64 TYPE(t_region
),
INTENT(INOUT),
TARGET :: region
70 CHARACTER(CHRLEN) :: rcsidentstring
72 INTEGER :: npcls, ncont, icvmassbeg, icvmassend, icontal, imatal
76 INTEGER,
POINTER,
DIMENSION(:,:) :: paiv
78 REAL(RFREAL) :: temptarg, masssum, kinener, heatcap, enertarg
80 REAL(RFREAL),
POINTER,
DIMENSION(:) :: pspcheat
81 REAL(RFREAL),
POINTER,
DIMENSION(:,:) :: pcv
84 TYPE(t_plag),
POINTER :: pplag
89 rcsidentstring =
'$RCSfile: INRT_SetParticleTemp.F90,v $ $Revision: 1.3 $'
91 global => region%global
94 'INRT_SetParticleTemp.F90' )
100 ilev = region%currLevel
101 pplag => region%levels(ilev)%plag
110 IF (global%plagUsed) npcls = pplag%nPcls
112 IF (npcls < 1) go to 9
119 pinrtburn => region%inrtInput%inrts(inrt_type_burning)
121 pspcheat => region%plagInput%spht
122 ncont = region%plagInput%nCont
127 icvmassbeg = pplag%cvPlagMass(1)
128 icvmassend = pplag%cvPlagMass(ncont)
132 icontal = pinrtburn%edges(inrt_burning_l_mass_x)%iNode(1) &
133 - region%inrtInput%indPlag0
135 IF (icontal < 1 .OR. icontal > ncont)
THEN
136 CALL
errorstop( global,err_inrt_indexrange,__line__ )
141 imatal = region%plagInput%materialIndex(icontal)
143 IF (imatal < 1 .OR. imatal > global%nMaterials)
THEN
144 CALL
errorstop( global,err_inrt_indexrange,__line__ )
147 temptarg = global%materials(imatal)%Tboil
149 IF (temptarg < 500._rfreal .OR. temptarg > 10000._rfreal)
THEN
150 CALL
errorstop( global,err_inrt_badval,__line__ )
157 SELECT CASE (paiv(aiv_plag_burnstat,ipcls))
159 CASE (inrt_burnstat_off)
163 CASE (inrt_burnstat_on)
165 masssum =
sum( pcv(icvmassbeg:icvmassend,ipcls) )
167 kinener =
dot_product( pcv(cv_plag_xmom:cv_plag_zmom,ipcls), &
168 pcv(cv_plag_xmom:cv_plag_zmom,ipcls) ) * &
171 heatcap =
dot_product( pcv(icvmassbeg:icvmassend,ipcls),pspcheat(:) )
173 enertarg = kinener + heatcap*temptarg
182 pcv(cv_plag_ener,ipcls) = enertarg
186 CALL
errorstop( global,err_reached_default,__line__ )
Tfloat sum() const
Return the sum of all the pixel values in an image.
subroutine registerfunction(global, funName, fileName)
subroutine errorstop(global, errorCode, errorLine, addMessage)
long double dot_product(pnt vec1, pnt vec2)
subroutine inrt_setparticletemp(region)
subroutine deregisterfunction(global)