166 |
do bi = mybxlo(mythid), mybxhi(mythid) |
do bi = mybxlo(mythid), mybxhi(mythid) |
167 |
|
|
168 |
C check validity of input/output coordinates |
C check validity of input/output coordinates |
169 |
if ( xG(1,1 ,bi,bj) .le. x_in(0) .or. |
#ifdef ALLOW_DEBUG |
170 |
& xG(snx,1,bi,bj) .ge. x_in(nx_in+1) .or. |
if ( debugLevel .ge. debLevB ) then |
171 |
& yG(1,1 ,bi,bj) .lt. y_in(1) .or. |
do i=1,snx |
172 |
& yG(1,sny,bi,bj) .gt. y_in(ny_in) ) then |
do j=1,sny |
173 |
print*,'ERROR in S/R EXF_INTERP:' |
if ( xG(i,j,bi,bj) .lt. x_in(0) .or. |
174 |
print*,' input grid must encompass output grid.' |
& xG(i,j,bi,bj) .ge. x_in(nx_in+1) .or. |
175 |
STOP ' ABNORMAL END: S/R EXF_INTERP' |
& yG(i,j,bi,bj) .lt. y_in(0) .or. |
176 |
|
& yG(i,j,bi,bj) .ge. y_in(ny_in+1) ) then |
177 |
|
print*,'ERROR in S/R EXF_INTERP:' |
178 |
|
print*,' input grid must encompass output grid.' |
179 |
|
print*,'i,j,bi,bj' ,i,j,bi,bj |
180 |
|
print*,'xG,yG' ,xG(i,j,bi,bj),yG(i,j,bi,bj) |
181 |
|
print*,'nx_in,ny_in' ,nx_in ,ny_in |
182 |
|
print*,'x_in(0,nx_in+1)',x_in(0) ,x_in(nx_in+1) |
183 |
|
print*,'y_in(0,ny_in+1)',y_in(0) ,y_in(ny_in+1) |
184 |
|
STOP ' ABNORMAL END: S/R EXF_INTERP' |
185 |
|
endif |
186 |
|
enddo |
187 |
|
enddo |
188 |
endif |
endif |
189 |
|
#endif /* ALLOW_DEBUG */ |
190 |
|
|
191 |
C compute interpolation indices |
C compute interpolation indices |
192 |
do i=1,snx |
do i=1,snx |
197 |
w_ind(i,j) = int((xG(i,j,bi,bj)-x_in(1))/lon_inc) |
w_ind(i,j) = int((xG(i,j,bi,bj)-x_in(1))/lon_inc) |
198 |
endif |
endif |
199 |
e_ind(i,j) = w_ind(i,j) + 1 |
e_ind(i,j) = w_ind(i,j) + 1 |
200 |
js = ny_in/2 |
js = ny_in*.5 |
201 |
do while (yG(i,j,bi,bj) .lt. y_in(js)) |
do while (yG(i,j,bi,bj) .lt. y_in(js)) |
202 |
js = (js + 1)/2 |
js = (js - 1)*.5 |
203 |
enddo |
enddo |
204 |
do while (yG(i,j,bi,bj) .ge. y_in(js+1)) |
do while (yG(i,j,bi,bj) .ge. y_in(js+1)) |
205 |
js = js + 1 |
js = js + 1 |