7 hprogram,hfield,harea,hfile,hfiletype,&
8 hncvarname,punif,pfield)
55 USE modi_treat_bathyfield
56 USE modi_interpol_field
58 USE yomhook
,ONLY : lhook, dr_hook
59 USE parkind1
,ONLY : jprb
73 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
74 CHARACTER(LEN=*),
INTENT(IN) :: hfield
75 CHARACTER(LEN=3),
INTENT(IN) :: harea
82 CHARACTER(LEN=28),
INTENT(IN) :: hfile
83 CHARACTER(LEN=6),
INTENT(IN) :: hfiletype
84 CHARACTER(LEN=28),
INTENT(IN) :: hncvarname
85 REAL,
INTENT(IN) :: punif
86 REAL,
DIMENSION(:),
INTENT(OUT):: pfield
94 CHARACTER(LEN=20) :: yfield
96 REAL(KIND=JPRB) :: zhook_handle
102 IF (lhook) CALL dr_hook(
'PGD_BATHYFIELD',0,zhook_handle)
116 IF (len_trim(hfile)/=0)
THEN
124 ALLOCATE(xsumval(nl))
130 yfield = hfield(1:min(len(hfield),20))
133 hprogram,
'SURF ',hfiletype,
'A_MESH',hfile, hncvarname,&
134 yfield,pfield,harea )
143 WHERE (u%XTOWN(:)+u%XNATURE(:)==0. .AND. nsize(:)==0 ) nsize(:) = -1
145 WHERE (u%XTOWN (:)==0. .AND. nsize(:)==0 ) nsize(:) = -1
147 WHERE (u%XNATURE(:)==0. .AND. nsize(:)==0 ) nsize(:) = -1
149 WHERE (u%XSEA (:)==0. .AND. nsize(:)==0 ) nsize(:) = -1
151 WHERE (u%XWATER (:)==0. .AND. nsize(:)==0 ) nsize(:) = -1
161 hprogram,iluout,nsize,pfield(:),hfield)
163 DO jloop=1,
SIZE(pfield)
164 pfield(jloop)=min(pfield(jloop),-1.)
176 ELSEIF (punif/=xundef)
THEN
186 WRITE(iluout,*)
'***********************************************************'
187 WRITE(iluout,*)
'* Error in PGD field preparation of field : ', hfield
188 WRITE(iluout,*)
'* There is no prescribed value and no input file *'
189 WRITE(iluout,*)
'***********************************************************'
191 CALL
abor1_sfx(
'PGD_BATHYFIELD: NO PRESCRIBED VALUE NOR INPUT FILE FOR '//hfield)
201 WHERE (u%XTOWN(:)+u%XNATURE(:)==0.) pfield(:) = xundef
203 WHERE (u%XTOWN (:)==0.) pfield(:) = xundef
205 WHERE (u%XNATURE(:)==0.) pfield(:) = xundef
207 WHERE (u%XSEA (:)==0.) pfield(:) = xundef
209 WHERE (u%XWATER (:)==0.) pfield(:) = xundef
212 IF (lhook) CALL dr_hook(
'PGD_BATHYFIELD',1,zhook_handle)
subroutine abor1_sfx(YTEXT)
subroutine get_luout(HPROGRAM, KLUOUT)
subroutine interpol_field(UG, U, HPROGRAM, KLUOUT, KCODE, PFIELD, HFIELD, PDEF, KNPTS)
subroutine pgd_bathyfield(UG, U, USS, HPROGRAM, HFIELD, HAREA, HFILE, HFILETYPE, HNCVARNAME, PUNIF, PFIELD)
subroutine treat_bathyfield(UG, U, USS, HPROGRAM, HSCHEME, HFILETYPE, HSUBROUTINE, HFILENAME, HNCVARNAME, HFIELD, PPGDARRAY, HSFTYPE)