7 hprogram,hfield,harea,hfile,hfiletype,punif,pfield,opresent)
58 nvalnbr, nvalcount, xvallist, jpvalmax
62 USE modi_interpol_field
66 USE yomhook
,ONLY : lhook, dr_hook
67 USE parkind1
,ONLY : jprb
71 USE modi_get_surf_mask_n
73 USE modi_get_type_dim_n
86 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
87 CHARACTER(LEN=*),
INTENT(IN) :: hfield
88 CHARACTER(LEN=3),
INTENT(IN) :: harea
94 CHARACTER(LEN=28),
INTENT(IN) :: hfile
95 CHARACTER(LEN=6),
INTENT(IN) :: hfiletype
96 REAL,
INTENT(IN) :: punif
97 REAL,
DIMENSION(:),
INTENT(OUT):: pfield
98 LOGICAL,
OPTIONAL,
INTENT(OUT) :: opresent
106 INTEGER,
DIMENSION(:),
POINTER :: imask
110 CHARACTER(LEN=20) :: yfield
111 CHARACTER(LEN=6) :: ymask
113 REAL,
DIMENSION(NL) :: zfield
114 REAL(KIND=JPRB) :: zhook_handle
120 IF (lhook) CALL dr_hook(
'PGD_FIELD',0,zhook_handle)
122 IF (present(opresent)) opresent=.true.
135 IF (len_trim(hfile)/=0)
THEN
143 ALLOCATE(xsumval(nl))
149 IF(hfield==
"water depth")
THEN
153 IF (catype==
'MAJ')
THEN
154 ALLOCATE(nvalnbr(nl))
155 ALLOCATE(nvalcount(nl,jpvalmax))
156 ALLOCATE(xvallist(nl,jpvalmax))
164 yfield = hfield(1:min(len(hfield),20))
167 hprogram,
'SURF ',hfiletype,
'A_MESH',hfile, &
168 yfield,zfield,harea )
177 WHERE ((u%XTOWN(:)+u%XNATURE(:))==0. .AND. nsize(:)==0 ) nsize(:) = -1
179 WHERE (u%XTOWN (:)==0. .AND. nsize(:)==0 ) nsize(:) = -1
181 WHERE (u%XTOWN (:)==0. .AND. nsize(:)==0 ) nsize(:) = -1
183 WHERE (u%XNATURE(:)==0. .AND. nsize(:)==0 ) nsize(:) = -1
185 WHERE (u%XSEA (:)==0. .AND. nsize(:)==0 ) nsize(:) = -1
187 WHERE (u%XWATER (:)==0. .AND. nsize(:)==0 ) nsize(:) = -1
195 IF (punif/=xundef)
THEN
197 hprogram,iluout,nsize,zfield(:),hfield,pdef=punif,knpts=inpts)
200 hprogram,iluout,nsize,zfield(:),hfield)
205 IF (catype==
'MAJ')
THEN
207 DEALLOCATE(nvalcount)
208 DEALLOCATE(xvallist )
213 ELSEIF (punif/=xundef)
THEN
222 IF (present(opresent))
THEN
224 IF (lhook) CALL dr_hook(
'PGD_FIELD',1,zhook_handle)
229 WRITE(iluout,*)
'***********************************************************'
230 WRITE(iluout,*)
'* Error in PGD field preparation of field : ', hfield
231 WRITE(iluout,*)
'* There is no prescribed value and no input file *'
232 WRITE(iluout,*)
'***********************************************************'
234 CALL
abor1_sfx(
'PGD_FIELD: NO PRESCRIBED VALUE NOR INPUT FILE FOR '//hfield)
256 pfield(:) = zfield(:)
257 IF (lhook) CALL dr_hook(
'PGD_FIELD',1,zhook_handle)
263 IF (idim/=
SIZE(pfield))
THEN
264 WRITE(iluout,*)
'Wrong dimension of MASK: ',idim,
SIZE(pfield)
265 CALL
abor1_sfx(
'PGD_FIELD: WRONG DIMENSION OF MASK')
268 ALLOCATE(imask(idim))
271 ymask,idim,imask,ilu,iluout)
274 IF (lhook) CALL dr_hook(
'PGD_FIELD',1,zhook_handle)
subroutine get_type_dim_n(DTCO, U, HTYPE, KDIM)
subroutine pgd_field(DTCO, UG, U, USS, HPROGRAM, HFIELD, HAREA, HFILE, HFILETYPE, PUNIF, PFIELD, OPRESENT)
subroutine treat_field(UG, U, USS, HPROGRAM, HSCHEME, HFILETYPE, HSUBROUTINE, HFILENAME, HFIELD, PPGDARRAY, HSFTYPE)
subroutine abor1_sfx(YTEXT)
subroutine get_surf_mask_n(DTCO, U, HTYPE, KDIM, KMASK, KLU, KLUOUT)
subroutine get_luout(HPROGRAM, KLUOUT)
subroutine interpol_field(UG, U, HPROGRAM, KLUOUT, KCODE, PFIELD, HFIELD, PDEF, KNPTS)