/[MITgcm]/MITgcm/pkg/exf/exf_interp.F
ViewVC logotype

Diff of /MITgcm/pkg/exf/exf_interp.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.22 by mlosch, Wed Jan 23 16:41:01 2008 UTC revision 1.23 by mlosch, Thu Jan 24 08:29:51 2008 UTC
# Line 97  C local variables Line 97  C local variables
97  #ifdef TARGET_NEC_SX  #ifdef TARGET_NEC_SX
98        integer  ic, ii, icnt        integer  ic, ii, icnt
99        integer  inx(snx*sny,2)        integer  inx(snx*sny,2)
100          _RL      ew_val1, ew_val2, ew_val3, ew_val4
101  #endif  #endif
102        _RS      xG(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        _RS      xG(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
103        _RL      ninety        _RL      ninety
# Line 302  C bilinear interpolation Line 303  C bilinear interpolation
303              px_ind(l+1) = x_in(w_ind(i,j)+l)              px_ind(l+1) = x_in(w_ind(i,j)+l)
304              py_ind(l+1) = y_in(s_ind(i,j)+l)              py_ind(l+1) = y_in(s_ind(i,j)+l)
305             enddo             enddo
306    #ifndef TARGET_NEC_SX
307             do k=1,2             do k=1,2
308              ew_val(k) = arrayin(w_ind(i,j),s_ind(i,j)+k-1)              ew_val(k) = arrayin(w_ind(i,j),s_ind(i,j)+k-1)
309       &             *lagran(1,xG(i,j,bi,bj),px_ind,sp)       &             *lagran(1,xG(i,j,bi,bj),px_ind,sp)
# Line 310  C bilinear interpolation Line 312  C bilinear interpolation
312              arrayout(i,j,bi,bj)=arrayout(i,j,bi,bj)              arrayout(i,j,bi,bj)=arrayout(i,j,bi,bj)
313       &             +ew_val(k)*lagran(k,yG(i,j,bi,bj),py_ind,sp)       &             +ew_val(k)*lagran(k,yG(i,j,bi,bj),py_ind,sp)
314             enddo             enddo
315    #else
316               ew_val1 = arrayin(w_ind(i,j),s_ind(i,j)+1-1)
317         &             *lagran(1,xG(i,j,bi,bj),px_ind,sp)
318         &             +arrayin(e_ind(i,j),s_ind(i,j)+1-1)
319         &             *lagran(2,xG(i,j,bi,bj),px_ind,sp)
320               ew_val2 = arrayin(w_ind(i,j),s_ind(i,j)+2-1)
321         &             *lagran(1,xG(i,j,bi,bj),px_ind,sp)
322         &             +arrayin(e_ind(i,j),s_ind(i,j)+2-1)
323         &             *lagran(2,xG(i,j,bi,bj),px_ind,sp)
324               arrayout(i,j,bi,bj)=
325         &             +ew_val1*lagran(1,yG(i,j,bi,bj),py_ind,sp)
326         &             +ew_val2*lagran(2,yG(i,j,bi,bj),py_ind,sp)
327    #endif /* TARGET_NEC_SX defined */
328            enddo            enddo
329           enddo           enddo
330          elseif (method .eq. 2 .or. method.eq.12 .or. method.eq.22) then          elseif (method .eq. 2 .or. method.eq.12 .or. method.eq.22) then
# Line 323  C bicubic interpolation Line 338  C bicubic interpolation
338              px_ind(l+2) = x_in(w_ind(i,j)+l)              px_ind(l+2) = x_in(w_ind(i,j)+l)
339              py_ind(l+2) = y_in(s_ind(i,j)+l)              py_ind(l+2) = y_in(s_ind(i,j)+l)
340             enddo             enddo
341    #ifndef TARGET_NEC_SX
342             do k=1,4             do k=1,4
343              ew_val(k) =              ew_val(k) =
344       &             arrayin(w_ind(i,j)-1,s_ind(i,j)+k-2)       &             arrayin(w_ind(i,j)-1,s_ind(i,j)+k-2)
# Line 336  C bicubic interpolation Line 352  C bicubic interpolation
352              arrayout(i,j,bi,bj)=arrayout(i,j,bi,bj)              arrayout(i,j,bi,bj)=arrayout(i,j,bi,bj)
353       &             +ew_val(k)*lagran(k,yG(i,j,bi,bj),py_ind,sp)       &             +ew_val(k)*lagran(k,yG(i,j,bi,bj),py_ind,sp)
354             enddo             enddo
355    #else
356               ew_val1 =
357         &             arrayin(w_ind(i,j)-1,s_ind(i,j)+1-2)
358         &             *lagran(1,xG(i,j,bi,bj),px_ind,sp)
359         &             +arrayin(w_ind(i,j)  ,s_ind(i,j)+1-2)
360         &             *lagran(2,xG(i,j,bi,bj),px_ind,sp)
361         &             +arrayin(e_ind(i,j)  ,s_ind(i,j)+1-2)
362         &             *lagran(3,xG(i,j,bi,bj),px_ind,sp)
363         &             +arrayin(e_ind(i,j)+1,s_ind(i,j)+1-2)
364         &             *lagran(4,xG(i,j,bi,bj),px_ind,sp)
365                ew_val2 =
366         &             arrayin(w_ind(i,j)-1,s_ind(i,j)+2-2)
367         &             *lagran(1,xG(i,j,bi,bj),px_ind,sp)
368         &             +arrayin(w_ind(i,j)  ,s_ind(i,j)+2-2)
369         &             *lagran(2,xG(i,j,bi,bj),px_ind,sp)
370         &             +arrayin(e_ind(i,j)  ,s_ind(i,j)+2-2)
371         &             *lagran(3,xG(i,j,bi,bj),px_ind,sp)
372         &             +arrayin(e_ind(i,j)+1,s_ind(i,j)+2-2)
373         &             *lagran(4,xG(i,j,bi,bj),px_ind,sp)
374                ew_val3 =
375         &             arrayin(w_ind(i,j)-1,s_ind(i,j)+3-2)
376         &             *lagran(1,xG(i,j,bi,bj),px_ind,sp)
377         &             +arrayin(w_ind(i,j)  ,s_ind(i,j)+3-2)
378         &             *lagran(2,xG(i,j,bi,bj),px_ind,sp)
379         &             +arrayin(e_ind(i,j)  ,s_ind(i,j)+3-2)
380         &             *lagran(3,xG(i,j,bi,bj),px_ind,sp)
381         &             +arrayin(e_ind(i,j)+1,s_ind(i,j)+3-2)
382         &             *lagran(4,xG(i,j,bi,bj),px_ind,sp)
383                ew_val4 =
384         &             arrayin(w_ind(i,j)-1,s_ind(i,j)+4-2)
385         &             *lagran(1,xG(i,j,bi,bj),px_ind,sp)
386         &             +arrayin(w_ind(i,j)  ,s_ind(i,j)+4-2)
387         &             *lagran(2,xG(i,j,bi,bj),px_ind,sp)
388         &             +arrayin(e_ind(i,j)  ,s_ind(i,j)+4-2)
389         &             *lagran(3,xG(i,j,bi,bj),px_ind,sp)
390         &             +arrayin(e_ind(i,j)+1,s_ind(i,j)+4-2)
391         &             *lagran(4,xG(i,j,bi,bj),px_ind,sp)
392                arrayout(i,j,bi,bj)=
393         &             +ew_val1*lagran(1,yG(i,j,bi,bj),py_ind,sp)
394         &             +ew_val2*lagran(2,yG(i,j,bi,bj),py_ind,sp)
395         &             +ew_val3*lagran(3,yG(i,j,bi,bj),py_ind,sp)
396         &             +ew_val4*lagran(4,yG(i,j,bi,bj),py_ind,sp)
397    #endif /* TARGET_NEC_SX defined */
398            enddo            enddo
399           enddo           enddo
400          else          else
Legend:
Removed from v.1.22  
changed lines
  Added in v.1.23
  ViewVC Help
Powered by ViewVC 1.1.22