27 |
numer = 1. _d 0 |
numer = 1. _d 0 |
28 |
denom = 1. _d 0 |
denom = 1. _d 0 |
29 |
|
|
30 |
|
#ifdef TARGET_NEC_SX |
31 |
|
!CDIR UNROLL=8 |
32 |
|
#endif /* TARGET_NEC_SX */ |
33 |
do k=1,sp |
do k=1,sp |
34 |
if ( k .ne. i) then |
if ( k .ne. i) then |
35 |
denom = denom*(a(i) - a(k)) |
denom = denom*(a(i) - a(k)) |
94 |
_RL NorthValue |
_RL NorthValue |
95 |
_RL x_in (-1:nx_in+2), y_in(-1:ny_in+2) |
_RL x_in (-1:nx_in+2), y_in(-1:ny_in+2) |
96 |
integer i, j, k, l, js, bi, bj, sp, interp_unit |
integer i, j, k, l, js, bi, bj, sp, interp_unit |
97 |
|
#ifdef TARGET_NEC_SX |
98 |
|
integer ic, ii, icnt |
99 |
|
integer inx(snx*sny,2) |
100 |
|
#endif |
101 |
_RS xG(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
_RS xG(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
102 |
_RL ninety |
_RL ninety |
103 |
PARAMETER ( ninety = 90. ) |
PARAMETER ( ninety = 90. ) |
216 |
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) |
217 |
endif |
endif |
218 |
e_ind(i,j) = w_ind(i,j) + 1 |
e_ind(i,j) = w_ind(i,j) + 1 |
219 |
|
enddo |
220 |
|
enddo |
221 |
|
#ifndef TARGET_NEC_SX |
222 |
|
C use the original and more readable variant of the algorithm that |
223 |
|
C has unvectorizable while-loops for each (i,j) |
224 |
|
do i=1,snx |
225 |
|
do j=1,sny |
226 |
js = ny_in*.5 |
js = ny_in*.5 |
227 |
do while (yG(i,j,bi,bj) .lt. y_in(js)) |
do while (yG(i,j,bi,bj) .lt. y_in(js)) |
228 |
js = (js - 1)*.5 |
js = (js - 1)*.5 |
231 |
js = js + 1 |
js = js + 1 |
232 |
enddo |
enddo |
233 |
s_ind(i,j) = js |
s_ind(i,j) = js |
234 |
n_ind(i,j) = js + 1 |
enddo |
235 |
|
enddo |
236 |
|
#else /* TARGET_NEC_SX defined */ |
237 |
|
C this variant vectorizes more efficiently than the original one because |
238 |
|
C it moves the while loops out of the i,j loops (loop pushing) but |
239 |
|
C it is ugly and incomprehensible |
240 |
|
icnt = 0 |
241 |
|
do j=1,sny |
242 |
|
do i=1,snx |
243 |
|
s_ind(i,j) = ny_in*.5 |
244 |
|
icnt = icnt+1 |
245 |
|
inx(icnt,1) = i |
246 |
|
inx(icnt,2) = j |
247 |
|
enddo |
248 |
|
enddo |
249 |
|
do while (icnt .gt. 0) |
250 |
|
ii = 0 |
251 |
|
!CDIR NODEP |
252 |
|
do ic=1,icnt |
253 |
|
i = inx(ic,1) |
254 |
|
j = inx(ic,2) |
255 |
|
if (yG(i,j,bi,bj) .lt. y_in(s_ind(i,j))) then |
256 |
|
s_ind(i,j) = (s_ind(i,j) - 1)*.5 |
257 |
|
ii = ii+1 |
258 |
|
inx(ii,1) = i |
259 |
|
inx(ii,2) = j |
260 |
|
endif |
261 |
|
enddo |
262 |
|
icnt = ii |
263 |
|
enddo |
264 |
|
icnt = 0 |
265 |
|
do j=1,sny |
266 |
|
do i=1,snx |
267 |
|
icnt = icnt+1 |
268 |
|
inx(icnt,1) = i |
269 |
|
inx(icnt,2) = j |
270 |
|
enddo |
271 |
|
enddo |
272 |
|
do while (icnt .gt. 0) |
273 |
|
ii = 0 |
274 |
|
!CDIR NODEP |
275 |
|
do ic=1,icnt |
276 |
|
i = inx(ic,1) |
277 |
|
j = inx(ic,2) |
278 |
|
if (yG(i,j,bi,bj) .ge. y_in(s_ind(i,j)+1)) then |
279 |
|
s_ind(i,j) = s_ind(i,j) + 1 |
280 |
|
ii = ii+1 |
281 |
|
inx(ii,1) = i |
282 |
|
inx(ii,2) = j |
283 |
|
endif |
284 |
|
enddo |
285 |
|
icnt = ii |
286 |
|
enddo |
287 |
|
#endif /* TARGET_NEC_SX defined */ |
288 |
|
do i=1,snx |
289 |
|
do j=1,sny |
290 |
|
n_ind(i,j) = s_ind(i,j) + 1 |
291 |
enddo |
enddo |
292 |
enddo |
enddo |
293 |
|
|