!-------------------------------------- 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_ad - ADJ of adw_tricub_lag3d_tl
*
#include "model_macros_f.h"
*
subroutine adw_tricub_lag3d_ad ( F_out, F_in, F_x, F_y, F_z, 4
% 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_xm(F_num), F_ym(F_num), F_zm(F_num)
*
*authors
* Monique Tanguay
*
* (Based on adw_tricub_ad v_3.1.1)
*
*revision
* v3_20 - Tanguay M. - initial version
*
*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, prminm, prmaxm
*
real prmin1m, prmax1m,prmin2m, prmax2m
real prmin3m, prmax3m,prmin4m, prmax4m
real prmin5m, prmax5m,prmin6m, prmax6m
real prmin7m, prmax7m,prmin8m, prmax8m
*
real F_outm
*
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 a1m_z, b1m_z, c1m_z, d1m_z
real*8 p1m_y, p2m_y, p3m_y, p4m_y
real*8 p1m_z, p2m_z, p3m_z, p4m_z
*
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
*
real*8, parameter :: ZERO_8 = 0.0
*
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
*
real *8 triprd_ad
triprd_ad(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
*
* Zero adjoint variables
* ----------------------
prmin = ZERO_8
prmax = ZERO_8
*
if(F_mono_L) then
*
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 (START)
* ------------------
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))
*
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))
*
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))
*
zcubic_L = (kk.gt.0) .and. (kk.lt.kkmax-1)
*
* *********************************************************************
* x interpolation
* *********************************************************************
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)
*
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
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)
endif
*
o1 = o1 + nijag
o2 = o2 + nijag
o3 = o3 + nijag
o4 = o4 + nijag
*
prmaxm = F_inm(o2)
prmax1m = prmaxm
if(F_inm(o2+1).gt.prmax1m) prmaxm = F_inm(o2+1)
prmax2m= prmaxm
if(F_inm(o3) .gt.prmax2m) prmaxm = F_inm(o3)
prmax3m= prmaxm
if(F_inm(o3+1).gt.prmax3m) prmaxm = F_inm(o3+1)
prmax4m= prmaxm
*
prminm = F_inm(o2)
prmin1m = prminm
if(F_inm(o2+1).lt.prmin1m) prminm = F_inm(o2+1)
prmin2m = prminm
if(F_inm(o3) .lt.prmin2m) prminm = F_inm(o3)
prmin3m = prminm
if(F_inm(o3+1).lt.prmin3m) prminm = F_inm(o3+1)
prmin4m = prminm
*
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)
*
o1 = o1 + nijag
o2 = o2 + nijag
o3 = o3 + nijag
o4 = o4 + nijag
*
if(F_inm(o2) .gt.prmax4m) prmaxm = F_inm(o2)
prmax5m = prmaxm
if(F_inm(o2+1).gt.prmax5m) prmaxm = F_inm(o2+1)
prmax6m = prmaxm
if(F_inm(o3) .gt.prmax6m) prmaxm = F_inm(o3)
prmax7m = prmaxm
if(F_inm(o3+1).gt.prmax7m) prmaxm = F_inm(o3+1)
prmax8m = prmaxm
*
if(F_inm(o2) .lt.prmin4m) prminm = F_inm(o2)
prmin5m = prminm
if(F_inm(o2+1).lt.prmin5m) prminm = F_inm(o2+1)
prmin6m = prminm
if(F_inm(o3) .lt.prmin6m) prminm = F_inm(o3)
prmin7m = prminm
if(F_inm(o3+1).lt.prmin7m) prminm = F_inm(o3+1)
prmin8m = prminm
*
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)
*
o1 = o1 + nijag
o2 = o2 + nijag
o3 = o3 + nijag
o4 = o4 + nijag
*
if(zcubic_L) then
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)
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)
*
p1m_y = triprd(rrjm,rb,rc,rd)*Adw_yabcd_8(jj)
p2m_y = triprd(rrjm,ra,rc,rd)*Adw_ybacd_8(jj)
p3m_y = triprd(rrjm,ra,rb,rd)*Adw_ycabd_8(jj)
p4m_y = triprd(rrjm,ra,rb,rc)*Adw_ydabc_8(jj)
*
if(zcubic_L)a1m_z = p1m_y * a1m + p2m_y * a2m + p3m_y * a3m + p4m_y * a4m
b1m_z = p1m_y * b1m + p2m_y * b2m + p3m_y * b3m + p4m_y * b4m
c1m_z = p1m_y * c1m + p2m_y * c2m + p3m_y * c3m + p4m_y * c4m
if(zcubic_L)d1m_z = p1m_y * d1m + p2m_y * d2m + p3m_y * d3m + p4m_y * 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)
*
p1m_z = triprd(rrkm,rb,rc,rd)*Adw_zabcd_8(kk+1)
p2m_z = triprd(rrkm,ra,rc,rd)*Adw_zbacd_8(kk+1)
p3m_z = triprd(rrkm,ra,rb,rd)*Adw_zcabd_8(kk+1)
p4m_z = triprd(rrkm,ra,rb,rc)*Adw_zdabc_8(kk+1)
*
F_outm = p1m_z * a1m_z + p2m_z * b1m_z + p3m_z * c1m_z + p4m_z * d1m_z
*
else
*
p3m_z = (rrkm-Adw_bsz_8(kk))*Adw_zbc_8(kk+1)
p2m_z = 1. - p3m_z
*
F_outm = p2m_z * b1m_z + p3m_z * c1m_z
endif
*
* ----------------
* TRAJECTORY (END)
* ----------------
*
* ADJOINT CALCULATIONS
* --------------------
*
if(F_outm.lt.prmin8m) then
prmin = F_out(n) + prmin
F_out(n) = ZERO_8
endif
if(F_outm.gt.prmax8m) then
prmax = F_out(n) + prmax
F_out(n) = ZERO_8
endif
*
* ADJ of
********************************************************************************
* z interpolation
********************************************************************************
if(zcubic_L) then
p1 = F_out(n) * a1m_z
p2 = F_out(n) * b1m_z
p3 = F_out(n) * c1m_z
p4 = F_out(n) * d1m_z
a1 = p1m_z * F_out(n)
b1 = p2m_z * F_out(n)
c1 = p3m_z * F_out(n)
d1 = p4m_z * F_out(n)
*
else
p2 = F_out(n) * b1m_z
p3 = F_out(n) * c1m_z
b1 = p2m_z * F_out(n)
c1 = p3m_z * F_out(n)
endif
*
F_out(n) = ZERO_8
*
if(zcubic_L) then
rrk = triprd_ad(p4,rrkm,ra,rb,rc)*Adw_zdabc_8(kk+1)
rrk = triprd_ad(p3,rrkm,ra,rb,rd)*Adw_zcabd_8(kk+1) + rrk
rrk = triprd_ad(p2,rrkm,ra,rc,rd)*Adw_zbacd_8(kk+1) + rrk
rrk = triprd_ad(p1,rrkm,rb,rc,rd)*Adw_zabcd_8(kk+1) + rrk
*
else
p3 = -p2 + p3
rrk = (p3)*Adw_zbc_8(kk+1)
endif
*
* ADJ of
********************************************************************************
* y interpolation
********************************************************************************
if(zcubic_L) then
p1 = d1 * d1m + c1 * c1m + b1 * b1m + a1 * a1m
p2 = d1 * d2m + c1 * c2m + b1 * b2m + a1 * a2m
p3 = d1 * d3m + c1 * c3m + b1 * b3m + a1 * a3m
p4 = d1 * d4m + c1 * c4m + b1 * b4m + a1 * a4m
*
else
p1 = c1 * c1m + b1 * b1m
p2 = c1 * c2m + b1 * b2m
p3 = c1 * c3m + b1 * b3m
p4 = c1 * c4m + b1 * b4m
endif
*
if(zcubic_L) then
d2 = p2m_y * d1
d3 = p3m_y * d1
d4 = p4m_y * d1
d1 = p1m_y * d1
endif
*
c2 = p2m_y * c1
c3 = p3m_y * c1
c4 = p4m_y * c1
c1 = p1m_y * c1
*
b2 = p2m_y * b1
b3 = p3m_y * b1
b4 = p4m_y * b1
b1 = p1m_y * b1
*
if(zcubic_L) then
a2 = p2m_y * a1
a3 = p3m_y * a1
a4 = p4m_y * a1
a1 = p1m_y * a1
endif
*
ra = Adw_bsy_8(jj-1)
rb = Adw_bsy_8(jj )
rc = Adw_bsy_8(jj+1)
rd = Adw_bsy_8(jj+2)
*
rrj = triprd_ad(p4,rrjm,ra,rb,rc)*Adw_ydabc_8(jj)
rrj = triprd_ad(p3,rrjm,ra,rb,rd)*Adw_ycabd_8(jj) + rrj
rrj = triprd_ad(p2,rrjm,ra,rc,rd)*Adw_ybacd_8(jj) + rrj
rrj = triprd_ad(p1,rrjm,rb,rc,rd)*Adw_yabcd_8(jj) + rrj
*
* ADJ of
* *********************************************************************
* x interpolation
* *********************************************************************
if(zcubic_L) then
p1 = F_inm (o4-1) * d4 + F_inm (o3-1) * d3 + F_inm (o2-1) * d2 + F_inm (o1-1) * d1
p2 = F_inm (o4) * d4 + F_inm (o3) * d3 + F_inm (o2) * d2 + F_inm (o1) * d1
p3 = F_inm (o4+1) * d4 + F_inm (o3+1) * d3 + F_inm (o2+1) * d2 + F_inm (o1+1) * d1
p4 = F_inm (o4+2) * d4 + F_inm (o3+2) * d3 + F_inm (o2+2) * d2 + F_inm (o1+2) * d1
*
F_in(o4-1) = p1m * d4 + F_in(o4-1)
F_in(o4) = p2m * d4 + F_in(o4)
F_in(o4+1) = p3m * d4 + F_in(o4+1)
F_in(o4+2) = p4m * d4 + F_in(o4+2)
*
F_in(o3-1) = p1m * d3 + F_in(o3-1)
F_in(o3) = p2m * d3 + F_in(o3)
F_in(o3+1) = p3m * d3 + F_in(o3+1)
F_in(o3+2) = p4m * d3 + F_in(o3+2)
*
F_in(o2-1) = p1m * d2 + F_in(o2-1)
F_in(o2) = p2m * d2 + F_in(o2)
F_in(o2+1) = p3m * d2 + F_in(o2+1)
F_in(o2+2) = p4m * d2 + F_in(o2+2)
*
F_in(o1-1) = p1m * d1 + F_in(o1-1)
F_in(o1) = p2m * d1 + F_in(o1)
F_in(o1+1) = p3m * d1 + F_in(o1+1)
F_in(o1+2) = p4m * d1 + F_in(o1+2)
else
p1 = ZERO_8
p2 = ZERO_8
p3 = ZERO_8
p4 = ZERO_8
endif
*
o1 = o1 - nijag
o2 = o2 - nijag
o3 = o3 - nijag
o4 = o4 - nijag
*
p1 = F_inm (o4-1) * c4 + F_inm (o3-1) * c3 + F_inm (o2-1) * c2 + F_inm (o1-1) * c1 + p1
p2 = F_inm (o4) * c4 + F_inm (o3) * c3 + F_inm (o2) * c2 + F_inm (o1) * c1 + p2
p3 = F_inm (o4+1) * c4 + F_inm (o3+1) * c3 + F_inm (o2+1) * c2 + F_inm (o1+1) * c1 + p3
p4 = F_inm (o4+2) * c4 + F_inm (o3+2) * c3 + F_inm (o2+2) * c2 + F_inm (o1+2) * c1 + p4
*
F_in(o4-1) = p1m * c4 + F_in(o4-1)
F_in(o4) = p2m * c4 + F_in(o4)
F_in(o4+1) = p3m * c4 + F_in(o4+1)
F_in(o4+2) = p4m * c4 + F_in(o4+2)
*
F_in(o3-1) = p1m * c3 + F_in(o3-1)
F_in(o3) = p2m * c3 + F_in(o3)
F_in(o3+1) = p3m * c3 + F_in(o3+1)
F_in(o3+2) = p4m * c3 + F_in(o3+2)
*
F_in(o2-1) = p1m * c2 + F_in(o2-1)
F_in(o2) = p2m * c2 + F_in(o2)
F_in(o2+1) = p3m * c2 + F_in(o2+1)
F_in(o2+2) = p4m * c2 + F_in(o2+2)
*
F_in(o1-1) = p1m * c1 + F_in(o1-1)
F_in(o1) = p2m * c1 + F_in(o1)
F_in(o1+1) = p3m * c1 + F_in(o1+1)
F_in(o1+2) = p4m * c1 + F_in(o1+2)
*
if(F_inm(o3+1).lt.prmin7m) then
F_in(o3+1) = prmin + F_in(o3+1)
prmin = ZERO_8
endif
if(F_inm(o3) .lt.prmin6m) then
F_in(o3) = prmin + F_in(o3)
prmin = ZERO_8
endif
if(F_inm(o2+1).lt.prmin5m) then
F_in(o2+1) = prmin + F_in(o2+1)
prmin = ZERO_8
endif
if(F_inm(o2) .lt.prmin4m) then
F_in(o2) = prmin + F_in(o2)
prmin = ZERO_8
endif
*
if(F_inm(o3+1).gt.prmax7m) then
F_in(o3+1) = prmax + F_in(o3+1)
prmax = ZERO_8
endif
if(F_inm(o3) .gt.prmax6m) then
F_in(o3) = prmax + F_in(o3)
prmax = ZERO_8
endif
if(F_inm(o2+1).gt.prmax5m) then
F_in(o2+1) = prmax + F_in(o2+1)
prmax = ZERO_8
endif
if(F_inm(o2) .gt.prmax4m) then
F_in(o2) = prmax + F_in(o2)
prmax = ZERO_8
endif
*
o1 = o1 - nijag
o2 = o2 - nijag
o3 = o3 - nijag
o4 = o4 - nijag
*
p1 = F_inm (o4-1) * b4 + F_inm (o3-1) * b3 + F_inm (o2-1) * b2 + F_inm (o1-1) * b1 + p1
p2 = F_inm (o4) * b4 + F_inm (o3) * b3 + F_inm (o2) * b2 + F_inm (o1) * b1 + p2
p3 = F_inm (o4+1) * b4 + F_inm (o3+1) * b3 + F_inm (o2+1) * b2 + F_inm (o1+1) * b1 + p3
p4 = F_inm (o4+2) * b4 + F_inm (o3+2) * b3 + F_inm (o2+2) * b2 + F_inm (o1+2) * b1 + p4
*
F_in(o4-1) = p1m * b4 + F_in(o4-1)
F_in(o4) = p2m * b4 + F_in(o4)
F_in(o4+1) = p3m * b4 + F_in(o4+1)
F_in(o4+2) = p4m * b4 + F_in(o4+2)
*
F_in(o3-1) = p1m * b3 + F_in(o3-1)
F_in(o3) = p2m * b3 + F_in(o3)
F_in(o3+1) = p3m * b3 + F_in(o3+1)
F_in(o3+2) = p4m * b3 + F_in(o3+2)
*
F_in(o2-1) = p1m * b2 + F_in(o2-1)
F_in(o2) = p2m * b2 + F_in(o2)
F_in(o2+1) = p3m * b2 + F_in(o2+1)
F_in(o2+2) = p4m * b2 + F_in(o2+2)
*
F_in(o1-1) = p1m * b1 + F_in(o1-1)
F_in(o1) = p2m * b1 + F_in(o1)
F_in(o1+1) = p3m * b1 + F_in(o1+1)
F_in(o1+2) = p4m * b1 + F_in(o1+2)
*
if(F_inm(o3+1).lt.prmin3m) then
F_in(o3+1) = prmin + F_in(o3+1)
prmin = ZERO_8
endif
if(F_inm(o3) .lt.prmin2m) then
F_in(o3) = prmin + F_in(o3)
prmin = ZERO_8
endif
if(F_inm(o2+1).lt.prmin1m) then
F_in(o2+1) = prmin + F_in(o2+1)
prmin = ZERO_8
endif
F_in(o2) = prmin + F_in(o2)
prmin = ZERO_8
*
if(F_inm(o3+1).gt.prmax3m) then
F_in(o3+1) = prmax + F_in(o3+1)
prmax = ZERO_8
endif
if(F_inm(o3) .gt.prmax2m) then
F_in(o3) = prmax + F_in(o3)
prmax = ZERO_8
endif
if(F_inm(o2+1).gt.prmax1m) then
F_in(o2+1) = prmax + F_in(o2+1)
prmax = ZERO_8
endif
F_in(o2) = prmax + F_in(o2)
prmax = ZERO_8
*
o1 = o1 - nijag
o2 = o2 - nijag
o3 = o3 - nijag
o4 = o4 - nijag
*
if(zcubic_L) then
p1 = F_inm (o4-1) * a4 + F_inm (o3-1) * a3 + F_inm (o2-1) * a2 + F_inm (o1-1) * a1 + p1
p2 = F_inm (o4) * a4 + F_inm (o3) * a3 + F_inm (o2) * a2 + F_inm (o1) * a1 + p2
p3 = F_inm (o4+1) * a4 + F_inm (o3+1) * a3 + F_inm (o2+1) * a2 + F_inm (o1+1) * a1 + p3
p4 = F_inm (o4+2) * a4 + F_inm (o3+2) * a3 + F_inm (o2+2) * a2 + F_inm (o1+2) * a1 + p4
*
F_in(o4-1) = p1m * a4 + F_in(o4-1)
F_in(o4) = p2m * a4 + F_in(o4)
F_in(o4+1) = p3m * a4 + F_in(o4+1)
F_in(o4+2) = p4m * a4 + F_in(o4+2)
*
F_in(o3-1) = p1m * a3 + F_in(o3-1)
F_in(o3) = p2m * a3 + F_in(o3)
F_in(o3+1) = p3m * a3 + F_in(o3+1)
F_in(o3+2) = p4m * a3 + F_in(o3+2)
*
F_in(o2-1) = p1m * a2 + F_in(o2-1)
F_in(o2) = p2m * a2 + F_in(o2)
F_in(o2+1) = p3m * a2 + F_in(o2+1)
F_in(o2+2) = p4m * a2 + F_in(o2+2)
*
F_in(o1-1) = p1m * a1 + F_in(o1-1)
F_in(o1) = p2m * a1 + F_in(o1)
F_in(o1+1) = p3m * a1 + F_in(o1+1)
F_in(o1+2) = p4m * a1 + F_in(o1+2)
endif
*
ra = Adw_bsx_8(ii-1)
rb = Adw_bsx_8(ii )
rc = Adw_bsx_8(ii+1)
rd = Adw_bsx_8(ii+2)
*
rri = triprd_ad(p4,rrim,ra,rb,rc)*Adw_xdabc_8(ii)
rri = triprd_ad(p3,rrim,ra,rb,rd)*Adw_xcabd_8(ii) + rri
rri = triprd_ad(p2,rrim,ra,rc,rd)*Adw_xbacd_8(ii) + rri
rri = triprd_ad(p1,rrim,rb,rc,rd)*Adw_xabcd_8(ii) + rri
*
F_z(n) = rrk + F_z(n)
F_y(n) = rrj + F_y(n)
F_x(n) = rri + F_x(n)
*
80 continue
90 continue
100 continue
*
else
*
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 (START)
* ------------------
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))
*
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))
*
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))
*
zcubic_L = (kk.gt.0) .and. (kk.lt.kkmax-1)
*
* *********************************************************************
* x interpolation
* *********************************************************************
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)
*
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
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)
endif
*
o1 = o1 + nijag
o2 = o2 + nijag
o3 = o3 + nijag
o4 = o4 + nijag
*
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)
*
o1 = o1 + nijag
o2 = o2 + nijag
o3 = o3 + nijag
o4 = o4 + nijag
*
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)
*
o1 = o1 + nijag
o2 = o2 + nijag
o3 = o3 + nijag
o4 = o4 + nijag
*
if(zcubic_L) then
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)
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)
*
p1m_y = triprd(rrjm,rb,rc,rd)*Adw_yabcd_8(jj)
p2m_y = triprd(rrjm,ra,rc,rd)*Adw_ybacd_8(jj)
p3m_y = triprd(rrjm,ra,rb,rd)*Adw_ycabd_8(jj)
p4m_y = triprd(rrjm,ra,rb,rc)*Adw_ydabc_8(jj)
*
if(zcubic_L)a1m_z = p1m_y * a1m + p2m_y * a2m + p3m_y * a3m + p4m_y * a4m
b1m_z = p1m_y * b1m + p2m_y * b2m + p3m_y * b3m + p4m_y * b4m
c1m_z = p1m_y * c1m + p2m_y * c2m + p3m_y * c3m + p4m_y * c4m
if(zcubic_L)d1m_z = p1m_y * d1m + p2m_y * d2m + p3m_y * d3m + p4m_y * 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)
*
p1m_z = triprd(rrkm,rb,rc,rd)*Adw_zabcd_8(kk+1)
p2m_z = triprd(rrkm,ra,rc,rd)*Adw_zbacd_8(kk+1)
p3m_z = triprd(rrkm,ra,rb,rd)*Adw_zcabd_8(kk+1)
p4m_z = triprd(rrkm,ra,rb,rc)*Adw_zdabc_8(kk+1)
*
else
*
p3m_z = (rrkm-Adw_bsz_8(kk))*Adw_zbc_8(kk+1)
p2m_z = 1. - p3m_z
*
endif
*
* ----------------
* TRAJECTORY (END)
* ----------------
*
* ADJOINT CALCULATIONS
* --------------------
*
* ADJ of
********************************************************************************
* z interpolation
********************************************************************************
if(zcubic_L) then
p1 = F_out(n) * a1m_z
p2 = F_out(n) * b1m_z
p3 = F_out(n) * c1m_z
p4 = F_out(n) * d1m_z
a1 = p1m_z * F_out(n)
b1 = p2m_z * F_out(n)
c1 = p3m_z * F_out(n)
d1 = p4m_z * F_out(n)
*
else
p2 = F_out(n) * b1m_z
p3 = F_out(n) * c1m_z
b1 = p2m_z * F_out(n)
c1 = p3m_z * F_out(n)
endif
*
F_out(n) = ZERO_8
*
if(zcubic_L) then
rrk = triprd_ad(p4,rrkm,ra,rb,rc)*Adw_zdabc_8(kk+1)
rrk = triprd_ad(p3,rrkm,ra,rb,rd)*Adw_zcabd_8(kk+1) + rrk
rrk = triprd_ad(p2,rrkm,ra,rc,rd)*Adw_zbacd_8(kk+1) + rrk
rrk = triprd_ad(p1,rrkm,rb,rc,rd)*Adw_zabcd_8(kk+1) + rrk
*
else
p3 = -p2 + p3
rrk = (p3)*Adw_zbc_8(kk+1)
endif
*
* ADJ of
********************************************************************************
* y interpolation
********************************************************************************
if(zcubic_L) then
p1 = d1 * d1m + c1 * c1m + b1 * b1m + a1 * a1m
p2 = d1 * d2m + c1 * c2m + b1 * b2m + a1 * a2m
p3 = d1 * d3m + c1 * c3m + b1 * b3m + a1 * a3m
p4 = d1 * d4m + c1 * c4m + b1 * b4m + a1 * a4m
*
else
p1 = c1 * c1m + b1 * b1m
p2 = c1 * c2m + b1 * b2m
p3 = c1 * c3m + b1 * b3m
p4 = c1 * c4m + b1 * b4m
endif
*
if(zcubic_L) then
d2 = p2m_y * d1
d3 = p3m_y * d1
d4 = p4m_y * d1
d1 = p1m_y * d1
endif
*
c2 = p2m_y * c1
c3 = p3m_y * c1
c4 = p4m_y * c1
c1 = p1m_y * c1
*
b2 = p2m_y * b1
b3 = p3m_y * b1
b4 = p4m_y * b1
b1 = p1m_y * b1
*
if(zcubic_L) then
a2 = p2m_y * a1
a3 = p3m_y * a1
a4 = p4m_y * a1
a1 = p1m_y * a1
endif
*
ra = Adw_bsy_8(jj-1)
rb = Adw_bsy_8(jj )
rc = Adw_bsy_8(jj+1)
rd = Adw_bsy_8(jj+2)
*
rrj = triprd_ad(p4,rrjm,ra,rb,rc)*Adw_ydabc_8(jj)
rrj = triprd_ad(p3,rrjm,ra,rb,rd)*Adw_ycabd_8(jj) + rrj
rrj = triprd_ad(p2,rrjm,ra,rc,rd)*Adw_ybacd_8(jj) + rrj
rrj = triprd_ad(p1,rrjm,rb,rc,rd)*Adw_yabcd_8(jj) + rrj
*
* ADJ of
* *********************************************************************
* x interpolation
* *********************************************************************
if(zcubic_L) then
p1 = F_inm (o4-1) * d4 + F_inm (o3-1) * d3 + F_inm (o2-1) * d2 + F_inm (o1-1) * d1
p2 = F_inm (o4) * d4 + F_inm (o3) * d3 + F_inm (o2) * d2 + F_inm (o1) * d1
p3 = F_inm (o4+1) * d4 + F_inm (o3+1) * d3 + F_inm (o2+1) * d2 + F_inm (o1+1) * d1
p4 = F_inm (o4+2) * d4 + F_inm (o3+2) * d3 + F_inm (o2+2) * d2 + F_inm (o1+2) * d1
*
F_in(o4-1) = p1m * d4 + F_in(o4-1)
F_in(o4) = p2m * d4 + F_in(o4)
F_in(o4+1) = p3m * d4 + F_in(o4+1)
F_in(o4+2) = p4m * d4 + F_in(o4+2)
*
F_in(o3-1) = p1m * d3 + F_in(o3-1)
F_in(o3) = p2m * d3 + F_in(o3)
F_in(o3+1) = p3m * d3 + F_in(o3+1)
F_in(o3+2) = p4m * d3 + F_in(o3+2)
*
F_in(o2-1) = p1m * d2 + F_in(o2-1)
F_in(o2) = p2m * d2 + F_in(o2)
F_in(o2+1) = p3m * d2 + F_in(o2+1)
F_in(o2+2) = p4m * d2 + F_in(o2+2)
*
F_in(o1-1) = p1m * d1 + F_in(o1-1)
F_in(o1) = p2m * d1 + F_in(o1)
F_in(o1+1) = p3m * d1 + F_in(o1+1)
F_in(o1+2) = p4m * d1 + F_in(o1+2)
else
p1 = ZERO_8
p2 = ZERO_8
p3 = ZERO_8
p4 = ZERO_8
endif
*
o1 = o1 - nijag
o2 = o2 - nijag
o3 = o3 - nijag
o4 = o4 - nijag
*
p1 = F_inm (o4-1) * c4 + F_inm (o3-1) * c3 + F_inm (o2-1) * c2 + F_inm (o1-1) * c1 + p1
p2 = F_inm (o4) * c4 + F_inm (o3) * c3 + F_inm (o2) * c2 + F_inm (o1) * c1 + p2
p3 = F_inm (o4+1) * c4 + F_inm (o3+1) * c3 + F_inm (o2+1) * c2 + F_inm (o1+1) * c1 + p3
p4 = F_inm (o4+2) * c4 + F_inm (o3+2) * c3 + F_inm (o2+2) * c2 + F_inm (o1+2) * c1 + p4
*
F_in(o4-1) = p1m * c4 + F_in(o4-1)
F_in(o4) = p2m * c4 + F_in(o4)
F_in(o4+1) = p3m * c4 + F_in(o4+1)
F_in(o4+2) = p4m * c4 + F_in(o4+2)
*
F_in(o3-1) = p1m * c3 + F_in(o3-1)
F_in(o3) = p2m * c3 + F_in(o3)
F_in(o3+1) = p3m * c3 + F_in(o3+1)
F_in(o3+2) = p4m * c3 + F_in(o3+2)
*
F_in(o2-1) = p1m * c2 + F_in(o2-1)
F_in(o2) = p2m * c2 + F_in(o2)
F_in(o2+1) = p3m * c2 + F_in(o2+1)
F_in(o2+2) = p4m * c2 + F_in(o2+2)
*
F_in(o1-1) = p1m * c1 + F_in(o1-1)
F_in(o1) = p2m * c1 + F_in(o1)
F_in(o1+1) = p3m * c1 + F_in(o1+1)
F_in(o1+2) = p4m * c1 + F_in(o1+2)
*
o1 = o1 - nijag
o2 = o2 - nijag
o3 = o3 - nijag
o4 = o4 - nijag
*
p1 = F_inm (o4-1) * b4 + F_inm (o3-1) * b3 + F_inm (o2-1) * b2 + F_inm (o1-1) * b1 + p1
p2 = F_inm (o4) * b4 + F_inm (o3) * b3 + F_inm (o2) * b2 + F_inm (o1) * b1 + p2
p3 = F_inm (o4+1) * b4 + F_inm (o3+1) * b3 + F_inm (o2+1) * b2 + F_inm (o1+1) * b1 + p3
p4 = F_inm (o4+2) * b4 + F_inm (o3+2) * b3 + F_inm (o2+2) * b2 + F_inm (o1+2) * b1 + p4
*
F_in(o4-1) = p1m * b4 + F_in(o4-1)
F_in(o4) = p2m * b4 + F_in(o4)
F_in(o4+1) = p3m * b4 + F_in(o4+1)
F_in(o4+2) = p4m * b4 + F_in(o4+2)
*
F_in(o3-1) = p1m * b3 + F_in(o3-1)
F_in(o3) = p2m * b3 + F_in(o3)
F_in(o3+1) = p3m * b3 + F_in(o3+1)
F_in(o3+2) = p4m * b3 + F_in(o3+2)
*
F_in(o2-1) = p1m * b2 + F_in(o2-1)
F_in(o2) = p2m * b2 + F_in(o2)
F_in(o2+1) = p3m * b2 + F_in(o2+1)
F_in(o2+2) = p4m * b2 + F_in(o2+2)
*
F_in(o1-1) = p1m * b1 + F_in(o1-1)
F_in(o1) = p2m * b1 + F_in(o1)
F_in(o1+1) = p3m * b1 + F_in(o1+1)
F_in(o1+2) = p4m * b1 + F_in(o1+2)
*
o1 = o1 - nijag
o2 = o2 - nijag
o3 = o3 - nijag
o4 = o4 - nijag
*
if(zcubic_L) then
p1 = F_inm (o4-1) * a4 + F_inm (o3-1) * a3 + F_inm (o2-1) * a2 + F_inm (o1-1) * a1 + p1
p2 = F_inm (o4) * a4 + F_inm (o3) * a3 + F_inm (o2) * a2 + F_inm (o1) * a1 + p2
p3 = F_inm (o4+1) * a4 + F_inm (o3+1) * a3 + F_inm (o2+1) * a2 + F_inm (o1+1) * a1 + p3
p4 = F_inm (o4+2) * a4 + F_inm (o3+2) * a3 + F_inm (o2+2) * a2 + F_inm (o1+2) * a1 + p4
*
F_in(o4-1) = p1m * a4 + F_in(o4-1)
F_in(o4) = p2m * a4 + F_in(o4)
F_in(o4+1) = p3m * a4 + F_in(o4+1)
F_in(o4+2) = p4m * a4 + F_in(o4+2)
*
F_in(o3-1) = p1m * a3 + F_in(o3-1)
F_in(o3) = p2m * a3 + F_in(o3)
F_in(o3+1) = p3m * a3 + F_in(o3+1)
F_in(o3+2) = p4m * a3 + F_in(o3+2)
*
F_in(o2-1) = p1m * a2 + F_in(o2-1)
F_in(o2) = p2m * a2 + F_in(o2)
F_in(o2+1) = p3m * a2 + F_in(o2+1)
F_in(o2+2) = p4m * a2 + F_in(o2+2)
*
F_in(o1-1) = p1m * a1 + F_in(o1-1)
F_in(o1) = p2m * a1 + F_in(o1)
F_in(o1+1) = p3m * a1 + F_in(o1+1)
F_in(o1+2) = p4m * a1 + F_in(o1+2)
endif
*
ra = Adw_bsx_8(ii-1)
rb = Adw_bsx_8(ii )
rc = Adw_bsx_8(ii+1)
rd = Adw_bsx_8(ii+2)
*
rri = triprd_ad(p4,rrim,ra,rb,rc)*Adw_xdabc_8(ii)
rri = triprd_ad(p3,rrim,ra,rb,rd)*Adw_xcabd_8(ii) + rri
rri = triprd_ad(p2,rrim,ra,rc,rd)*Adw_xbacd_8(ii) + rri
rri = triprd_ad(p1,rrim,rb,rc,rd)*Adw_xabcd_8(ii) + rri
*
F_z(n) = rrk + F_z(n)
F_y(n) = rrj + F_y(n)
F_x(n) = rri + F_x(n)
*
81 continue
91 continue
101 continue
*
endif
*
return
end