!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
***s/r adw_tricub_lag3d_tl - TLM of adw_tricub_lag3d
*
#include "model_macros_f.h"
*
subroutine adw_tricub_lag3d_tl ( F_out, F_in, F_x, F_y, F_z, 3
% F_outm, F_inm, F_xm, F_ym, F_zm,
% F_num, F_mono_L,i0,in,j0,jn,kn )
*
implicit none
*
logical F_mono_L
*
integer F_num,i0,in,j0,jn,kn
*
real F_in(*),F_inm(*)
*
real F_out (F_num), F_x (F_num), F_y (F_num), F_z (F_num)
real F_outm(F_num), F_xm(F_num), F_ym(F_num), F_zm(F_num)
*
*authors
* Monique Tanguay
*
* (Based on adw_tricub_tl v_3.1.1)
*
*revision
* v3_20 - Tanguay M. - initial version
* v3_21 - Tanguay M. - Revision Openmp
*
*object
* see id section
*
*arguments
*______________________________________________________________________
* | | |
* NAME | DESCRIPTION | I/O |
*--------------|-------------------------------------------------|-----|
* | | |
* F_out | result of interpolation | o |
* F_in | field to interpolate | i |
* | | |
* F_x | interpolation target X coordinate | i |
* F_y | interpolation target Y coordinate | i |
* F_z | interpolation target Z coordinate | i |
* | | |
* F_num | number of points to interpolate | i |
* | | |
* F_mono_L | switch: .true. : monotonic interpolation | i |
*______________|_________________________________________________|_____|
*
*implicits
#include "glb_ld.cdk"
#include "adw.cdk"
* **********************************************************************
integer n, nijag,i,j,k,nij,iimax,jjmax,kkmax
logical zcubic_L
*
real prmin, prmax, prmin2, prmax2
real prminm, prmaxm, prmin2m, prmax2m
*
integer o1, o2, o3, o4
*
real*8 a1m, a2m, a3m, a4m
real*8 b1m, b2m, b3m, b4m
real*8 c1m, c2m, c3m, c4m
real*8 d1m, d2m, d3m, d4m
real*8 p1m, p2m, p3m, p4m
*
real*8 a1, a2, a3, a4
real*8 b1, b2, b3, b4
real*8 c1, c2, c3, c4
real*8 d1, d2, d3, d4
real*8 p1, p2, p3, p4
*
integer ii,jj,kk
real *8 triprd,za,zb,zc,zd,rri,rrj,rrk,ra,rb,rc,rd
triprd(za,zb,zc,zd)=(za-zb)*(za-zc)*(za-zd)
*
real *8 triprd_tl,zam,rrim,rrjm,rrkm
triprd_tl(za,zam,zb,zc,zd)=
%za*(zam-zc)*(zam-zd)+(zam-zb)*za*(zam-zd)+(zam-zb)*(zam-zc)*za
*
nij = l_ni*l_nj
nijag = Adw_nit * Adw_njt
*
iimax = G_ni+2*Adw_halox-2
jjmax = G_nj+Adw_haloy
kkmax = l_nk-1
*
if(F_mono_L) then
*
!$omp do
do 100 k=1,kn
do 90 j=j0,jn
do 80 i=i0,in
n = (k-1)*nij + ((j-1)*l_ni) + i
*
* TRAJECTORY
* ----------
rrim= F_xm(n)
ii = ( rrim - Adw_x00_8 ) * Adw_ovdx_8
ii = Adw_lcx( ii+1 ) + 1
if ( rrim .lt. Adw_bsx_8(ii) ) ii = ii - 1
ii = max(2,min(ii,iimax))
*
* TLM
* ---
rri= F_x(n)
*
* TRAJECTORY
* ----------
rrjm= F_ym(n)
jj = ( rrjm - Adw_y00_8 ) * Adw_ovdy_8
jj = Adw_lcy( jj+1 ) + 1
if ( rrjm .lt. Adw_bsy_8(jj) ) jj = jj - 1
jj = max(Adw_haloy,min(jj,jjmax))
*
* TLM
* ---
rrj= F_y(n)
*
* TRAJECTORY
* ----------
rrkm= F_zm(n)
kk = ( rrkm - Adw_z00_8 ) * Adw_ovdz_8
kk = Adw_lcz( kk+1 )
if ( rrkm .lt. Adw_bsz_8(kk) ) kk = kk - 1
kk = min(kkmax-1,max(0,kk))
*
* TLM
* ---
rrk= F_z(n)
*
zcubic_L = (kk.gt.0) .and. (kk.lt.kkmax-1)
*
* *********************************************************************
* x interpolation
* *********************************************************************
*
* TRAJECTORY
* ----------
ra = Adw_bsx_8(ii-1)
rb = Adw_bsx_8(ii )
rc = Adw_bsx_8(ii+1)
rd = Adw_bsx_8(ii+2)
*
p1m = triprd(rrim,rb,rc,rd)*Adw_xabcd_8(ii)
p2m = triprd(rrim,ra,rc,rd)*Adw_xbacd_8(ii)
p3m = triprd(rrim,ra,rb,rd)*Adw_xcabd_8(ii)
p4m = triprd(rrim,ra,rb,rc)*Adw_xdabc_8(ii)
*
* TLM
* ---
p1 = triprd_tl(rri,rrim,rb,rc,rd)*Adw_xabcd_8(ii)
p2 = triprd_tl(rri,rrim,ra,rc,rd)*Adw_xbacd_8(ii)
p3 = triprd_tl(rri,rrim,ra,rb,rd)*Adw_xcabd_8(ii)
p4 = triprd_tl(rri,rrim,ra,rb,rc)*Adw_xdabc_8(ii)
*
o2 = (kk-1)*nijag + (jj-Adw_int_j_off-1)*Adw_nit + (ii-Adw_int_i_off)
o1 = o2-Adw_nit
o3 = o2+Adw_nit
o4 = o3+Adw_nit
*
if(zcubic_L) then
*
* TRAJECTORY
* ----------
a1m = p1m * F_inm (o1-1) + p2m * F_inm (o1) + p3m * F_inm (o1+1) + p4m * F_inm (o1+2)
a2m = p1m * F_inm (o2-1) + p2m * F_inm (o2) + p3m * F_inm (o2+1) + p4m * F_inm (o2+2)
a3m = p1m * F_inm (o3-1) + p2m * F_inm (o3) + p3m * F_inm (o3+1) + p4m * F_inm (o3+2)
a4m = p1m * F_inm (o4-1) + p2m * F_inm (o4) + p3m * F_inm (o4+1) + p4m * F_inm (o4+2)
*
* TLM
* ---
a1 = p1 * F_inm (o1-1) + p2 * F_inm (o1) + p3 * F_inm (o1+1) + p4 * F_inm (o1+2)
% + p1m * F_in (o1-1) + p2m * F_in (o1) + p3m * F_in (o1+1) + p4m * F_in (o1+2)
a2 = p1 * F_inm (o2-1) + p2 * F_inm (o2) + p3 * F_inm (o2+1) + p4 * F_inm (o2+2)
% + p1m * F_in (o2-1) + p2m * F_in (o2) + p3m * F_in (o2+1) + p4m * F_in (o2+2)
a3 = p1 * F_inm (o3-1) + p2 * F_inm (o3) + p3 * F_inm (o3+1) + p4 * F_inm (o3+2)
% + p1m * F_in (o3-1) + p2m * F_in (o3) + p3m * F_in (o3+1) + p4m * F_in (o3+2)
a4 = p1 * F_inm (o4-1) + p2 * F_inm (o4) + p3 * F_inm (o4+1) + p4 * F_inm (o4+2)
% + p1m * F_in (o4-1) + p2m * F_in (o4) + p3m * F_in (o4+1) + p4m * F_in (o4+2)
endif
*
o1 = o1 + nijag
o2 = o2 + nijag
o3 = o3 + nijag
o4 = o4 + nijag
*
prmax = max(F_in(o2),F_in(o2+1),F_in(o3),F_in(o3+1))
prmin = min(F_in(o2),F_in(o2+1),F_in(o3),F_in(o3+1))
*
* TRAJECTORY and TLM
* ------------------
prmaxm = F_inm(o2)
prmax = F_in (o2)
if(F_inm(o2+1).gt.prmaxm) then
prmaxm = F_inm(o2+1)
prmax = F_in (o2+1)
endif
if(F_inm(o3) .gt.prmaxm) then
prmaxm = F_inm(o3)
prmax = F_in (o3)
endif
if(F_inm(o3+1).gt.prmaxm) then
prmaxm = F_inm(o3+1)
prmax = F_in (o3+1)
endif
*
prminm = F_inm(o2)
prmin = F_in (o2)
if(F_inm(o2+1).lt.prminm) then
prminm = F_inm(o2+1)
prmin = F_in (o2+1)
endif
if(F_inm(o3) .lt.prminm) then
prminm = F_inm(o3)
prmin = F_in (o3)
endif
if(F_inm(o3+1).lt.prminm) then
prminm = F_inm(o3+1)
prmin = F_in (o3+1)
endif
*
* TRAJECTORY
* ----------
b1m = p1m * F_inm (o1-1) + p2m * F_inm (o1) + p3m * F_inm (o1+1) + p4m * F_inm (o1+2)
b2m = p1m * F_inm (o2-1) + p2m * F_inm (o2) + p3m * F_inm (o2+1) + p4m * F_inm (o2+2)
b3m = p1m * F_inm (o3-1) + p2m * F_inm (o3) + p3m * F_inm (o3+1) + p4m * F_inm (o3+2)
b4m = p1m * F_inm (o4-1) + p2m * F_inm (o4) + p3m * F_inm (o4+1) + p4m * F_inm (o4+2)
*
* TLM
* ---
b1 = p1 * F_inm (o1-1) + p2 * F_inm (o1) + p3 * F_inm (o1+1) + p4 * F_inm (o1+2)
% + p1m * F_in (o1-1) + p2m * F_in (o1) + p3m * F_in (o1+1) + p4m * F_in (o1+2)
b2 = p1 * F_inm (o2-1) + p2 * F_inm (o2) + p3 * F_inm (o2+1) + p4 * F_inm (o2+2)
% + p1m * F_in (o2-1) + p2m * F_in (o2) + p3m * F_in (o2+1) + p4m * F_in (o2+2)
b3 = p1 * F_inm (o3-1) + p2 * F_inm (o3) + p3 * F_inm (o3+1) + p4 * F_inm (o3+2)
% + p1m * F_in (o3-1) + p2m * F_in (o3) + p3m * F_in (o3+1) + p4m * F_in (o3+2)
b4 = p1 * F_inm (o4-1) + p2 * F_inm (o4) + p3 * F_inm (o4+1) + p4 * F_inm (o4+2)
% + p1m * F_in (o4-1) + p2m * F_in (o4) + p3m * F_in (o4+1) + p4m * F_in (o4+2)
*
o1 = o1 + nijag
o2 = o2 + nijag
o3 = o3 + nijag
o4 = o4 + nijag
*
* TRAJECTORY and TLM
* ------------------
if(F_inm(o2) .gt.prmaxm) then
prmaxm = F_inm(o2)
prmax = F_in (o2)
endif
if(F_inm(o2+1).gt.prmaxm) then
prmaxm = F_inm(o2+1)
prmax = F_in (o2+1)
endif
if(F_inm(o3) .gt.prmaxm) then
prmaxm = F_inm(o3)
prmax = F_in (o3)
endif
if(F_inm(o3+1).gt.prmaxm) then
prmaxm = F_inm(o3+1)
prmax = F_in (o3+1)
endif
*
if(F_inm(o2) .lt.prminm) then
prminm = F_inm(o2)
prmin = F_in (o2)
endif
if(F_inm(o2+1).lt.prminm) then
prminm = F_inm(o2+1)
prmin = F_in (o2+1)
endif
if(F_inm(o3) .lt.prminm) then
prminm = F_inm(o3)
prmin = F_in (o3)
endif
if(F_inm(o3+1).lt.prminm) then
prminm = F_inm(o3+1)
prmin = F_in (o3+1)
endif
*
* TRAJECTORY
* ----------
c1m = p1m * F_inm (o1-1) + p2m * F_inm (o1) + p3m * F_inm (o1+1) + p4m * F_inm (o1+2)
c2m = p1m * F_inm (o2-1) + p2m * F_inm (o2) + p3m * F_inm (o2+1) + p4m * F_inm (o2+2)
c3m = p1m * F_inm (o3-1) + p2m * F_inm (o3) + p3m * F_inm (o3+1) + p4m * F_inm (o3+2)
c4m = p1m * F_inm (o4-1) + p2m * F_inm (o4) + p3m * F_inm (o4+1) + p4m * F_inm (o4+2)
*
* TLM
* ---
c1 = p1 * F_inm (o1-1) + p2 * F_inm (o1) + p3 * F_inm (o1+1) + p4 * F_inm (o1+2)
% + p1m * F_in (o1-1) + p2m * F_in (o1) + p3m * F_in (o1+1) + p4m * F_in (o1+2)
c2 = p1 * F_inm (o2-1) + p2 * F_inm (o2) + p3 * F_inm (o2+1) + p4 * F_inm (o2+2)
% + p1m * F_in (o2-1) + p2m * F_in (o2) + p3m * F_in (o2+1) + p4m * F_in (o2+2)
c3 = p1 * F_inm (o3-1) + p2 * F_inm (o3) + p3 * F_inm (o3+1) + p4 * F_inm (o3+2)
% + p1m * F_in (o3-1) + p2m * F_in (o3) + p3m * F_in (o3+1) + p4m * F_in (o3+2)
c4 = p1 * F_inm (o4-1) + p2 * F_inm (o4) + p3 * F_inm (o4+1) + p4 * F_inm (o4+2)
% + p1m * F_in (o4-1) + p2m * F_in (o4) + p3m * F_in (o4+1) + p4m * F_in (o4+2)
*
o1 = o1 + nijag
o2 = o2 + nijag
o3 = o3 + nijag
o4 = o4 + nijag
*
if(zcubic_L) then
*
* TRAJECTORY
* ----------
d1m = p1m * F_inm (o1-1) + p2m * F_inm (o1) + p3m * F_inm (o1+1) + p4m * F_inm (o1+2)
d2m = p1m * F_inm (o2-1) + p2m * F_inm (o2) + p3m * F_inm (o2+1) + p4m * F_inm (o2+2)
d3m = p1m * F_inm (o3-1) + p2m * F_inm (o3) + p3m * F_inm (o3+1) + p4m * F_inm (o3+2)
d4m = p1m * F_inm (o4-1) + p2m * F_inm (o4) + p3m * F_inm (o4+1) + p4m * F_inm (o4+2)
*
* TLM
* ---
d1 = p1 * F_inm (o1-1) + p2 * F_inm (o1) + p3 * F_inm (o1+1) + p4 * F_inm (o1+2)
% + p1m * F_in (o1-1) + p2m * F_in (o1) + p3m * F_in (o1+1) + p4m * F_in (o1+2)
d2 = p1 * F_inm (o2-1) + p2 * F_inm (o2) + p3 * F_inm (o2+1) + p4 * F_inm (o2+2)
% + p1m * F_in (o2-1) + p2m * F_in (o2) + p3m * F_in (o2+1) + p4m * F_in (o2+2)
d3 = p1 * F_inm (o3-1) + p2 * F_inm (o3) + p3 * F_inm (o3+1) + p4 * F_inm (o3+2)
% + p1m * F_in (o3-1) + p2m * F_in (o3) + p3m * F_in (o3+1) + p4m * F_in (o3+2)
d4 = p1 * F_inm (o4-1) + p2 * F_inm (o4) + p3 * F_inm (o4+1) + p4 * F_inm (o4+2)
% + p1m * F_in (o4-1) + p2m * F_in (o4) + p3m * F_in (o4+1) + p4m * F_in (o4+2)
endif
* *********************************************************************
* y interpolation
* *********************************************************************
ra = Adw_bsy_8(jj-1)
rb = Adw_bsy_8(jj )
rc = Adw_bsy_8(jj+1)
rd = Adw_bsy_8(jj+2)
*
* TRAJECTORY
* ----------
p1m = triprd(rrjm,rb,rc,rd)*Adw_yabcd_8(jj)
p2m = triprd(rrjm,ra,rc,rd)*Adw_ybacd_8(jj)
p3m = triprd(rrjm,ra,rb,rd)*Adw_ycabd_8(jj)
p4m = triprd(rrjm,ra,rb,rc)*Adw_ydabc_8(jj)
*
* TLM
* ---
p1 = triprd_tl(rrj,rrjm,rb,rc,rd)*Adw_yabcd_8(jj)
p2 = triprd_tl(rrj,rrjm,ra,rc,rd)*Adw_ybacd_8(jj)
p3 = triprd_tl(rrj,rrjm,ra,rb,rd)*Adw_ycabd_8(jj)
p4 = triprd_tl(rrj,rrjm,ra,rb,rc)*Adw_ydabc_8(jj)
*
* TLM
* ---
if(zcubic_L)a1 = p1 * a1m + p2 * a2m + p3 * a3m + p4 * a4m
% + p1m * a1 + p2m * a2 + p3m * a3 + p4m * a4
b1 = p1 * b1m + p2 * b2m + p3 * b3m + p4 * b4m
% + p1m * b1 + p2m * b2 + p3m * b3 + p4m * b4
c1 = p1 * c1m + p2 * c2m + p3 * c3m + p4 * c4m
% + p1m * c1 + p2m * c2 + p3m * c3 + p4m * c4
if(zcubic_L)d1 = p1 * d1m + p2 * d2m + p3 * d3m + p4 * d4m
% + p1m * d1 + p2m * d2 + p3m * d3 + p4m * d4
*
* TRAJECTORY
* ----------
if(zcubic_L)a1m = p1m * a1m + p2m * a2m + p3m * a3m + p4m * a4m
b1m = p1m * b1m + p2m * b2m + p3m * b3m + p4m * b4m
c1m = p1m * c1m + p2m * c2m + p3m * c3m + p4m * c4m
if(zcubic_L)d1m = p1m * d1m + p2m * d2m + p3m * d3m + p4m * d4m
* *********************************************************************
* z interpolation
* *********************************************************************
if(zcubic_L) then
ra = Adw_bsz_8(kk-1)
rb = Adw_bsz_8(kk )
rc = Adw_bsz_8(kk+1)
rd = Adw_bsz_8(kk+2)
*
* TRAJECTORY
* ----------
p1m = triprd(rrkm,rb,rc,rd)*Adw_zabcd_8(kk+1)
p2m = triprd(rrkm,ra,rc,rd)*Adw_zbacd_8(kk+1)
p3m = triprd(rrkm,ra,rb,rd)*Adw_zcabd_8(kk+1)
p4m = triprd(rrkm,ra,rb,rc)*Adw_zdabc_8(kk+1)
*
* TLM
* ---
p1 = triprd_tl(rrk,rrkm,rb,rc,rd)*Adw_zabcd_8(kk+1)
p2 = triprd_tl(rrk,rrkm,ra,rc,rd)*Adw_zbacd_8(kk+1)
p3 = triprd_tl(rrk,rrkm,ra,rb,rd)*Adw_zcabd_8(kk+1)
p4 = triprd_tl(rrk,rrkm,ra,rb,rc)*Adw_zdabc_8(kk+1)
*
* TRAJECTORY
* ----------
F_outm(n) = p1m * a1m + p2m * b1m + p3m * c1m + p4m * d1m
*
* TLM
* ---
F_out(n) = p1 * a1m + p2 * b1m + p3 * c1m + p4 * d1m
% + p1m * a1 + p2m * b1 + p3m * c1 + p4m * d1
*
else
*
* TRAJECTORY
* ----------
p3m = (rrkm-Adw_bsz_8(kk))*Adw_zbc_8(kk+1)
p2m = 1. - p3m
*
* TLM
* ---
p3 = (rrk)*Adw_zbc_8(kk+1)
p2 = - p3
*
* TRAJECTORY
* ----------
F_outm(n) = p2m * b1m + p3m * c1m
*
* TLM
* ---
F_out(n) = p2 * b1m + p3 * c1m
% + p2m * b1 + p3m * c1
*
endif
*
* TRAJECTORY and TLM
* ------------------
if(F_outm(n).gt.prmaxm) then
F_outm(n) = prmaxm
F_out (n) = prmax
endif
if(F_outm(n).lt.prminm) then
F_outm(n) = prminm
F_out (n) = prmin
endif
*
80 continue
90 continue
100 continue
!$omp enddo
*
else
*
!$omp do
do 101 k=1,kn
do 91 j=j0,jn
do 81 i=i0,in
n = (k-1)*nij + ((j-1)*l_ni) + i
*
* TRAJECTORY
* ----------
rrim= F_xm(n)
ii = ( rrim - Adw_x00_8 ) * Adw_ovdx_8
ii = Adw_lcx( ii+1 ) + 1
if ( rrim .lt. Adw_bsx_8(ii) ) ii = ii - 1
ii = max(2,min(ii,iimax))
*
* TLM
* ---
rri= F_x(n)
*
* TRAJECTORY
* ----------
rrjm= F_ym(n)
jj = ( rrjm - Adw_y00_8 ) * Adw_ovdy_8
jj = Adw_lcy( jj+1 ) + 1
if ( rrjm .lt. Adw_bsy_8(jj) ) jj = jj - 1
jj = max(Adw_haloy,min(jj,jjmax))
*
* TLM
* ---
rrj= F_y(n)
*
* TRAJECTORY
* ----------
rrkm= F_zm(n)
kk = ( rrkm - Adw_z00_8 ) * Adw_ovdz_8
kk = Adw_lcz( kk+1 )
if ( rrkm .lt. Adw_bsz_8(kk) ) kk = kk - 1
kk = min(kkmax-1,max(0,kk))
*
* TLM
* ---
rrk= F_z(n)
*
zcubic_L = (kk.gt.0) .and. (kk.lt.kkmax-1)
*
* *********************************************************************
* x interpolation
* *********************************************************************
*
* TRAJECTORY
* ----------
ra = Adw_bsx_8(ii-1)
rb = Adw_bsx_8(ii )
rc = Adw_bsx_8(ii+1)
rd = Adw_bsx_8(ii+2)
*
p1m = triprd(rrim,rb,rc,rd)*Adw_xabcd_8(ii)
p2m = triprd(rrim,ra,rc,rd)*Adw_xbacd_8(ii)
p3m = triprd(rrim,ra,rb,rd)*Adw_xcabd_8(ii)
p4m = triprd(rrim,ra,rb,rc)*Adw_xdabc_8(ii)
*
* TLM
* ---
p1 = triprd_tl(rri,rrim,rb,rc,rd)*Adw_xabcd_8(ii)
p2 = triprd_tl(rri,rrim,ra,rc,rd)*Adw_xbacd_8(ii)
p3 = triprd_tl(rri,rrim,ra,rb,rd)*Adw_xcabd_8(ii)
p4 = triprd_tl(rri,rrim,ra,rb,rc)*Adw_xdabc_8(ii)
*
o2 = (kk-1)*nijag + (jj-Adw_int_j_off-1)*Adw_nit + (ii-Adw_int_i_off)
o1 = o2-Adw_nit
o3 = o2+Adw_nit
o4 = o3+Adw_nit
*
if(zcubic_L) then
*
* TRAJECTORY
* ----------
a1m = p1m * F_inm (o1-1) + p2m * F_inm (o1) + p3m * F_inm (o1+1) + p4m * F_inm (o1+2)
a2m = p1m * F_inm (o2-1) + p2m * F_inm (o2) + p3m * F_inm (o2+1) + p4m * F_inm (o2+2)
a3m = p1m * F_inm (o3-1) + p2m * F_inm (o3) + p3m * F_inm (o3+1) + p4m * F_inm (o3+2)
a4m = p1m * F_inm (o4-1) + p2m * F_inm (o4) + p3m * F_inm (o4+1) + p4m * F_inm (o4+2)
*
* TLM
* ---
a1 = p1 * F_inm (o1-1) + p2 * F_inm (o1) + p3 * F_inm (o1+1) + p4 * F_inm (o1+2)
% + p1m * F_in (o1-1) + p2m * F_in (o1) + p3m * F_in (o1+1) + p4m * F_in (o1+2)
a2 = p1 * F_inm (o2-1) + p2 * F_inm (o2) + p3 * F_inm (o2+1) + p4 * F_inm (o2+2)
% + p1m * F_in (o2-1) + p2m * F_in (o2) + p3m * F_in (o2+1) + p4m * F_in (o2+2)
a3 = p1 * F_inm (o3-1) + p2 * F_inm (o3) + p3 * F_inm (o3+1) + p4 * F_inm (o3+2)
% + p1m * F_in (o3-1) + p2m * F_in (o3) + p3m * F_in (o3+1) + p4m * F_in (o3+2)
a4 = p1 * F_inm (o4-1) + p2 * F_inm (o4) + p3 * F_inm (o4+1) + p4 * F_inm (o4+2)
% + p1m * F_in (o4-1) + p2m * F_in (o4) + p3m * F_in (o4+1) + p4m * F_in (o4+2)
endif
*
o1 = o1 + nijag
o2 = o2 + nijag
o3 = o3 + nijag
o4 = o4 + nijag
*
prmax = max(F_in(o2),F_in(o2+1),F_in(o3),F_in(o3+1))
prmin = min(F_in(o2),F_in(o2+1),F_in(o3),F_in(o3+1))
*
* TRAJECTORY
* ----------
b1m = p1m * F_inm (o1-1) + p2m * F_inm (o1) + p3m * F_inm (o1+1) + p4m * F_inm (o1+2)
b2m = p1m * F_inm (o2-1) + p2m * F_inm (o2) + p3m * F_inm (o2+1) + p4m * F_inm (o2+2)
b3m = p1m * F_inm (o3-1) + p2m * F_inm (o3) + p3m * F_inm (o3+1) + p4m * F_inm (o3+2)
b4m = p1m * F_inm (o4-1) + p2m * F_inm (o4) + p3m * F_inm (o4+1) + p4m * F_inm (o4+2)
*
* TLM
* ---
b1 = p1 * F_inm (o1-1) + p2 * F_inm (o1) + p3 * F_inm (o1+1) + p4 * F_inm (o1+2)
% + p1m * F_in (o1-1) + p2m * F_in (o1) + p3m * F_in (o1+1) + p4m * F_in (o1+2)
b2 = p1 * F_inm (o2-1) + p2 * F_inm (o2) + p3 * F_inm (o2+1) + p4 * F_inm (o2+2)
% + p1m * F_in (o2-1) + p2m * F_in (o2) + p3m * F_in (o2+1) + p4m * F_in (o2+2)
b3 = p1 * F_inm (o3-1) + p2 * F_inm (o3) + p3 * F_inm (o3+1) + p4 * F_inm (o3+2)
% + p1m * F_in (o3-1) + p2m * F_in (o3) + p3m * F_in (o3+1) + p4m * F_in (o3+2)
b4 = p1 * F_inm (o4-1) + p2 * F_inm (o4) + p3 * F_inm (o4+1) + p4 * F_inm (o4+2)
% + p1m * F_in (o4-1) + p2m * F_in (o4) + p3m * F_in (o4+1) + p4m * F_in (o4+2)
*
o1 = o1 + nijag
o2 = o2 + nijag
o3 = o3 + nijag
o4 = o4 + nijag
*
* TRAJECTORY
* ----------
c1m = p1m * F_inm (o1-1) + p2m * F_inm (o1) + p3m * F_inm (o1+1) + p4m * F_inm (o1+2)
c2m = p1m * F_inm (o2-1) + p2m * F_inm (o2) + p3m * F_inm (o2+1) + p4m * F_inm (o2+2)
c3m = p1m * F_inm (o3-1) + p2m * F_inm (o3) + p3m * F_inm (o3+1) + p4m * F_inm (o3+2)
c4m = p1m * F_inm (o4-1) + p2m * F_inm (o4) + p3m * F_inm (o4+1) + p4m * F_inm (o4+2)
*
* TLM
* ---
c1 = p1 * F_inm (o1-1) + p2 * F_inm (o1) + p3 * F_inm (o1+1) + p4 * F_inm (o1+2)
% + p1m * F_in (o1-1) + p2m * F_in (o1) + p3m * F_in (o1+1) + p4m * F_in (o1+2)
c2 = p1 * F_inm (o2-1) + p2 * F_inm (o2) + p3 * F_inm (o2+1) + p4 * F_inm (o2+2)
% + p1m * F_in (o2-1) + p2m * F_in (o2) + p3m * F_in (o2+1) + p4m * F_in (o2+2)
c3 = p1 * F_inm (o3-1) + p2 * F_inm (o3) + p3 * F_inm (o3+1) + p4 * F_inm (o3+2)
% + p1m * F_in (o3-1) + p2m * F_in (o3) + p3m * F_in (o3+1) + p4m * F_in (o3+2)
c4 = p1 * F_inm (o4-1) + p2 * F_inm (o4) + p3 * F_inm (o4+1) + p4 * F_inm (o4+2)
% + p1m * F_in (o4-1) + p2m * F_in (o4) + p3m * F_in (o4+1) + p4m * F_in (o4+2)
*
o1 = o1 + nijag
o2 = o2 + nijag
o3 = o3 + nijag
o4 = o4 + nijag
*
if(zcubic_L) then
*
* TRAJECTORY
* ----------
d1m = p1m * F_inm (o1-1) + p2m * F_inm (o1) + p3m * F_inm (o1+1) + p4m * F_inm (o1+2)
d2m = p1m * F_inm (o2-1) + p2m * F_inm (o2) + p3m * F_inm (o2+1) + p4m * F_inm (o2+2)
d3m = p1m * F_inm (o3-1) + p2m * F_inm (o3) + p3m * F_inm (o3+1) + p4m * F_inm (o3+2)
d4m = p1m * F_inm (o4-1) + p2m * F_inm (o4) + p3m * F_inm (o4+1) + p4m * F_inm (o4+2)
*
* TLM
* ---
d1 = p1 * F_inm (o1-1) + p2 * F_inm (o1) + p3 * F_inm (o1+1) + p4 * F_inm (o1+2)
% + p1m * F_in (o1-1) + p2m * F_in (o1) + p3m * F_in (o1+1) + p4m * F_in (o1+2)
d2 = p1 * F_inm (o2-1) + p2 * F_inm (o2) + p3 * F_inm (o2+1) + p4 * F_inm (o2+2)
% + p1m * F_in (o2-1) + p2m * F_in (o2) + p3m * F_in (o2+1) + p4m * F_in (o2+2)
d3 = p1 * F_inm (o3-1) + p2 * F_inm (o3) + p3 * F_inm (o3+1) + p4 * F_inm (o3+2)
% + p1m * F_in (o3-1) + p2m * F_in (o3) + p3m * F_in (o3+1) + p4m * F_in (o3+2)
d4 = p1 * F_inm (o4-1) + p2 * F_inm (o4) + p3 * F_inm (o4+1) + p4 * F_inm (o4+2)
% + p1m * F_in (o4-1) + p2m * F_in (o4) + p3m * F_in (o4+1) + p4m * F_in (o4+2)
endif
* *********************************************************************
* y interpolation
* *********************************************************************
ra = Adw_bsy_8(jj-1)
rb = Adw_bsy_8(jj )
rc = Adw_bsy_8(jj+1)
rd = Adw_bsy_8(jj+2)
*
* TRAJECTORY
* ----------
p1m = triprd(rrjm,rb,rc,rd)*Adw_yabcd_8(jj)
p2m = triprd(rrjm,ra,rc,rd)*Adw_ybacd_8(jj)
p3m = triprd(rrjm,ra,rb,rd)*Adw_ycabd_8(jj)
p4m = triprd(rrjm,ra,rb,rc)*Adw_ydabc_8(jj)
*
* TLM
* ---
p1 = triprd_tl(rrj,rrjm,rb,rc,rd)*Adw_yabcd_8(jj)
p2 = triprd_tl(rrj,rrjm,ra,rc,rd)*Adw_ybacd_8(jj)
p3 = triprd_tl(rrj,rrjm,ra,rb,rd)*Adw_ycabd_8(jj)
p4 = triprd_tl(rrj,rrjm,ra,rb,rc)*Adw_ydabc_8(jj)
*
* TLM
* ---
if(zcubic_L)a1 = p1 * a1m + p2 * a2m + p3 * a3m + p4 * a4m
% + p1m * a1 + p2m * a2 + p3m * a3 + p4m * a4
b1 = p1 * b1m + p2 * b2m + p3 * b3m + p4 * b4m
% + p1m * b1 + p2m * b2 + p3m * b3 + p4m * b4
c1 = p1 * c1m + p2 * c2m + p3 * c3m + p4 * c4m
% + p1m * c1 + p2m * c2 + p3m * c3 + p4m * c4
if(zcubic_L)d1 = p1 * d1m + p2 * d2m + p3 * d3m + p4 * d4m
% + p1m * d1 + p2m * d2 + p3m * d3 + p4m * d4
*
* TRAJECTORY
* ----------
if(zcubic_L)a1m = p1m * a1m + p2m * a2m + p3m * a3m + p4m * a4m
b1m = p1m * b1m + p2m * b2m + p3m * b3m + p4m * b4m
c1m = p1m * c1m + p2m * c2m + p3m * c3m + p4m * c4m
if(zcubic_L)d1m = p1m * d1m + p2m * d2m + p3m * d3m + p4m * d4m
* *********************************************************************
* z interpolation
* *********************************************************************
if(zcubic_L) then
ra = Adw_bsz_8(kk-1)
rb = Adw_bsz_8(kk )
rc = Adw_bsz_8(kk+1)
rd = Adw_bsz_8(kk+2)
*
* TRAJECTORY
* ----------
p1m = triprd(rrkm,rb,rc,rd)*Adw_zabcd_8(kk+1)
p2m = triprd(rrkm,ra,rc,rd)*Adw_zbacd_8(kk+1)
p3m = triprd(rrkm,ra,rb,rd)*Adw_zcabd_8(kk+1)
p4m = triprd(rrkm,ra,rb,rc)*Adw_zdabc_8(kk+1)
*
* TLM
* ---
p1 = triprd_tl(rrk,rrkm,rb,rc,rd)*Adw_zabcd_8(kk+1)
p2 = triprd_tl(rrk,rrkm,ra,rc,rd)*Adw_zbacd_8(kk+1)
p3 = triprd_tl(rrk,rrkm,ra,rb,rd)*Adw_zcabd_8(kk+1)
p4 = triprd_tl(rrk,rrkm,ra,rb,rc)*Adw_zdabc_8(kk+1)
*
* TRAJECTORY
* ----------
F_outm(n) = p1m * a1m + p2m * b1m + p3m * c1m + p4m * d1m
*
* TLM
* ---
F_out(n) = p1 * a1m + p2 * b1m + p3 * c1m + p4 * d1m
% + p1m * a1 + p2m * b1 + p3m * c1 + p4m * d1
*
else
*
* TRAJECTORY
* ----------
p3m = (rrkm-Adw_bsz_8(kk))*Adw_zbc_8(kk+1)
p2m = 1. - p3m
*
* TLM
* ---
p3 = (rrk)*Adw_zbc_8(kk+1)
p2 = - p3
*
* TRAJECTORY
* ----------
F_outm(n) = p2m * b1m + p3m * c1m
*
* TLM
* ---
F_out(n) = p2 * b1m + p3 * c1m
% + p2m * b1 + p3m * c1
*
endif
*
81 continue
91 continue
101 continue
!$omp enddo
*
endif
return
end