59 TYPE(t_region
),
INTENT(INOUT),
TARGET :: region
65 REAL(RFREAL),
PARAMETER :: diamalcutoff = 5.e-7_rfreal
67 CHARACTER(CHRLEN) :: rcsidentstring
69 INTEGER :: npcls, ncont, icontal, icvalmass
73 INTEGER,
POINTER,
DIMENSION(:,:) :: paiv
75 LOGICAL :: vapornotused
77 REAL(RFREAL) :: densal, massalcutoff, massal
79 REAL(RFREAL),
POINTER,
DIMENSION(:,:) :: pcv
82 TYPE(t_plag),
POINTER :: pplag
87 rcsidentstring =
'$RCSfile: INRT_BurnStatusUpdate.F90,v $ $Revision: 1.3 $'
89 global => region%global
92 'INRT_BurnStatusUpdate.F90' )
98 ilev = region%currLevel
99 pplag => region%levels(ilev)%plag
108 IF (global%plagUsed) npcls = pplag%nPcls
110 IF (npcls < 1) go to 9
117 pinrtburn => region%inrtInput%inrts(inrt_type_burning)
119 ncont = region%plagInput%nCont
123 icontal = pinrtburn%edges(inrt_burning_l_mass_x)%iNode(1) &
124 - region%inrtInput%indPlag0
126 IF (icontal < 1 .OR. icontal > ncont)
THEN
127 CALL
errorstop( global,err_inrt_indexrange,__line__ )
132 icvalmass = pplag%cvPlagMass(icontal)
134 densal = region%plagInput%dens(icontal)
139 massalcutoff = (global%pi / 6._rfreal) * diamalcutoff**3 * densal
144 vapornotused = pinrtburn%switches(inrt_swi_burning_vapor_meth) /= &
145 inrt_burning_vapor_meth_used
151 SELECT CASE (paiv(aiv_plag_burnstat,ipcls))
153 CASE (inrt_burnstat_off)
159 CASE (inrt_burnstat_on)
163 IF (pcv(cv_plag_enervapor,ipcls) > 0._rfreal)
THEN
167 IF (vapornotused)
THEN
168 CALL
errorstop( global,err_inrt_enervapor,__line__ )
178 massal = pcv(icvalmass,ipcls)
180 IF (massal < massalcutoff)
THEN
182 paiv(aiv_plag_burnstat,ipcls) = inrt_burnstat_off
190 CALL
errorstop( global,err_reached_default,__line__ )
subroutine registerfunction(global, funName, fileName)
subroutine errorstop(global, errorCode, errorLine, addMessage)
subroutine deregisterfunction(global)
subroutine inrt_burnstatusupdate(region)