Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE GetHeatBalHAMTInput
! SUBROUTINE INFORMATION:
! AUTHOR Phillip Biddulph
! DATE WRITTEN June 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! gets input for the HAMT model
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: cHAMTObject1='MaterialProperty:HeatAndMoistureTransfer:Settings'
CHARACTER(len=*), PARAMETER :: cHAMTObject2='MaterialProperty:HeatAndMoistureTransfer:SorptionIsotherm'
CHARACTER(len=*), PARAMETER :: cHAMTObject3='MaterialProperty:HeatAndMoistureTransfer:Suction'
CHARACTER(len=*), PARAMETER :: cHAMTObject4='MaterialProperty:HeatAndMoistureTransfer:Redistribution'
CHARACTER(len=*), PARAMETER :: cHAMTObject5='MaterialProperty:HeatAndMoistureTransfer:Diffusion'
CHARACTER(len=*), PARAMETER :: cHAMTObject6='MaterialProperty:HeatAndMoistureTransfer:ThermalConductivity'
CHARACTER(len=*), PARAMETER :: cHAMTObject7='SurfaceProperties:VaporCoefficients'
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=MaxNameLength),DIMENSION(:),ALLOCATABLE :: AlphaArray
CHARACTER(len=MaxNameLength),DIMENSION(:),ALLOCATABLE :: cAlphaFieldNames
CHARACTER(len=MaxNameLength),DIMENSION(:),ALLOCATABLE :: cNumericFieldNames
LOGICAL,DIMENSION(:),ALLOCATABLE :: lAlphaBlanks
LOGICAL,DIMENSION(:),ALLOCATABLE :: lNumericBlanks
REAL(r64),DIMENSION(:),ALLOCATABLE :: NumArray
REAL(r64) :: dumrh
REAL(r64) :: dumdata
REAL(r64) :: avdata
INTEGER :: MaxNums
INTEGER :: MaxAlphas
INTEGER :: NumParams
INTEGER :: NumNums
INTEGER :: NumAlphas
INTEGER :: status
INTEGER :: matid
INTEGER :: iso
INTEGER :: Numid
INTEGER :: suc
INTEGER :: red
INTEGER :: mu
INTEGER :: tc
!unused1208 INTEGER :: sid
INTEGER :: HAMTitems
INTEGER :: item
INTEGER :: ii
INTEGER :: jj
INTEGER :: vtcsid
LOGICAL :: avflag
LOGICAL :: isoerrrise
LOGICAL :: ErrorsFound
ALLOCATE(watertot(TotSurfaces))
ALLOCATE(surfrh(TotSurfaces))
ALLOCATE(surfextrh(TotSurfaces))
ALLOCATE(surftemp(TotSurfaces))
ALLOCATE(surfexttemp(TotSurfaces))
ALLOCATE(surfvp(TotSurfaces))
ALLOCATE(firstcell(TotSurfaces))
ALLOCATE(lastcell(TotSurfaces))
ALLOCATE(Extcell(TotSurfaces))
ALLOCATE(ExtRadcell(TotSurfaces))
ALLOCATE(ExtConcell(TotSurfaces))
ALLOCATE(ExtSkycell(TotSurfaces))
ALLOCATE(ExtGrncell(TotSurfaces))
ALLOCATE(Intcell(TotSurfaces))
ALLOCATE(IntConcell(TotSurfaces))
ALLOCATE(extvtc(TotSurfaces))
ALLOCATE(intvtc(TotSurfaces))
ALLOCATE(extvtcflag(TotSurfaces))
ALLOCATE(intvtcflag(TotSurfaces))
ALLOCATE(MyEnvrnFlag(TotSurfaces))
extvtc=-1.0d0
intvtc=-1.0d0
extvtcflag=.FALSE.
intvtcflag=.FALSE.
MyEnvrnFlag=.TRUE.
latswitch=.TRUE.
rainswitch=.TRUE.
MaxAlphas=0
MaxNums=0
CALL GetObjectDefMaxArgs(cHAMTObject1,NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNums=MAX(MaxNums,NumNums)
CALL GetObjectDefMaxArgs(cHAMTObject2,NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNums=MAX(MaxNums,NumNums)
CALL GetObjectDefMaxArgs(cHAMTObject3,NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNums=MAX(MaxNums,NumNums)
CALL GetObjectDefMaxArgs(cHAMTObject4,NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNums=MAX(MaxNums,NumNums)
CALL GetObjectDefMaxArgs(cHAMTObject5,NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNums=MAX(MaxNums,NumNums)
CALL GetObjectDefMaxArgs(cHAMTObject6,NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNums=MAX(MaxNums,NumNums)
CALL GetObjectDefMaxArgs(cHAMTObject7,NumParams,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNums=MAX(MaxNums,NumNums)
ErrorsFound=.false.
ALLOCATE(AlphaArray(MaxAlphas))
AlphaArray=' '
ALLOCATE(cAlphaFieldNames(MaxAlphas))
cAlphaFieldNames=' '
ALLOCATE(cNumericFieldNames(MaxNums))
cNumericFieldNames=' '
ALLOCATE(NumArray(MaxNums))
NumArray=0.0d0
ALLOCATE(lAlphaBlanks(MaxAlphas))
lAlphaBlanks=.false.
ALLOCATE(lNumericBlanks(MaxNums))
lNumericBlanks=.false.
HAMTitems=GetNumObjectsFound(cHAMTObject1) ! MaterialProperty:HeatAndMoistureTransfer:Settings
DO item=1,HAMTitems
CALL GetObjectItem(cHAMTObject1,item,AlphaArray,NumAlphas,NumArray,NumNums,status, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
matid=FindItemInList(AlphaArray(1),Material%Name,TotMaterials)
IF (matid == 0) THEN
CALL ShowSevereError(cHAMTObject1//' '//trim(cAlphaFieldNames(1))//'="'//TRIM(AlphaArray(1))// &
'" is invalid (undefined).')
CALL ShowContinueError('The basic material must be defined in addition to specifying '// &
'HeatAndMoistureTransfer properties.')
ErrorsFound=.true.
CYCLE
ENDIF
IF (Material(matid)%ROnly) THEN
CALL ShowWarningError(cHAMTObject1//' '//trim(cAlphaFieldNames(1))//'="'//TRIM(AlphaArray(1))// &
'" is defined as an R-only value material.')
CYCLE
ENDIF
Material(matid)%Porosity=NumArray(1)
Material(matid)%iwater=NumArray(2)
ENDDO
HAMTitems=GetNumObjectsFound(cHAMTObject2) ! MaterialProperty:HeatAndMoistureTransfer:SorptionIsotherm
DO item=1,HAMTitems
CALL GetObjectItem(cHAMTObject2,item,AlphaArray,NumAlphas,NumArray,NumNums,status, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
matid=FindItemInList(AlphaArray(1),Material%Name,TotMaterials)
IF (matid == 0) THEN
CALL ShowSevereError(cHAMTObject2//' '//trim(cAlphaFieldNames(1))//'="'//TRIM(AlphaArray(1))// &
'" is invalid (undefined).')
CALL ShowContinueError('The basic material must be defined in addition to specifying '// &
'HeatAndMoistureTransfer properties.')
ErrorsFound=.true.
CYCLE
ENDIF
IF (Material(matid)%ROnly) THEN
CALL ShowWarningError(cHAMTObject2//' '//trim(cAlphaFieldNames(1))//'="'//TRIM(AlphaArray(1))// &
'" is defined as an R-only value material.')
CYCLE
ENDIF
Numid=1
Material(matid)%niso=INT(NumArray(Numid))
DO iso=1,Material(matid)%niso
Numid=Numid+1
Material(matid)%isorh(iso)=NumArray(Numid)
Numid=Numid+1
Material(matid)%isodata(iso)=NumArray(Numid)
ENDDO
Material(matid)%niso=Material(matid)%niso+1
Material(matid)%isorh(Material(matid)%niso)=rhmax
Material(matid)%isodata(Material(matid)%niso)=Material(matid)%Porosity*wdensity
Material(matid)%niso=Material(matid)%niso+1
Material(matid)%isorh(Material(matid)%niso)=0.0d0
Material(matid)%isodata(Material(matid)%niso)=0.0d0
ENDDO
! check the isotherm
DO matid=1,TotMaterials
IF(Material(matid)%niso>0)THEN
! - First sort
DO jj=1,Material(matid)%niso-1
DO ii=jj+1,Material(matid)%niso
IF(Material(matid)%isorh(jj)>Material(matid)%isorh(ii))THEN
dumrh=Material(matid)%isorh(jj)
dumdata=Material(matid)%isodata(jj)
Material(matid)%isorh(jj)=Material(matid)%isorh(ii)
Material(matid)%isodata(jj)=Material(matid)%isodata(ii)
Material(matid)%isorh(ii)=dumrh
Material(matid)%isodata(ii)=dumdata
ENDIF
ENDDO
ENDDO
!- Now make sure the data rises
isoerrrise=.FALSE.
DO ii=1,100
avflag=.TRUE.
DO jj=1,Material(matid)%niso-1
IF(Material(matid)%isodata(jj)>Material(matid)%isodata(jj+1))THEN
isoerrrise=.TRUE.
avdata=(Material(matid)%isodata(jj)+Material(matid)%isodata(jj+1))/2.0d0
Material(matid)%isodata(jj)=avdata
Material(matid)%isodata(jj+1)=avdata
avflag=.FALSE.
ENDIF
ENDDO
IF(avflag)EXIT
ENDDO
IF(isoerrrise)THEN
CALL ShowWarningError(cHAMTObject2//' data not rising - Check material '//TRIM(Material(matid)%Name))
Call ShowContinueError('Isotherm data has been fixed, and the simulation continues.')
ENDIF
ENDIF
ENDDO
HAMTitems=GetNumObjectsFound(cHAMTObject3) ! MaterialProperty:HeatAndMoistureTransfer:Suction
DO item=1,HAMTitems
CALL GetObjectItem(cHAMTObject3,item,AlphaArray,NumAlphas,NumArray,NumNums,status, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
matid=FindItemInList(AlphaArray(1),Material%Name,TotMaterials)
IF (matid == 0) THEN
CALL ShowSevereError(cHAMTObject3//' '//trim(cAlphaFieldNames(1))//'="'//TRIM(AlphaArray(1))// &
'" is invalid (undefined).')
CALL ShowContinueError('The basic material must be defined in addition to specifying '// &
'HeatAndMoistureTransfer properties.')
ErrorsFound=.true.
CYCLE
ENDIF
IF (Material(matid)%ROnly) THEN
CALL ShowWarningError(cHAMTObject3//' '//trim(cAlphaFieldNames(1))//'="'//TRIM(AlphaArray(1))// &
'" is defined as an R-only value material.')
CYCLE
ENDIF
Numid=1
Material(matid)%nsuc=NumArray(Numid)
DO suc=1,Material(matid)%nsuc
Numid=Numid+1
Material(matid)%sucwater(suc)=NumArray(Numid)
Numid=Numid+1
Material(matid)%sucdata(suc)=NumArray(Numid)
ENDDO
Material(matid)%nsuc=Material(matid)%nsuc+1
Material(matid)%sucwater(Material(matid)%nsuc)=Material(matid)%isodata(Material(matid)%niso)
Material(matid)%sucdata(Material(matid)%nsuc)=Material(matid)%sucdata(Material(matid)%nsuc-1)
ENDDO
HAMTitems=GetNumObjectsFound(cHAMTObject4) ! MaterialProperty:HeatAndMoistureTransfer:Redistribution
DO item=1,HAMTitems
CALL GetObjectItem(cHAMTObject4,item,AlphaArray,NumAlphas,NumArray,NumNums,status, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
matid=FindItemInList(AlphaArray(1),Material%Name,TotMaterials)
IF (matid == 0) THEN
CALL ShowSevereError(cHAMTObject4//' '//trim(cAlphaFieldNames(1))//'="'//TRIM(AlphaArray(1))// &
'" is invalid (undefined).')
CALL ShowContinueError('The basic material must be defined in addition to specifying '// &
'HeatAndMoistureTransfer properties.')
ErrorsFound=.true.
CYCLE
ENDIF
IF (Material(matid)%ROnly) THEN
CALL ShowWarningError(cHAMTObject4//' '//trim(cAlphaFieldNames(1))//'="'//TRIM(AlphaArray(1))// &
'" is defined as an R-only value material.')
CYCLE
ENDIF
Numid=1
Material(matid)%nred=NumArray(Numid)
DO red=1,Material(matid)%nred
Numid=Numid+1
Material(matid)%redwater(red)=NumArray(Numid)
Numid=Numid+1
Material(matid)%reddata(red)=NumArray(Numid)
ENDDO
Material(matid)%nred=Material(matid)%nred+1
Material(matid)%redwater(Material(matid)%nred)=Material(matid)%isodata(Material(matid)%niso)
Material(matid)%reddata(Material(matid)%nred)=Material(matid)%reddata(Material(matid)%nred-1)
ENDDO
HAMTitems=GetNumObjectsFound(cHAMTObject5) ! MaterialProperty:HeatAndMoistureTransfer:Diffusion
DO item=1,HAMTitems
CALL GetObjectItem(cHAMTObject5,item,AlphaArray,NumAlphas,NumArray,NumNums,status, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
matid=FindItemInList(AlphaArray(1),Material%Name,TotMaterials)
IF (matid == 0) THEN
CALL ShowSevereError(cHAMTObject5//' '//trim(cAlphaFieldNames(1))//'="'//TRIM(AlphaArray(1))// &
'" is invalid (undefined).')
CALL ShowContinueError('The basic material must be defined in addition to specifying '// &
'HeatAndMoistureTransfer properties.')
ErrorsFound=.true.
CYCLE
ENDIF
IF (Material(matid)%ROnly) THEN
CALL ShowWarningError(cHAMTObject5//' '//trim(cAlphaFieldNames(1))//'="'//TRIM(AlphaArray(1))// &
'" is defined as an R-only value material.')
CYCLE
ENDIF
Numid=1
Material(matid)%nmu=NumArray(Numid)
IF(Material(matid)%nmu>0)THEN
DO mu=1,Material(matid)%nmu
Numid=Numid+1
Material(matid)%murh(mu)=NumArray(Numid)
Numid=Numid+1
Material(matid)%mudata(mu)=NumArray(Numid)
ENDDO
Material(matid)%nmu=Material(matid)%nmu+1
Material(matid)%murh(Material(matid)%nmu)=Material(matid)%isorh(Material(matid)%niso)
Material(matid)%mudata(Material(matid)%nmu)=Material(matid)%mudata(Material(matid)%nmu-1)
ENDIF
ENDDO
HAMTitems=GetNumObjectsFound(cHAMTObject6) ! MaterialProperty:HeatAndMoistureTransfer:ThermalConductivity
DO item=1,HAMTitems
CALL GetObjectItem(cHAMTObject6,item,AlphaArray,NumAlphas,NumArray,NumNums,status, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
matid=FindItemInList(AlphaArray(1),Material%Name,TotMaterials)
IF (matid == 0) THEN
CALL ShowSevereError(cHAMTObject6//' '//trim(cAlphaFieldNames(1))//'="'//TRIM(AlphaArray(1))// &
'" is invalid (undefined).')
CALL ShowContinueError('The basic material must be defined in addition to specifying '// &
'HeatAndMoistureTransfer properties.')
ErrorsFound=.true.
CYCLE
ENDIF
IF (Material(matid)%ROnly) THEN
CALL ShowWarningError(cHAMTObject6//' '//trim(cAlphaFieldNames(1))//'="'//TRIM(AlphaArray(1))// &
'" is defined as an R-only value material.')
CYCLE
ENDIF
Numid=1
Material(matid)%ntc=NumArray(Numid)
IF(Material(matid)%ntc>0)THEN
DO tc=1,Material(matid)%ntc
Numid=Numid+1
Material(matid)%tcwater(tc)=NumArray(Numid)
Numid=Numid+1
Material(matid)%tcdata(tc)=NumArray(Numid)
ENDDO
Material(matid)%ntc=Material(matid)%ntc+1
Material(matid)%tcwater(Material(matid)%ntc)=Material(matid)%isodata(Material(matid)%niso)
Material(matid)%tcdata(Material(matid)%ntc)=Material(matid)%tcdata(Material(matid)%ntc-1)
ENDIF
ENDDO
! Vapor Transfer coefficients
HAMTitems=GetNumObjectsFound(cHAMTObject7) ! SurfaceProperties:VaporCoefficients
DO item=1,HAMTitems
CALL GetObjectItem(cHAMTObject7,item,AlphaArray,NumAlphas,NumArray,NumNums,status, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
vtcsid=FindItemInList(AlphaArray(1),Surface%Name,TotSurfaces)
IF(vtcsid==0)THEN
CALL ShowSevereError(cHAMTObject7//' '//trim(cAlphaFieldNames(1))//'="'//TRIM(AlphaArray(1))// &
'" is invalid (undefined).')
CALL ShowContinueError('The basic material must be defined in addition to specifying '// &
'HeatAndMoistureTransfer properties.')
ErrorsFound=.true.
CYCLE
ENDIF
IF(TRIM(AlphaArray(2)) == 'YES')THEN
extvtcflag(vtcsid)=.TRUE.
extvtc(vtcsid)=NumArray(1)
ENDIF
IF(TRIM(AlphaArray(3)) == 'YES')THEN
intvtcflag(vtcsid)=.TRUE.
intvtc(vtcsid)=NumArray(2)
ENDIF
ENDDO
DEALLOCATE(AlphaArray)
DEALLOCATE(cAlphaFieldNames)
DEALLOCATE(cNumericFieldNames)
DEALLOCATE(NumArray)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
IF (ErrorsFound) THEN
CALL ShowFatalError('GetHeatBalHAMTInput: Errors found getting input. Program terminates.')
ENDIF
END SUBROUTINE GetHeatBalHAMTInput