6 SUBROUTINE read_prep_isba_snow(HPROGRAM,HSNOW,KSNOW_LAYER,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,OUNIF)
60 USE modi_open_namelist
61 USE modi_close_namelist
64 USE modd_prep_isba, ONLY : cfile_snow, ctype_snow, cfilepgd_snow, &
65 ctypepgd_snow, lsnow_ideal, &
66 xwsnow_p=>xwsnow, xtsnow_p=>xtsnow, &
67 xlwcsnow_p=>xlwcsnow, &
68 xrsnow_p=>xrsnow, xasnow, &
69 xsg1snow_p=>xsg1snow, xsg2snow_p=>xsg2snow, &
70 xhistsnow_p=>xhistsnow, xagesnow_p=>xagesnow
73 USE modd_prep_snow, ONLY : lsnow_frac_tot, nsnow_layer_max , lsnow_prep_perm
75 USE yomhook
,ONLY : lhook, dr_hook
76 USE parkind1
,ONLY : jprb
83 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
84 CHARACTER(LEN=3),
INTENT(OUT) :: hsnow
85 INTEGER,
INTENT(OUT) :: ksnow_layer
86 CHARACTER(LEN=28),
OPTIONAL,
INTENT(OUT) :: hfile
87 CHARACTER(LEN=6),
OPTIONAL,
INTENT(OUT) :: hfiletype
88 CHARACTER(LEN=28),
OPTIONAL,
INTENT(OUT) :: hfilepgd
89 CHARACTER(LEN=6),
OPTIONAL,
INTENT(OUT) :: hfilepgdtype
90 LOGICAL,
OPTIONAL,
INTENT(OUT) :: ounif
95 REAL,
DIMENSION(NSNOW_LAYER_MAX) :: xwsnow, xzsnow, xrsnow, xtsnow, xlwcsnow, &
96 xsg1snow, xsg2snow, xhistsnow, xagesnow
104 REAL(KIND=JPRB) :: zhook_handle
106 namelist/nam_prep_isba_snow/csnow, nsnow_layer, cfile_snow, ctype_snow, &
107 cfilepgd_snow, ctypepgd_snow, &
108 lsnow_ideal, lsnow_frac_tot,lsnow_prep_perm, &
109 xwsnow, xzsnow, xtsnow, xlwcsnow, xrsnow, xasnow, &
110 xsg1snow, xsg2snow, xhistsnow, xagesnow, &
116 IF (lhook) CALL dr_hook(
'READ_PREP_ISBA_SNOW',0,zhook_handle)
127 lsnow_ideal = .false.
128 lsnow_frac_tot = .false.
129 lsnow_prep_perm = .true.
139 xhistsnow(:) = xundef
151 CALL
posnam(ilunam,
'NAM_PREP_ISBA_SNOW',gfound,iluout)
152 IF (gfound)
READ(unit=ilunam,nml=nam_prep_isba_snow)
156 IF (csnow==
'NON') nsnow_layer = 0
158 IF (csnow==
'D95' .OR. csnow==
'EBA') nsnow_layer = 1
160 IF ((csnow==
'3-L' .OR. csnow==
'CRO') .AND. nsnow_layer<=2) nsnow_layer = 12
162 IF (nsnow_layer > nsnow_layer_max)
THEN
163 WRITE(iluout,*)
'------------------------------------'
164 WRITE(iluout,*)
'Please update modd_prep_snow.f90 routine : '
165 WRITE(iluout,*)
'The maximum number of snow layers '
166 WRITE(iluout,*)
'in the declaration of the namelist variables '
167 WRITE(iluout,*)
'must be decreased to : ', nsnow_layer_max
168 WRITE(iluout,*)
'------------------------------------'
169 CALL
abor1_sfx(
'READ_PREP_ISBA_SNOW: NUMBER OF SNOW LAYERS MUST BE INCREASED IN NAMELIST DECLARATION')
173 DO jlayer=1,nsnow_layer
174 IF (xzsnow(jlayer)/=xundef)
THEN
175 IF (xwsnow(jlayer)/=xundef)
THEN
176 WRITE(iluout,*)
'----------------------------'
177 WRITE(iluout,*)
'layer ',jlayer,
':'
178 WRITE(iluout,*)
'XWSNOW and XZSNOW are both defined.'
179 WRITE(iluout,*)
'You must define only one of them.'
180 WRITE(iluout,*)
' PLEASE CORRECT THAT '
181 WRITE(iluout,*)
'----------------------------'
182 CALL
abor1_sfx(
'READ_PREP_ISBA_SNOW: ERROR IN INITIALISATION OF SNOW PARAMETERS')
183 ELSEIF (xrsnow(jlayer)==xundef)
THEN
184 WRITE(iluout,*)
'----------------------------'
185 WRITE(iluout,*)
'layer ',jlayer,
':'
186 WRITE(iluout,*)
'XZSNOW is defined '
187 WRITE(iluout,*)
'but XRSNOW is not. '
188 WRITE(iluout,*)
' PLEASE CORRECT THAT '
189 WRITE(iluout,*)
'----------------------------'
190 CALL
abor1_sfx(
'READ_PREP_ISBA_SNOW: ERROR IN INITIALISATION OF SNOW PARAMETERS')
192 xwsnow(jlayer)=xzsnow(jlayer)*xrsnow(jlayer)
197 IF(nsnow_layer>=3)
THEN
198 IF(xwsnow(1)/=xundef.AND.any(xwsnow(2:nsnow_layer)==xundef))
THEN
199 WHERE(xwsnow(2:nsnow_layer)==xundef)xwsnow(2:nsnow_layer)=0.0
201 IF(xrsnow(1)/=xundef.AND.any(xrsnow(2:nsnow_layer)==xundef))
THEN
202 WHERE(xrsnow(2:nsnow_layer)==xundef)xrsnow(2:nsnow_layer)=xrsnow(1)
206 ALLOCATE(xwsnow_p(nsnow_layer))
207 ALLOCATE(xrsnow_p(nsnow_layer))
208 ALLOCATE(xtsnow_p(nsnow_layer))
209 ALLOCATE(xlwcsnow_p(nsnow_layer))
210 ALLOCATE(xagesnow_p(nsnow_layer))
212 xwsnow_p =xwsnow(1:nsnow_layer)
213 xrsnow_p =xrsnow(1:nsnow_layer)
214 xtsnow_p =xtsnow(1:nsnow_layer)
215 xagesnow_p=xagesnow(1:nsnow_layer)
216 xlwcsnow_p=xlwcsnow(1:nsnow_layer)
220 DO jlayer=1,nsnow_layer
221 IF ((xlwcsnow_p(jlayer)>0.).AND.(xtsnow_p(jlayer)<xtt))
THEN
222 WRITE(iluout,*)
'----------------------------'
223 WRITE(iluout,*)
'layer ',jlayer,
':'
224 WRITE(iluout,*)
'Incoherence between '
225 WRITE(iluout,*)
'snow liquid water content '
226 WRITE(iluout,*)
'and snow temperature. '
227 WRITE(iluout,*)
' PLEASE CORRECT THAT '
228 WRITE(iluout,*)
'----------------------------'
229 CALL
abor1_sfx(
'READ_PREP_ISBA_SNOW: ERROR IN INITIALISATION OF SNOW PARAMETERS')
233 IF (csnow==
'CRO')
THEN
235 ALLOCATE(xsg1snow_p(nsnow_layer))
236 ALLOCATE(xsg2snow_p(nsnow_layer))
237 ALLOCATE(xhistsnow_p(nsnow_layer))
239 xsg1snow_p =xsg1snow(1:nsnow_layer)
240 xsg2snow_p =xsg2snow(1:nsnow_layer)
241 xhistsnow_p=xhistsnow(1:nsnow_layer)
243 DO jlayer=1,nsnow_layer
244 IF ((xsg1snow_p(jlayer)==xundef .OR. xsg2snow_p(jlayer)==xundef .OR. &
245 xhistsnow_p(jlayer)==xundef .OR. xagesnow_p(jlayer)==xundef) &
246 .AND. xwsnow_p(jlayer).NE.0. .AND. xwsnow_p(jlayer)/=xundef )
THEN
247 WRITE(iluout,*)
'----------------------------'
248 WRITE(iluout,*)
'WSNOW/=0 AND ONE OF SG1SNOW,'
249 WRITE(iluout,*)
'SG2SNOW, HISTSNOW OR AGESNOW'
250 WRITE(iluout,*)
' ==XUNDEF '
251 WRITE(iluout,*)
' PLEASE CORRECT THAT '
252 WRITE(iluout,*)
'----------------------------'
253 CALL
abor1_sfx(
'READ_PREP_ISBA_SNOW: ERROR IN INITIALISATION OF SNOW PARAMETERS')
259 ALLOCATE(xsg1snow_p(0))
260 ALLOCATE(xsg2snow_p(0))
261 ALLOCATE(xhistsnow_p(0))
271 ksnow_layer = nsnow_layer
273 IF(all(xwsnow_p(:)==xundef).AND.present(ounif))
THEN
275 ELSEIF(present(ounif))
THEN
279 lfile=(len_trim(cfile_snow)>0.AND.len_trim(ctype_snow)>0 &
280 .AND.len_trim(cfilepgd_snow)>0.AND.len_trim(ctypepgd_snow)>0)
282 IF(present(hfile))
THEN
289 IF(present(hfiletype))
THEN
291 hfiletype = ctype_snow
296 IF(present(hfilepgdtype))
THEN
298 hfilepgdtype = ctypepgd_snow
303 IF(present(hfilepgd))
THEN
305 hfilepgd = cfilepgd_snow
310 IF (lfile.AND.present(ounif)) ounif=.false.
312 IF (lhook) CALL dr_hook(
'READ_PREP_ISBA_SNOW',1,zhook_handle)
subroutine abor1_sfx(YTEXT)
subroutine close_namelist(HPROGRAM, KLUNAM)
subroutine posnam(KULNAM, HDNAML, OFOUND, KLUOUT)
subroutine get_luout(HPROGRAM, KLUOUT)
subroutine read_prep_isba_snow(HPROGRAM, HSNOW, KSNOW_LAYER, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, OUNIF)
subroutine open_namelist(HPROGRAM, KLUNAM, HFILE)