57 USE modi_open_namelist
58 USE modi_close_namelist
62 ctypepgd_snow, lsnow_ideal_gd, &
63 xwsnow_p=>xwsnow_gd, xtsnow_p=>xtsnow_gd, xlwcsnow_p=>xlwcsnow_gd, &
64 xrsnow_p=>xrsnow_gd, xagesnow_p=>xagesnow_gd, xasnow_gd
68 USE yomhook
,ONLY : lhook, dr_hook
69 USE parkind1
,ONLY : jprb
76 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
77 CHARACTER(LEN=3),
INTENT(OUT) :: hsnow
78 INTEGER,
INTENT(OUT) :: ksnow_layer
79 CHARACTER(LEN=28),
OPTIONAL,
INTENT(OUT) :: hfile
80 CHARACTER(LEN=6),
OPTIONAL,
INTENT(OUT) :: hfiletype
81 CHARACTER(LEN=28),
OPTIONAL,
INTENT(OUT) :: hfilepgd
82 CHARACTER(LEN=6),
OPTIONAL,
INTENT(OUT) :: hfilepgdtype
83 LOGICAL,
OPTIONAL,
INTENT(OUT) :: ounif
88 CHARACTER(LEN=3) :: csnow
89 INTEGER :: nsnow_layer
90 CHARACTER(LEN=28) :: cfile_snow, cfilepgd_snow
91 LOGICAL :: lsnow_ideal, lsnow_frac_tot, lswemax
92 REAL :: xasnow, xswemax
93 REAL,
DIMENSION(NSNOW_LAYER_MAX) :: xwsnow, xzsnow, xrsnow, xtsnow, xlwcsnow, xsg1snow, xsg2snow,&
97 REAL,
DIMENSION(NSNOW_LAYER_MAX) :: xwsnow_gd, xzsnow_gd, xrsnow_gd, xtsnow_gd, xlwcsnow_gd, &
98 xsg1snow_gd, xsg2snow_gd, xhistsnow_gd, xagesnow_gd
105 REAL(KIND=JPRB) :: zhook_handle
107 namelist/nam_prep_isba_snow/csnow, nsnow_layer, cfile_snow, ctype_snow, &
108 cfilepgd_snow, ctypepgd_snow, &
109 lsnow_ideal, lsnow_frac_tot, lsnow_prep_perm, &
110 xwsnow, xzsnow, xtsnow, xlwcsnow, xrsnow, xasnow, &
111 xsg1snow, xsg2snow, xhistsnow, xagesnow, &
113 namelist/nam_prep_garden_snow/csnow_gd, nsnow_layer_gd, cfile_snow_gd, ctype_snow, &
114 cfilepgd_snow_gd, ctypepgd_snow, &
115 lsnow_ideal_gd, xwsnow_gd, xzsnow_gd, xtsnow_gd, xlwcsnow_gd, xrsnow_gd, xasnow_gd
121 IF (lhook) CALL dr_hook(
'READ_PREP_GARDEN_SNOW',0,zhook_handle)
129 cfilepgd_snow_gd =
' '
132 lsnow_ideal_gd = .false.
133 lsnow_prep_perm = .true.
136 xzsnow_gd(:) = xundef
137 xrsnow_gd(:) = xrhosmax
141 xsg1snow_gd(:) = xundef
143 xhistsnow_gd(:) = xundef
144 xagesnow_gd(:) = xundef
156 CALL
posnam(ilunam,
'NAM_PREP_ISBA_SNOW',gfound,iluout)
163 lsnow_ideal = .false.
164 lsnow_frac_tot = .false.
172 xhistsnow(:) = xundef
176 READ(unit=ilunam,nml=nam_prep_isba_snow)
180 nsnow_layer_gd = nsnow_layer
181 cfile_snow_gd = cfile_snow
182 cfilepgd_snow_gd = cfilepgd_snow
183 lsnow_ideal_gd = lsnow_ideal
184 xwsnow_gd(:) = xwsnow(:)
185 xzsnow_gd(:) = xzsnow(:)
186 xrsnow_gd(:) = xrsnow(:)
187 xtsnow_gd(:) = xtsnow(:)
188 xlwcsnow_gd(:) = xlwcsnow(:)
190 xsg1snow_gd(:) = xsg1snow(:)
191 xsg2snow_gd(:) = xsg2snow(:)
192 xhistsnow_gd(:) = xhistsnow(:)
193 xagesnow_gd(:) = xagesnow(:)
198 CALL
posnam(ilunam,
'NAM_PREP_GARDEN_SNOW',gfound,iluout)
200 READ(unit=ilunam,nml=nam_prep_garden_snow)
205 IF (csnow_gd==
'NON') nsnow_layer_gd = 0
207 IF (csnow_gd==
'D95' .OR. csnow_gd==
'EBA') nsnow_layer_gd = 1
209 IF (csnow_gd==
'3-L' .AND. nsnow_layer_gd<=2) nsnow_layer_gd = 12
211 IF (nsnow_layer_gd > nsnow_layer_max)
THEN
212 WRITE(iluout,*)
'------------------------------------'
213 WRITE(iluout,*)
'Please update modd_prep_snow.f90 routine : '
214 WRITE(iluout,*)
'The maximum number of snow layers '
215 WRITE(iluout,*)
'in the declaration of the namelist variables '
216 WRITE(iluout,*)
'must be decreased to : ', nsnow_layer_max
217 WRITE(iluout,*)
'------------------------------------'
218 CALL
abor1_sfx(
'READ_PREP_GARDEN_SNOW: NUMBER OF SNOW LAYERS MUST BE INCREASED IN NAMELIST DECLARATION')
221 ALLOCATE(xwsnow_p(nsnow_layer_gd))
222 ALLOCATE(xrsnow_p(nsnow_layer_gd))
223 ALLOCATE(xtsnow_p(nsnow_layer_gd))
224 ALLOCATE(xagesnow_p(nsnow_layer_gd))
225 ALLOCATE(xlwcsnow_p(nsnow_layer_gd))
227 DO jlayer=1,nsnow_layer_gd
229 IF ((xzsnow_gd(jlayer)>0) .AND.(xzsnow_gd(jlayer)/=xundef ))
THEN
230 IF ((xwsnow_gd(jlayer)>0) .AND.(xwsnow_gd(jlayer)/=xundef ))
THEN
231 WRITE(iluout,*)
'XWSNOW and XZSNOW are both defined.'
232 WRITE(iluout,*)
'You must define only one of them.'
233 WRITE(iluout,*)
' PLEASE CORRECT THAT '
234 CALL
abor1_sfx(
'READ_PREP_GARDEN_SNOW: ERROR IN INITIALIZATION OF SNOW DEPTH')
236 xwsnow_p(jlayer)=xzsnow_gd(jlayer)*xrsnow_gd(jlayer)
239 xwsnow_p(jlayer)=xwsnow_gd(jlayer)
243 xrsnow_p=xrsnow_gd(1:nsnow_layer_gd)
244 xtsnow_p=xtsnow_gd(1:nsnow_layer_gd)
245 xagesnow_p=xagesnow_gd(1:nsnow_layer_gd)
246 xlwcsnow_p=xlwcsnow_gd(1:nsnow_layer_gd)
254 ksnow_layer = nsnow_layer_gd
256 IF(all(xwsnow_p(:)==xundef).AND.present(ounif))
THEN
258 ELSEIF(present(ounif))
THEN
262 lfile=(len_trim(cfile_snow_gd)>0.AND.len_trim(ctype_snow)>0 &
263 .AND.len_trim(cfilepgd_snow_gd)>0.AND.len_trim(ctypepgd_snow)>0)
265 IF (present(ounif)) lfile=(lfile .AND. .NOT.ounif)
267 IF(present(hfile))
THEN
269 hfile = cfile_snow_gd
274 IF(present(hfiletype))
THEN
276 hfiletype = ctype_snow
281 IF(present(hfilepgdtype))
THEN
283 hfilepgdtype = ctypepgd_snow
288 IF(present(hfilepgd))
THEN
290 hfilepgd = cfilepgd_snow_gd
295 IF (lfile.AND.present(ounif)) ounif=.false.
297 IF (lhook) CALL dr_hook(
'READ_PREP_GARDEN_SNOW',1,zhook_handle)
subroutine abor1_sfx(YTEXT)
subroutine read_prep_garden_snow(HPROGRAM, HSNOW, KSNOW_LAYER, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, OUNIF)
subroutine close_namelist(HPROGRAM, KLUNAM)
subroutine posnam(KULNAM, HDNAML, OFOUND, KLUOUT)
subroutine get_luout(HPROGRAM, KLUOUT)
subroutine open_namelist(HPROGRAM, KLUNAM, HFILE)