8 plat,plon,pfield,ointerp,pzs,ndim2)
50 USE yomhook
,ONLY : lhook, dr_hook
51 USE parkind1
,ONLY : jprb
59 INTEGER,
INTENT(IN) :: ndim
60 REAL,
DIMENSION(NDIM),
INTENT(IN) :: plat_in
61 REAL,
DIMENSION(NDIM),
INTENT(IN) :: plon_in
62 REAL,
DIMENSION(NDIM),
INTENT(IN) :: pfield_in
63 REAL,
DIMENSION(NDIM),
INTENT(IN) :: plat
64 REAL,
DIMENSION(NDIM),
INTENT(IN) :: plon
65 REAL,
DIMENSION(NDIM),
INTENT(INOUT) :: pfield
66 LOGICAL,
DIMENSION(NDIM),
INTENT(IN) :: ointerp
67 REAL,
DIMENSION(NDIM),
OPTIONAL,
INTENT(IN) :: pzs
68 INTEGER,
OPTIONAL,
INTENT(IN) :: ndim2
80 REAL,
PARAMETER :: zlimmax = 1.
84 INTEGER :: jisc1,jisc2,jzlimcnt
86 REAL :: zlonsc, zdlat, zdlon, zconv, zr_earth
87 REAL(KIND=JPRB) :: zhook_handle
93 IF (lhook) CALL dr_hook(
'OI_HOR_EXTRAPOL_SURF',0,zhook_handle)
104 IF (count(pfield_in(:)/=xundef)==0 .AND. lhook) CALL dr_hook(
'OI_HOR_EXTRAPOL_SURF',1,zhook_handle)
105 IF (count(pfield_in(:)/=xundef)==0)
RETURN
115 IF (pfield(ji)/=xundef) cycle
116 IF (.NOT. ointerp(ji)) cycle
125 zcosla=cos(zlat*zconv)
126 IF (present(pzs)) zzs_out=pzs(ji)
127 IF ( present(ndim2))
THEN
128 jisc1=max((ji-ndim2),1)
129 jisc2=min((ji+ndim2),ndim)
141 IF (pfield_in(jisc)/=xundef)
THEN
142 zlonsc = plon_in(jisc)
143 IF (zlonsc-zlon> 180.) zlonsc = zlonsc - 360.0
144 IF (zlonsc-zlon<-180.) zlonsc = zlonsc + 360.0
145 zdlat = (plat_in(jisc)-zlat)*zconv
146 zdlon = (zlonsc-zlon)*zconv
147 zdist = zdlat*zdlat + zdlon*zdlon*zcosla*zcosla
148 IF (zdist<=zndist)
THEN
149 zfield=pfield_in(jisc)
150 IF (present(pzs)) zzs_out=pzs(jisc)
157 IF ( zndist == xundef )
THEN
158 CALL
abor1_sfx(
"Extrapolated point is undefined! No nearby point found.")
159 ELSEIF ( zndist > (zlimmax*zconv) )
THEN
161 & CALL
abor1_sfx(
"Distance to extrapolated point is to large. Increase ZLIMMAX or NDIM2")
162 jzlimcnt = jzlimcnt + 1
164 IF (present(pzs))
THEN
165 pfield(ji) = zfield + (zzs_out - pzs(ji))*0.0065
172 IF ( jzlimcnt > 0 )
THEN
173 print *,
'Points with extrapolation distance > ',zlimmax,
' degrees are ',jzlimcnt
176 IF (lhook) CALL dr_hook(
'OI_HOR_EXTRAPOL_SURF',1,zhook_handle)
subroutine abor1_sfx(YTEXT)