7 hprogram,hsurf,hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,okey)
52 USE modd_prep, ONLY : xzs_ls, linterp, cmask
55 xwsnow, xrsnow, xtsnow, xlwcsnow, xasnow, &
56 xsg1snow, xsg2snow, xhistsnow, xagesnow
63 USE modi_read_prep_isba_conf
64 USE modi_read_prep_isba_snow
65 USE modi_prep_isba_ascllv
66 USE modi_prep_isba_grib
67 USE modi_prep_isba_unif
68 USE modi_prep_isba_buffer
71 USE modi_put_on_all_vegtypes
72 USE modi_vegtype_grid_to_patch_grid
73 USE modi_prep_hor_snow_fields
75 USE modi_prep_isba_extern
76 USE modi_prep_isba_netcdf
77 USE modi_vegtype_to_patch
79 USE yomhook
,ONLY : lhook, dr_hook
80 USE parkind1
,ONLY : jprb
88 TYPE(isba_grid_t
),
INTENT(INOUT) :: ig
89 TYPE(isba_t
),
INTENT(INOUT) :: i
94 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
95 CHARACTER(LEN=7),
INTENT(IN) :: hsurf
96 CHARACTER(LEN=28),
INTENT(IN) :: hatmfile
97 CHARACTER(LEN=6),
INTENT(IN) :: hatmfiletype
98 CHARACTER(LEN=28),
INTENT(IN) :: hpgdfile
99 CHARACTER(LEN=6),
INTENT(IN) :: hpgdfiletype
101 LOGICAL,
OPTIONAL,
INTENT(INOUT):: okey
105 CHARACTER(LEN=6) :: yfiletype
106 CHARACTER(LEN=28) :: yfile
107 CHARACTER(LEN=6) :: yfiletype_snow
108 CHARACTER(LEN=28) :: yfile_snow
109 CHARACTER(LEN=6) :: yfilepgdtype_snow
110 CHARACTER(LEN=28) :: yfilepgd_snow
111 CHARACTER(LEN=6) :: yfilepgdtype
112 CHARACTER(LEN=28) :: yfilepgd
113 REAL,
POINTER,
DIMENSION(:,:,:) :: zfieldin
114 REAL,
POINTER,
DIMENSION(:,:) :: zfield, zpatch
115 REAL,
ALLOCATABLE,
DIMENSION(:,:,:) :: zfieldoutp
116 REAL,
ALLOCATABLE,
DIMENSION(:,:,:) :: zfieldoutv
117 REAL,
ALLOCATABLE,
DIMENSION(:,:,:) :: zw
118 REAL,
ALLOCATABLE,
DIMENSION(:,:,:) :: zf
119 REAL,
ALLOCATABLE,
DIMENSION(:,:,:) :: zdg
123 LOGICAL :: gunif_snow
126 INTEGER :: ini, inl, inp, jj, jl, ip_i, ip_o, jp, jveg
127 INTEGER,
DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,3)) :: iwork
128 REAL(KIND=JPRB) :: zhook_handle
134 IF (lhook) CALL dr_hook(
'PREP_HOR_ISBA_FIELD',0,zhook_handle)
138 hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,iluout,gunif)
148 IF (hsurf==
'SN_VEG ')
THEN
149 CALL
read_prep_isba_snow(hprogram,i%TSNOW%SCHEME,i%TSNOW%NLAYER,yfile_snow,yfiletype_snow,&
150 yfilepgd_snow,yfilepgdtype_snow,gunif_snow)
151 IF(.NOT.gunif_snow.AND.len_trim(yfile_snow)==0.AND.len_trim(yfiletype_snow)==0)
THEN
152 IF(len_trim(yfile)/=0.AND.len_trim(yfiletype)/=0)
THEN
154 yfiletype_snow=yfiletype
155 yfilepgd_snow =yfilepgd
156 yfilepgdtype_snow=yfilepgdtype
159 IF(all(xwsnow==xundef))xwsnow=0.0
165 yfile_snow, yfiletype_snow, &
166 yfilepgd_snow, yfilepgdtype_snow, &
167 iluout, gunif_snow, i%NPATCH, 1, &
168 ini,i%TSNOW, i%TTIME, &
169 xwsnow, xrsnow, xtsnow, xlwcsnow, &
170 xasnow, lsnow_ideal, xsg1snow, &
171 xsg2snow, xhistsnow, xagesnow, &
172 i%XVEGTYPE, i%XVEGTYPE_PATCH, i%XPATCH, &
180 DEALLOCATE(xhistsnow)
182 IF (lhook) CALL dr_hook(
'PREP_HOR_ISBA_FIELD',1,zhook_handle)
192 ELSE IF (yfiletype==
'ASCLLV')
THEN
194 hprogram,hsurf,iluout,zfieldin)
195 ELSE IF (yfiletype==
'GRIB ')
THEN
197 ELSE IF (yfiletype==
'MESONH' .OR. yfiletype==
'ASCII ' .OR. yfiletype==
'LFI '.OR.yfiletype==
'FA ')
THEN
199 hprogram,hsurf,yfile,yfiletype,yfilepgd,yfilepgdtype,iluout,zfieldin,okey)
200 ELSE IF (yfiletype==
'BUFFER')
THEN
202 hprogram,hsurf,iluout,zfieldin)
203 ELSE IF (yfiletype==
'NETCDF')
THEN
205 hprogram,hsurf,yfile,iluout,zfieldin)
207 CALL
abor1_sfx(
'PREP_HOR_ISBA_FIELD: data file type not supported : '//yfiletype)
214 inl =
SIZE(zfieldin,2)
215 inp =
SIZE(zfieldin,3)
217 ALLOCATE(zfieldoutp(ini,inl,inp))
218 ALLOCATE(zfield(
SIZE(zfieldin,1),inl))
220 ALLOCATE(zpatch(ini,inp))
223 IF (inp==nvegtype)
THEN
224 zpatch(:,:) = i%XVEGTYPE(:,:)
225 ELSEIF (inp==i%NPATCH)
THEN
226 zpatch(:,:) = i%XPATCH(:,:)
227 ELSEIF (inp<i%NPATCH)
THEN
237 zpatch(:,ip_i) = zpatch(:,ip_i) + i%XPATCH(:,ip_o)
242 ELSEIF (inp>i%NPATCH)
THEN
252 zpatch(:,ip_i) = i%XPATCH(:,ip_o)
261 zfield=zfieldin(:,:,jpatch)
262 linterp(:) = (zpatch(:,jpatch) > 0.)
264 iluout,zfield,zfieldoutp(:,:,jpatch))
271 ALLOCATE(zfieldoutv(ini,inl,nvegtype))
275 DEALLOCATE(zfieldoutp)
281 ALLOCATE(zw(ini,
SIZE(zfieldoutv,2),i%NPATCH))
296 ALLOCATE(xzs_ls(ini))
297 xzs_ls(:) = zfieldoutv(:,1,1)
302 ALLOCATE(zf(ini,i%NGROUND_LAYER,i%NPATCH))
308 ALLOCATE(i%XWG(ini,i%NGROUND_LAYER,i%NPATCH))
310 IF(i%CISBA==
'DIF')
THEN
311 iwork(:,:)=i%NWG_LAYER(:,:)
313 iwork(:,:)=
SIZE(i%XWG,2)
317 IF(iwork(jj,jpatch)==nundef)cycle
320 i%XWG(jj,jl,jpatch) = i%XWWILT(jj,jl) + zf(jj,jl,jpatch) * (i%XWFC(jj,jl)-i%XWWILT(jj,jl))
321 i%XWG(jj,jl,jpatch) = max(min(i%XWG(jj,jl,jpatch),i%XWSAT(jj,jl)),xwgmin)
326 WHERE(zf(:,:,:)==xundef)i%XWG(:,:,:)=xundef
333 ALLOCATE(zf(ini,i%NGROUND_LAYER,i%NPATCH))
339 ALLOCATE(i%XWGI(ini,i%NGROUND_LAYER,i%NPATCH))
341 IF(i%CISBA==
'DIF')
THEN
342 iwork(:,:)=i%NWG_LAYER(:,:)
348 IF(iwork(jj,jpatch)==nundef)cycle
351 i%XWGI(jj,jl,jpatch) = zf(jj,jl,jpatch) * i%XWSAT(jj,jl)
352 i%XWGI(jj,jl,jpatch) = max(min(i%XWGI(jj,jl,jpatch),i%XWSAT(jj,jl)),0.)
357 WHERE(zf(:,:,:)==xundef )i%XWGI(:,:,:)=xundef
358 WHERE(i%XWGI(:,:,:)<=1.0e-10)i%XWGI(:,:,:)=0.0
370 ALLOCATE(i%XTG(ini,inl,i%NPATCH))
371 ALLOCATE(zdg(
SIZE(i%XDG,1),inl,
SIZE(i%XDG,3)))
372 IF (i%CISBA==
'2-L'.OR.i%CISBA==
'3-L')
THEN
374 zdg(:,1,jpatch) = 0.01
375 zdg(:,2,jpatch) = 0.40
376 IF(i%CISBA==
'3-L') zdg(:,3,jpatch) = 5.00
380 zdg(:,3,jpatch) = 1.0
382 zdg(:,jl,jpatch) = zdg(:,jl-1,jpatch)+1.0
388 zdg(:,:,:) = i%XDG(:,:,:)
396 ALLOCATE(i%XWR(ini,i%NPATCH))
398 i%XWR(:,jpatch) = zw(:,1,jpatch)
404 ALLOCATE(i%XWRL(ini,i%NPATCH))
406 i%XWRL(:,jpatch) = zw(:,1,jpatch)
412 ALLOCATE(i%XWRLI(ini,i%NPATCH))
414 i%XWRLI(:,jpatch) = zw(:,1,jpatch)
420 ALLOCATE(i%XWRVN(ini,i%NPATCH))
422 i%XWRVN(:,jpatch) = zw(:,1,jpatch)
428 ALLOCATE(i%XTV(ini,i%NPATCH))
430 i%XTV(:,jpatch) = zw(:,1,jpatch)
436 ALLOCATE(i%XTL(ini,i%NPATCH))
438 i%XTL(:,jpatch) = zw(:,1,jpatch)
444 ALLOCATE(i%XTC(ini,i%NPATCH))
446 i%XTC(:,jpatch) = zw(:,1,jpatch)
452 ALLOCATE(i%XQC(ini,i%NPATCH))
454 i%XQC(:,jpatch) = zw(:,1,jpatch)
461 IF (any(zw(:,:,:)/=xundef))
THEN
463 i%XLAI(:,jpatch) = zw(:,1,jpatch)
470 ALLOCATE(i%XICE_STO(ini,i%NPATCH))
472 i%XICE_STO(:,jpatch) = zw(:,1,jpatch)
482 DEALLOCATE(zfieldin )
483 DEALLOCATE(zfieldoutv)
485 IF (lhook) CALL dr_hook(
'PREP_HOR_ISBA_FIELD',1,zhook_handle)
499 REAL,
DIMENSION(:,:,:),
INTENT(IN) :: pt1
500 REAL,
DIMENSION(:),
INTENT(IN) :: pgrid1
501 REAL,
DIMENSION(:,:,:),
INTENT(IN) :: pd2
502 REAL,
DIMENSION(:,:,:),
INTENT(OUT) :: pt2
505 REAL,
DIMENSION(SIZE(PT1,1),SIZE(PT1,2)) :: zd1
506 REAL,
DIMENSION(SIZE(PD2,1),SIZE(PD2,2)) :: zd2
508 INTEGER :: ilayer1, ilayer2
509 REAL(KIND=JPRB) :: zhook_handle
513 IF (lhook) CALL dr_hook(
'INIT_FROM_REF_GRID',0,zhook_handle)
516 IF (
SIZE(pt1,2)==3)
THEN
522 IF (i%CISBA==
'2-L' .OR. i%CISBA==
'3-L')
THEN
524 IF(
SIZE(pt2,2)>3)
THEN
533 pt2(:,1:ilayer1,jpatch) = pt1(:,1:ilayer1,jpatch)
536 DO jl=ilayer1+1,ilayer2
537 pt2(:,jl,jpatch) = pt2(:,ilayer1,jpatch)
541 ELSEIF(i%CISBA==
'DIF')
THEN
544 pt2(:,1,jpatch) = pt1(:,1,jpatch)
546 pt2(:,2,jpatch) = 0.25*pt1(:,1,jpatch)+0.75*pt1(:,2,jpatch)
549 DO jl=3,i%NGROUND_LAYER
550 IF(pd2(ji,jl,jpatch)<=i%XDG2(ji,jpatch))
THEN
552 pt2(ji,jl,jpatch) = pt1(ji,2,jpatch)
555 pt2(ji,jl,jpatch) = pt1(ji,3,jpatch)
570 zd1(:,jl) = pgrid1(jl)
574 zd2(:,:) = pd2(:,:,jpatch)
582 IF (lhook) CALL dr_hook(
'INIT_FROM_REF_GRID',1,zhook_handle)
subroutine prep_isba_grib(HPROGRAM, HSURF, HFILE, KLUOUT, PFIELD, OKEY)
subroutine prep_isba_netcdf(DTCO, U, HPROGRAM, HSURF, HFILE, KLUOUT, PFIELD)
subroutine init_from_ref_grid(PGRID1, PT1, PD2, PT2)
subroutine prep_isba_buffer(IG, U, HPROGRAM, HSURF, KLUOUT, PFIELD)
subroutine prep_isba_ascllv(DTCO, UG, U, USS, HPROGRAM, HSURF, KLUOUT, PFIELD)
subroutine prep_hor_isba_field(DTCO, IG, I, UG, U, USS, HPROGRAM, HSURF, HATMFILE, HATMFILETYPE, HPGDFILE, HPGDFILETYPE, OKEY)
integer function vegtype_to_patch(IVEGTYPE, INPATCH)
subroutine abor1_sfx(YTEXT)
subroutine hor_interpol(DTCO, U, KLUOUT, PFIELDIN, PFIELDOUT)
subroutine read_prep_isba_conf(HPROGRAM, HVAR, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, HATMFILE, HATMFILETYPE, HPGDFILE, HPGDFILETYPE, KLUOUT, OUNIF)
subroutine vegtype_grid_to_patch_grid(KPATCH, PVEGTYPE_PATCH, PPATCH, PFIELDOUT, PW)
subroutine prep_isba_extern(DTCO, I, U, HPROGRAM, HSURF, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, KLUOUT, PFIELD, OKEY)
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_isba_unif(KLUOUT, HSURF, PFIELD)
subroutine read_prep_isba_snow(HPROGRAM, HSNOW, KSNOW_LAYER, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, OUNIF)