7 tgd, tgdo, tgdpe, tgdp, tg, top, tvg, &
8 hprogram,hsurf,hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,kpatch)
60 USE modd_prep, ONLY : cingrid_type, cinterp_type, xzs_ls, &
61 xlat_out, xlon_out, xx_out, xy_out, &
65 xwsnow_gd, xrsnow_gd, xtsnow_gd, xlwcsnow_gd, &
66 xagesnow_gd, xasnow_gd, lsnow_ideal_gd
72 USE modi_read_prep_teb_garden_conf
73 USE modi_read_prep_garden_snow
74 USE modi_prep_teb_garden_ascllv
75 USE modi_prep_teb_garden_grib
76 USE modi_prep_teb_garden_unif
77 USE modi_prep_teb_garden_buffer
79 USE modi_put_on_all_vegtypes
80 USE modi_vegtype_grid_to_patch_grid
81 USE modi_prep_hor_snow_fields
83 USE modi_prep_teb_garden_extern
86 USE yomhook
,ONLY : lhook, dr_hook
87 USE parkind1
,ONLY : jprb
96 TYPE(isba_grid_t
),
INTENT(INOUT) :: ig
97 TYPE(isba_t
),
INTENT(INOUT) :: i
110 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
111 CHARACTER(LEN=7),
INTENT(IN) :: hsurf
112 CHARACTER(LEN=28),
INTENT(IN) :: hatmfile
113 CHARACTER(LEN=6),
INTENT(IN) :: hatmfiletype
114 CHARACTER(LEN=28),
INTENT(IN) :: hpgdfile
115 CHARACTER(LEN=6),
INTENT(IN) :: hpgdfiletype
117 INTEGER,
INTENT(IN) :: kpatch
121 CHARACTER(LEN=6) :: yfiletype
122 CHARACTER(LEN=28) :: yfile
123 CHARACTER(LEN=6) :: yfilepgdtype
124 CHARACTER(LEN=28) :: yfilepgd
125 CHARACTER(LEN=6) :: yfiletype_snow
126 CHARACTER(LEN=28) :: yfile_snow
127 CHARACTER(LEN=6) :: yfilepgdtype_snow
128 CHARACTER(LEN=28) :: yfilepgd_snow
129 REAL,
POINTER,
DIMENSION(:,:,:) :: zfieldin
130 REAL,
POINTER,
DIMENSION(:,:) :: zfield
131 REAL,
ALLOCATABLE,
DIMENSION(:,:,:) :: zfieldoutp
132 REAL,
ALLOCATABLE,
DIMENSION(:,:,:) :: zfieldoutv
133 REAL,
ALLOCATABLE,
DIMENSION(:,:,:) :: zvegtype_patch
134 REAL,
ALLOCATABLE,
DIMENSION(:,:) :: zw
135 REAL,
ALLOCATABLE,
DIMENSION(:) :: zsum
136 REAL,
ALLOCATABLE,
DIMENSION(:,:) :: zf
137 REAL,
ALLOCATABLE,
DIMENSION(:,:) :: zdg
138 REAL,
ALLOCATABLE,
DIMENSION(:,:) :: zpatch
139 REAL,
ALLOCATABLE,
DIMENSION(:) :: zsg1snow, zsg2snow, zhistsnow
143 LOGICAL :: gunif_snow
144 INTEGER :: jvegtype, jpatch
146 INTEGER :: ji, inp, inl, ini
148 REAL(KIND=JPRB) :: zhook_handle
154 IF (lhook) CALL dr_hook(
'PREP_HOR_TEB_GARDEN_FIELD',0,zhook_handle)
158 hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,iluout,gunif)
167 IF (hsurf==
'SN_VEG ')
THEN
169 yfiletype_snow,yfilepgd_snow,yfilepgdtype_snow,gunif_snow)
170 IF(.NOT.gunif_snow.AND.len_trim(yfile_snow)==0.AND.len_trim(yfiletype_snow)==0)
THEN
172 IF (yfiletype==
'GRIB')
THEN
174 yfiletype_snow=yfiletype
175 yfilepgd_snow =yfilepgd
176 yfilepgdtype_snow=yfilepgdtype
179 IF(all(xwsnow_gd==xundef))xwsnow_gd=0.0
182 ALLOCATE(zsg1snow(
SIZE(xwsnow_gd)))
183 ALLOCATE(zsg2snow(
SIZE(xwsnow_gd)))
184 ALLOCATE(zhistsnow(
SIZE(xwsnow_gd)))
185 ALLOCATE(zpatch(
SIZE(tgdp%XVEGTYPE,1),1))
186 ALLOCATE(zvegtype_patch(
SIZE(tgdp%XVEGTYPE,1),
SIZE(tgdp%XVEGTYPE,2),1))
189 zvegtype_patch(:,:,1) = tgdp%XVEGTYPE(:,:)
194 yfilepgd, yfilepgdtype, &
195 iluout,gunif_snow,1,kpatch, &
196 ini,tgd%CUR%TSNOW, top%TTIME, &
197 xwsnow_gd, xrsnow_gd, xtsnow_gd,&
198 xlwcsnow_gd, xasnow_gd, &
199 lsnow_ideal_gd, zsg1snow, &
200 zsg2snow, zhistsnow, xagesnow_gd, &
201 tgdp%XVEGTYPE,zvegtype_patch, zpatch )
204 DEALLOCATE(zhistsnow)
206 DEALLOCATE(zvegtype_patch)
207 IF (lhook) CALL dr_hook(
'PREP_HOR_TEB_GARDEN_FIELD',1,zhook_handle)
217 ELSE IF (yfiletype==
'ASCLLV')
THEN
219 hprogram,hsurf,iluout,zfieldin)
220 ELSE IF (yfiletype==
'GRIB ')
THEN
222 ELSE IF (yfiletype==
'MESONH' .OR. yfiletype==
'ASCII ' .OR. yfiletype==
'LFI '.OR.yfiletype==
'FA ')
THEN
224 hprogram,hsurf,yfile,yfiletype,yfilepgd,yfilepgdtype,iluout,kpatch,zfieldin)
225 ELSE IF (yfiletype==
'BUFFER')
THEN
228 CALL
abor1_sfx(
'PREP_HOR_TEB_GARDEN_FIELD: data file type not supported : '//yfiletype)
235 inl =
SIZE(zfieldin,2)
236 inp =
SIZE(zfieldin,3)
238 ALLOCATE(zfieldoutp(ini,inl,inp))
239 ALLOCATE(zfield(
SIZE(zfieldin,1),inl))
241 DO jpatch = 1,
SIZE(zfieldin,3)
242 zfield=zfieldin(:,:,jpatch)
243 IF (inp==nvegtype) linterp = (tgdp%XVEGTYPE(:,jpatch) > 0.)
245 iluout,zfield,zfieldoutp(:,:,jpatch))
251 ALLOCATE(zfieldoutv(ini,inl,nvegtype))
255 DEALLOCATE(zfieldoutp)
261 ALLOCATE(zw(ini,
SIZE(zfieldoutv,2)))
262 ALLOCATE(zsum(
SIZE(zfieldoutv,1)))
265 DO jlayer=1,
SIZE(zw,2)
266 zsum(:) = sum(tgdp%XVEGTYPE(:,:),2,zfieldoutv(:,jlayer,:)/=xundef)
267 DO jvegtype=1,nvegtype
268 WHERE (zfieldoutv(:,jlayer,jvegtype)/=xundef)
269 zw(:,jlayer) = zw(:,jlayer) + tgdp%XVEGTYPE(:,jvegtype) * zfieldoutv(:,jlayer,jvegtype) / zsum(:)
273 IF (all(zfieldoutv(ji,jlayer,:)==xundef)) zw(ji,jlayer) = xundef
287 ALLOCATE(zf(
SIZE(zfieldoutv,1),tgdo%NGROUND_LAYER))
293 ALLOCATE(tgd%CUR%XWG(
SIZE(zfieldoutv,1),tgdo%NGROUND_LAYER))
294 tgd%CUR%XWG(:,:) = tgdp%XWWILT + zf(:,:) * (tgdp%XWFC-tgdp%XWWILT)
295 tgd%CUR%XWG(:,:) = max(min(tgd%CUR%XWG(:,:),tgdp%XWSAT),xwgmin)
297 WHERE(zf(:,:)==xundef)tgd%CUR%XWG(:,:)=xundef
304 ALLOCATE(zf(
SIZE(zfieldoutv,1),tgdo%NGROUND_LAYER))
310 ALLOCATE(tgd%CUR%XWGI(
SIZE(zfieldoutv,1),tgdo%NGROUND_LAYER))
311 tgd%CUR%XWGI(:,:) = zf(:,:) * tgdp%XWSAT
312 tgd%CUR%XWGI(:,:) = max(min(tgd%CUR%XWGI(:,:),tgdp%XWSAT),0.)
314 WHERE(zf(:,:)==xundef)tgd%CUR%XWGI(:,:)=xundef
321 iwork=tgdo%NGROUND_LAYER
322 ALLOCATE(tgd%CUR%XTG(
SIZE(zfieldoutv,1),iwork))
323 ALLOCATE(zdg(
SIZE(tgdp%XDG,1),iwork))
324 IF (tvg%CISBA==
'2-L'.OR.tvg%CISBA==
'3-L')
THEN
327 IF(tvg%CISBA==
'3-L') zdg(:,3) = 5.00
330 zdg(:,:) = tgdp%XDG(:,:)
338 ALLOCATE(tgd%CUR%XWR(
SIZE(zfieldoutv,1)))
339 tgd%CUR%XWR(:) = zw(:,1)
346 WHERE (zw(:,1)/=xundef) tgdpe%CUR%XLAI(:) = zw(:,1)
355 DEALLOCATE(zfieldin )
356 DEALLOCATE(zfieldoutv)
358 IF (lhook) CALL dr_hook(
'PREP_HOR_TEB_GARDEN_FIELD',1,zhook_handle)
372 REAL,
DIMENSION(:,:),
INTENT(IN) :: pt1
373 REAL,
DIMENSION(:),
INTENT(IN) :: pgrid1
374 REAL,
DIMENSION(:,:),
INTENT(IN) :: pd2
375 REAL,
DIMENSION(:,:),
INTENT(OUT) :: pt2
378 REAL,
DIMENSION(SIZE(PT1,1),SIZE(PT1,2)) :: zd1
380 INTEGER :: ilayer1, ilayer2
381 REAL(KIND=JPRB) :: zhook_handle
385 IF (lhook) CALL dr_hook(
'INIT_FROM_REF_GRID',0,zhook_handle)
387 IF (
SIZE(pt1,2)==3)
THEN
392 IF (tvg%CISBA==
'2-L' .OR. tvg%CISBA==
'3-L')
THEN
394 IF(
SIZE(pt2,2)>3)
THEN
402 pt2(:,1:ilayer1) = pt1(:,1:ilayer1)
405 DO jl=ilayer1+1,ilayer2
406 pt2(:,jl) = pt2(:,ilayer1)
410 ELSEIF(tvg%CISBA==
'DIF')
THEN
414 DO jl=2,tgdo%NGROUND_LAYER
419 DO jl=2,tgdo%NGROUND_LAYER
420 IF(tgdp%XROOTFRAC(ji,jl)<=1.0)
THEN
421 pt2(ji,jl) = pt1(ji,2)
436 zd1(:,jl) = pgrid1(jl)
445 IF (lhook) CALL dr_hook(
'INIT_FROM_REF_GRID',1,zhook_handle)
subroutine prep_hor_teb_garden_field(DTCO, IG, I, UG, U, USS, TGD, TGDO, TGDPE, TGDP, TG, TOP, TVG, HPROGRAM, HSURF, HATMFILE, HATMFILETYPE, HPGDFILE, HPGDFILETYPE, KPATCH)
subroutine prep_teb_garden_ascllv(DTCO, UG, U, USS, HPROGRAM, HSURF, KLUOUT, PFIELD)
subroutine init_from_ref_grid(PGRID1, PT1, PD2, PT2)
subroutine prep_teb_garden_unif(KLUOUT, HSURF, PFIELD)
subroutine abor1_sfx(YTEXT)
subroutine read_prep_garden_snow(HPROGRAM, HSNOW, KSNOW_LAYER, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, OUNIF)
subroutine read_prep_teb_garden_conf(HPROGRAM, HVAR, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, HATMFILE, HATMFILETYPE, HPGDFILE, HPGDFILETYPE, KLUOUT, OUNIF)
subroutine prep_teb_garden_extern(DTCO, I, U, HPROGRAM, HSURF, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, KLUOUT, KPATCH, PFIELD)
subroutine hor_interpol(DTCO, U, KLUOUT, PFIELDIN, PFIELDOUT)
subroutine get_luout(HPROGRAM, KLUOUT)
subroutine put_on_all_vegtypes(KNI, KLAYER, KPATCH, KVEGTYPE, PFIELD_PATCH, PFIELD_VEGTYPE)
subroutine prep_hor_snow_fields(DTCO, IG, U, HPROGRAM, HSURF, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, KLUOUT, OUNIF, KPATCH, KTEB_PATCH, KL, TPSNOW, TPTIME, PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_LWCSNOW, PUNIF_ASNOW, OSNOW_IDEAL, PUNIF_SG1SNOW, PUNIF_SG2SNOW, PUNIF_HISTSNOW, PUNIF_AGESNOW, PVEGTYPE, PVEGTYPE_PATCH, PPATCH, OKEY)
subroutine prep_teb_garden_buffer(HPROGRAM, HSURF, KLUOUT, PFIELD)
subroutine prep_teb_garden_grib(HPROGRAM, HSURF, HFILE, KLUOUT, PFIELD)