7 hprogram,hsurf,hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,kpatch)
46 USE modd_prep, ONLY : cingrid_type, cinterp_type, xzs_ls, xlat_out, xlon_out, &
48 USE modd_prep_teb, ONLY : xgrid_roof, xgrid_road, xgrid_wall, xgrid_floor, lsnow_ideal_teb, &
49 xwsnow_roof, xrsnow_roof, xtsnow_roof, xlwcsnow_roof, xasnow_roof, &
50 xwsnow_road, xrsnow_road, xtsnow_road, xlwcsnow_road, xasnow_road, &
51 xhui_bld, xhui_bld_def
58 USE modi_read_prep_teb_conf
59 USE modi_read_prep_teb_snow
60 USE modi_prep_teb_grib
61 USE modi_prep_teb_unif
62 USE modi_prep_teb_buffer
64 USE modi_prep_hor_snow_fields
66 USE modi_prep_teb_extern
68 USE yomhook
,ONLY : lhook, dr_hook
69 USE parkind1
,ONLY : jprb
77 TYPE(bem_t),
INTENT(INOUT) :: b
80 TYPE(isba_grid_t
),
INTENT(INOUT) :: ig
83 TYPE(teb_t),
INTENT(INOUT) :: t
86 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
87 CHARACTER(LEN=7),
INTENT(IN) :: hsurf
88 CHARACTER(LEN=28),
INTENT(IN) :: hatmfile
89 CHARACTER(LEN=6),
INTENT(IN) :: hatmfiletype
90 CHARACTER(LEN=28),
INTENT(IN) :: hpgdfile
91 CHARACTER(LEN=6),
INTENT(IN) :: hpgdfiletype
93 INTEGER,
INTENT(IN) :: kpatch
97 CHARACTER(LEN=6) :: yfiletype
98 CHARACTER(LEN=28) :: yfile
99 CHARACTER(LEN=6) :: yfilepgdtype
100 CHARACTER(LEN=28) :: yfilepgd
101 REAL,
DIMENSION(:),
ALLOCATABLE :: zsg1snow, zsg2snow, zhistsnow, zagesnow
102 REAL,
POINTER,
DIMENSION(:,:) :: zfieldin
103 REAL,
ALLOCATABLE,
DIMENSION(:,:) :: zfieldout
104 REAL,
ALLOCATABLE,
DIMENSION(:) :: zps
105 REAL,
PARAMETER :: zrhoa=1.19
109 REAL(KIND=JPRB) :: zhook_handle
115 IF (lhook) CALL dr_hook(
'PREP_HOR_TEB_FIELD',0,zhook_handle)
119 hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,iluout,gunif)
127 IF (hsurf==
'SN_ROOF')
THEN
129 t%CUR%TSNOW_ROAD%SCHEME,t%CUR%TSNOW_ROAD%NLAYER,&
130 yfile,yfiletype,yfilepgd,yfilepgdtype)
131 IF (len_trim(yfile)>0 .AND. len_trim(yfiletype)>0) gunif = .false.
132 ALLOCATE(zsg1snow(
SIZE(xwsnow_roof)))
133 ALLOCATE(zsg2snow(
SIZE(xwsnow_roof)))
134 ALLOCATE(zhistsnow(
SIZE(xwsnow_roof)))
135 ALLOCATE(zagesnow(
SIZE(xwsnow_roof)))
140 yfilepgd, yfilepgdtype, &
141 iluout,gunif,1,kpatch, &
142 SIZE(tg%XLAT),t%CUR%TSNOW_ROOF, top%TTIME,&
143 xwsnow_roof, xrsnow_roof, &
144 xtsnow_roof, xlwcsnow_roof, &
146 lsnow_ideal_teb, zsg1snow, &
147 zsg2snow, zhistsnow, zagesnow)
150 DEALLOCATE(zhistsnow)
152 IF (lhook) CALL dr_hook(
'PREP_HOR_TEB_FIELD',1,zhook_handle)
154 ELSE IF (hsurf==
'SN_ROAD')
THEN
156 t%CUR%TSNOW_ROAD%SCHEME,t%CUR%TSNOW_ROAD%NLAYER,&
157 yfile,yfiletype,yfilepgd,yfilepgdtype)
158 IF (len_trim(yfile)>0 .AND. len_trim(yfiletype)>0) gunif = .false.
159 ALLOCATE(zsg1snow(
SIZE(xwsnow_road)))
160 ALLOCATE(zsg2snow(
SIZE(xwsnow_road)))
161 ALLOCATE(zhistsnow(
SIZE(xwsnow_road)))
162 ALLOCATE(zagesnow(
SIZE(xwsnow_road)))
167 yfilepgd, yfilepgdtype, &
168 iluout,gunif,1,kpatch, &
169 SIZE(tg%XLAT),t%CUR%TSNOW_ROAD, top%TTIME,&
170 xwsnow_road, xrsnow_road, &
171 xtsnow_road, xlwcsnow_road, &
173 lsnow_ideal_teb, zsg1snow, &
174 zsg2snow, zhistsnow, zagesnow)
177 DEALLOCATE(zhistsnow)
179 IF (lhook) CALL dr_hook(
'PREP_HOR_TEB_FIELD',1,zhook_handle)
188 ELSE IF (yfiletype==
'GRIB ')
THEN
190 ELSE IF (yfiletype==
'MESONH' .OR. yfiletype==
'ASCII ' .OR. yfiletype==
'LFI '.OR. yfiletype==
'FA ')
THEN
192 hprogram,hsurf,yfile,yfiletype,yfilepgd,yfilepgdtype,iluout,kpatch,zfieldin)
193 ELSE IF (yfiletype==
'BUFFER')
THEN
196 CALL
abor1_sfx(
'PREP_HOR_TEB_FIELD: data file type not supported : '//yfiletype)
201 ALLOCATE(zfieldout(
SIZE(tg%XLAT),
SIZE(zfieldin,2)))
204 iluout,zfieldin,zfieldout)
210 ALLOCATE(xzs_ls(
SIZE(zfieldout,1)))
211 xzs_ls(:) = zfieldout(:,1)
213 ALLOCATE(t%CUR%XWS_ROOF(
SIZE(zfieldout,1)))
214 t%CUR%XWS_ROOF(:) = zfieldout(:,1)
216 ALLOCATE(t%CUR%XWS_ROAD(
SIZE(zfieldout,1)))
217 t%CUR%XWS_ROAD(:) = zfieldout(:,1)
219 ALLOCATE(t%CUR%XTI_ROAD(
SIZE(zfieldout,1)))
220 t%CUR%XTI_ROAD(:) = zfieldout(:,1)
222 ALLOCATE(b%CUR%XTI_BLD (
SIZE(zfieldout,1)))
223 b%CUR%XTI_BLD (:) = zfieldout(:,1)
225 ALLOCATE(b%CUR%XQI_BLD (
SIZE(zfieldout,1)))
226 IF (all(zfieldout .GE. xundef-1.e+5 .AND. zfieldout .LE. xundef+1.e+5))
THEN
227 ALLOCATE(zps(
SIZE(zfieldout,1)))
228 zps = xp00 - zrhoa * xg * xzs_ls
229 IF (xhui_bld==xundef)
THEN
230 zfieldout(:,1) = xhui_bld_def *
qsat(b%CUR%XTI_BLD, zps)
232 zfieldout(:,1) = xhui_bld *
qsat(b%CUR%XTI_BLD, zps)
236 b%CUR%XQI_BLD (:) = zfieldout(:,1)
238 ALLOCATE(b%CUR%XT_WIN1 (
SIZE(zfieldout,1)))
239 b%CUR%XT_WIN1 (:) = zfieldout(:,1)
241 ALLOCATE(b%CUR%XT_WIN2 (
SIZE(zfieldout,1)))
242 b%CUR%XT_WIN2 (:) = zfieldout(:,1)
244 ALLOCATE(b%CUR%XT_FLOOR(
SIZE(zfieldout,1),bop%NFLOOR_LAYER))
247 ALLOCATE(b%CUR%XT_MASS(
SIZE(zfieldout,1),bop%NFLOOR_LAYER))
250 ALLOCATE(t%CUR%XT_ROAD(
SIZE(zfieldout,1),top%NROAD_LAYER))
253 ALLOCATE(t%CUR%XT_WALL_A(
SIZE(zfieldout,1),top%NWALL_LAYER))
256 ALLOCATE(t%CUR%XT_WALL_B(
SIZE(zfieldout,1),top%NWALL_LAYER))
257 IF (top%CWALL_OPT==
'UNIF')
THEN
258 t%CUR%XT_WALL_B = t%CUR%XT_WALL_A
263 ALLOCATE(t%CUR%XT_ROOF(
SIZE(zfieldout,1),top%NROOF_LAYER))
266 ALLOCATE(t%CUR%XT_CANYON(
SIZE(zfieldout,1)))
267 t%CUR%XT_CANYON (:) = zfieldout(:,1)
269 ALLOCATE(t%CUR%XQ_CANYON(
SIZE(zfieldout,1)))
270 t%CUR%XQ_CANYON (:) = zfieldout(:,1)
277 DEALLOCATE(zfieldin )
278 DEALLOCATE(zfieldout)
279 IF (lhook) CALL dr_hook(
'PREP_HOR_TEB_FIELD',1,zhook_handle)
292 REAL,
DIMENSION(:,:),
INTENT(IN) :: pt1
293 REAL,
DIMENSION(:),
INTENT(IN) :: pgrid1
294 REAL,
DIMENSION(:,:),
INTENT(IN) :: pd2
295 REAL,
DIMENSION(:,:),
INTENT(OUT) :: pt2
298 REAL,
DIMENSION(SIZE(PT1,1),SIZE(PT1,2)) :: zd1
299 REAL,
DIMENSION(SIZE(PD2,1),SIZE(PD2,2)) :: zd2
300 REAL,
DIMENSION(SIZE(PD2,1)) :: zd
301 REAL(KIND=JPRB) :: zhook_handle
303 IF (lhook) CALL dr_hook(
'INIT_FROM_REF_GRID',0,zhook_handle)
308 zd2(:,jl) = zd(:) + pd2(:,jl)/2.
309 zd(:) = zd(:) + pd2(:,jl)
313 zd1(:,jl) = pgrid1(jl) * zd(:)
317 IF (lhook) CALL dr_hook(
'INIT_FROM_REF_GRID',1,zhook_handle)
subroutine prep_hor_teb_field(B, BOP, DTCO, IG, U, TG, T, TOP, HPROGRAM, HSURF, HATMFILE, HATMFILETYPE, HPGDFILE, HPGDFILETYPE, KPATCH)
subroutine init_from_ref_grid(PGRID1, PT1, PD2, PT2)
subroutine read_prep_teb_conf(HPROGRAM, HVAR, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, HATMFILE, HATMFILETYPE, HPGDFILE, HPGDFILETYPE, KLUOUT, OUNIF)
subroutine read_prep_teb_snow(HPROGRAM, HSNOW_ROOF, KSNOW_ROOF, HSNOW_ROAD, KSNOW_ROAD, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE)
subroutine abor1_sfx(YTEXT)
subroutine hor_interpol(DTCO, U, KLUOUT, PFIELDIN, PFIELDOUT)
subroutine prep_teb_grib(HPROGRAM, HSURF, HFILE, KLUOUT, PFIELD)
subroutine get_luout(HPROGRAM, KLUOUT)
subroutine prep_teb_extern(DTCO, HPROGRAM, HSURF, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, KLUOUT, KPATCH, PFIELD)
subroutine prep_teb_buffer(HPROGRAM, HSURF, KLUOUT, PFIELD)
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_unif(KLUOUT, HSURF, PFIELD)