8 hprogram,hsurf,hatmfile,hatmfiletype,&
9 hpgdfile,hpgdfiletype,onovalue)
53 USE modd_prep, ONLY : cingrid_type, cinterp_type, xzs_ls, xlat_out, xlon_out, &
60 USE modi_read_prep_flake_conf
61 USE modi_prep_flake_grib
62 USE modi_prep_flake_ascllv
63 USE modi_prep_flake_unif
64 USE modi_prep_flake_buffer
67 USE modi_prep_flake_extern
69 USE yomhook
,ONLY : lhook, dr_hook
70 USE parkind1
,ONLY : jprb
85 TYPE(flake_t),
INTENT(INOUT) :: f
87 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
88 CHARACTER(LEN=7),
INTENT(IN) :: hsurf
89 CHARACTER(LEN=28),
INTENT(IN) :: hatmfile
90 CHARACTER(LEN=6),
INTENT(IN) :: hatmfiletype
91 CHARACTER(LEN=28),
INTENT(IN) :: hpgdfile
92 CHARACTER(LEN=6),
INTENT(IN) :: hpgdfiletype
93 LOGICAL,
OPTIONAL,
INTENT(OUT) :: onovalue
98 CHARACTER(LEN=6) :: yfiletype
99 CHARACTER(LEN=28) :: yfile
100 CHARACTER(LEN=6) :: yfilepgdtype
101 CHARACTER(LEN=28) :: yfilepgd
102 REAL,
POINTER,
DIMENSION(:,:) :: zfieldin
103 REAL,
ALLOCATABLE,
DIMENSION(:,:) :: zfieldout
108 REAL(KIND=JPRB) :: zhook_handle
114 IF (lhook) CALL dr_hook(
'PREP_HOR_FLAKE_FIELD',0,zhook_handle)
118 hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,iluout,gunif)
122 gdefault = (yfiletype==
' ' .OR. (hsurf(1:2)/=
'ZS' .AND. hsurf(1:2)/=
'TS' &
123 .AND.
SIZE(fg%XLAT).NE.1)) .AND. .NOT.gunif
124 IF (present(onovalue)) onovalue = gdefault
126 IF (.NOT. gdefault)
THEN
134 ELSE IF (yfiletype==
'ASCLLV')
THEN
136 hprogram,hsurf,iluout,zfieldin)
137 ELSE IF (yfiletype==
'GRIB ')
THEN
139 ELSE IF (yfiletype==
'MESONH' .OR. yfiletype==
'ASCII ' .OR. yfiletype==
'LFI '.OR. yfiletype==
'FA ')
THEN
141 hprogram,hsurf,yfile,yfiletype,yfilepgd,yfilepgdtype,iluout,zfieldin)
142 ELSE IF (yfiletype==
'BUFFER')
THEN
145 CALL
abor1_sfx(
'PREP_HOR_FLAKE_FIELD: data file type not supported : '//yfiletype)
152 ALLOCATE(zfieldout(
SIZE(fg%XLAT),1))
156 IF(gunif .OR.
SIZE(fg%XLAT).EQ.1)
THEN
158 iluout,zfieldin,zfieldout)
159 ELSE IF(hsurf(1:2)==
'ZS' .OR. hsurf(1:2)==
'TS')
THEN
160 WRITE(iluout,*)
"WARNING! Impossible to interpolate lake profiles in horisontal!"
161 WRITE(iluout,*)
"So, interoplate only surface temperature and start from lakes mixed down to the bottom"
163 iluout,zfieldin,zfieldout)
170 ALLOCATE(xzs_ls(
SIZE(zfieldout,1)))
171 xzs_ls(:) = zfieldout(:,1)
173 ALLOCATE(f%XTS(
SIZE(zfieldout,1)))
174 f%XTS(:) = zfieldout(:,1)
176 ALLOCATE(f%XT_SNOW(
SIZE(zfieldout,1)))
177 f%XT_SNOW(:) = zfieldout(:,1)
179 ALLOCATE(f%XT_ICE(
SIZE(zfieldout,1)))
180 f%XT_ICE(:) = zfieldout(:,1)
182 ALLOCATE(f%XT_WML(
SIZE(zfieldout,1)))
183 f%XT_WML(:) = zfieldout(:,1)
185 ALLOCATE(f%XT_BOT(
SIZE(zfieldout,1)))
186 f%XT_BOT(:) = zfieldout(:,1)
188 ALLOCATE(f%XT_B1(
SIZE(zfieldout,1)))
189 f%XT_B1(:) = zfieldout(:,1)
191 ALLOCATE(f%XCT(
SIZE(zfieldout,1)))
192 f%XCT(:) = zfieldout(:,1)
194 ALLOCATE(f%XH_SNOW(
SIZE(zfieldout,1)))
195 f%XH_SNOW(:) = zfieldout(:,1)
197 ALLOCATE(f%XH_ICE(
SIZE(zfieldout,1)))
198 f%XH_ICE(:) = zfieldout(:,1)
200 ALLOCATE(f%XH_ML(
SIZE(zfieldout,1)))
201 f%XH_ML(:) = zfieldout(:,1)
203 ALLOCATE(f%XH_B1(
SIZE(zfieldout,1)))
204 f%XH_B1(:) = zfieldout(:,1)
208 IF (all(zfieldout==xundef)) gdefault = .true.
210 DEALLOCATE(zfieldin )
211 DEALLOCATE(zfieldout)
220 IF (hsurf(1:2)/=
'ZS')
WRITE(iluout,*)
'NO FILE FOR FIELD ',hsurf, &
221 ': UNIFORM DEFAULT FIELD IS PRESCRIBED'
225 IF (lhook) CALL dr_hook(
'PREP_HOR_FLAKE_FIELD',1,zhook_handle)
subroutine prep_flake_unif(KLUOUT, HSURF, PFIELD)
subroutine prep_flake_extern(HPROGRAM, HSURF, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, KLUOUT, PFIELD)
subroutine prep_hor_flake_field(DTCO, UG, U, USS, FG, F, HPROGRAM, HSURF, HATMFILE, HATMFILETYPE, HPGDFILE, HPGDFILETYPE, ONOVALUE)
subroutine abor1_sfx(YTEXT)
subroutine prep_flake_grib(HPROGRAM, HSURF, HFILE, KLUOUT, PFIELD)
subroutine hor_interpol(DTCO, U, KLUOUT, PFIELDIN, PFIELDOUT)
subroutine read_prep_flake_conf(HPROGRAM, HVAR, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, HATMFILE, HATMFILETYPE, HPGDFILE, HPGDFILETYPE, KLUOUT, OUNIF)
subroutine get_luout(HPROGRAM, KLUOUT)
subroutine prep_flake_buffer(HPROGRAM, HSURF, KLUOUT, PFIELD)
subroutine prep_flake_ascllv(DTCO, UG, U, USS, HPROGRAM, HSURF, KLUOUT, PFIELD)