!-------------------------------------- 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/p adw_trilin_turbo_tl - TLM of adw_trilin_turbo
*
#include "model_macros_f.h"
*
subroutine adw_trilin_turbo_tl ( F_out, F_in, F_dt, F_x, F_y, F_z, 6
% F_outm, F_inm, F_xm,F_ym,F_zm,
% F_capxm, F_capym, F_capzm,
% Fn_I, F_num,i0,in,j0,jn,kn)
*
implicit none
*
integer F_num,i0,in,j0,jn,kn, Fn_I(F_num)
*
real F_dt, 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)
*
real F_capxm(F_num),F_capym(F_num),F_capzm(F_num)
*
*authors
* Monique Tanguay
*
* (Based on adw_trilin_tl v_3.1.1)
*
*revision
* v3_20 - Tanguay M. - initial version
*
*object
* see id section
*
*arguments
*______________________________________________________________________
* | | |
* NAME | DESCRIPTION | I/O |
*--------------|-------------------------------------------------|-----|
* | | |
* F_out | F_dt * result of interpolation | o |
* F_in | field to interpolate | i |
* | | |
* F_dt | multiplicative constant (1.0 or timestep lenght)| i |
* | | |
* F_n | positions in the 3D volume of interpolation | i |
* | boxes | |
* | | |
* F_capx | \ | i |
* F_capy | precomputed displacements | i |
* F_capz | / along the x,y,z directions | i |
* | | |
* F_num | number of points to interpolate | i |
*______________|_________________________________________________|_____|
*
*implicits
#include "glb_ld.cdk"
#include "adw.cdk"
*
************************************************************************
integer n, n0, nijag, nij, o1, o2, i, j, k, iimax, jjmax, kkmax
*
integer ii,jj,kk
real*8 rri, rrj, rrk,rb, rc
real*8 rrim,rrjm,rrkm
*
real capx, capy, capz, capxm, capym, capzm
*
real*8 prf1_8, prf2_8, prf3_8, prf4_8, prf1_y_8, prf2_y_8
real*8 prf1m_8,prf2m_8,prf3m_8,prf4m_8,prf1m_y_8,prf2m_y_8
* ------------------------------------------------------------------
*
nijag = Adw_nit * Adw_njt
nij = l_ni*l_nj
*
iimax = G_ni+2*Adw_halox-1
jjmax = G_nj+Adw_haloy
kkmax = l_nk-1
*
!$omp parallel private(n,n0,o1,o2,i,j,k,ii,jj,kk,
!$omp& rri, rrj, rrk,rb, rc, rrim,rrjm,rrkm,
!$omp& capx, capy, capz, capxm, capym, capzm,
!$omp& prf1_8,prf2_8,prf3_8,prf4_8,prf1_y_8,prf2_y_8,
!$omp& prf1m_8,prf2m_8,prf3m_8,prf4m_8,prf1m_y_8,prf2m_y_8)
!$omp do
do 100 k=1,kn
do 90 j=j0,jn
n0 = (k-1)*nij + ((j-1)*l_ni)
*
* ------------------
* TRAJECTORY (START)
* ------------------
if ( Adw_hor_L ) then
do i=i0,in
n = n0 + i
*
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))
*
F_capxm(n) = (rrim-Adw_bsx_8(ii)) *Adw_xbc_8(ii)
*
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))
*
F_capym(n) = (rrjm-Adw_bsy_8(jj)) *Adw_ybc_8(jj)
*
kk = ishft(Fn_I(n) , -24)
Fn_I(n) = ior( ior(ishft(jj,12) , ii) , ishft( kk , 24) )
*
enddo
endif
if ( Adw_ver_L ) then
do i=i0,in
n = n0 + i
*
rrkm= F_zm(n)
kk = ( rrkm - Adw_z00_8 ) * Adw_ovdz_8
kk = Adw_lcz( kk+1 )
rrkm = rrkm - Adw_bsz_8(kk)
if ( rrkm .lt. 0.0 ) kk = kk - 1
*
F_capzm(n) = rrkm * Adw_diz_8(kk)
if ( rrkm .lt. 0.0 ) F_capzm(n) = 1.0 + F_capzm(n)
*
ii = and( Fn_I(n) , 4095 )
jj = and( ishft( Fn_I(n) , -12 ) , 4095 )
Fn_I(n) = ior( ior(ishft(jj,12) , ii) , ishft( kk , 24) )
*
enddo
endif
* ----------------
* TRAJECTORY (END)
* ----------------
*
do 80 i=i0,in
n = n0 + i
*
* TRAJECTORY
* ----------
ii = and( Fn_I(n) , 4095 )
jj = and( ishft( Fn_I(n) , -12 ) , 4095 )
kk = ishft(Fn_I(n) , -24)
*
* TRAJECTORY
* ----------
C rrim= F_xm(n)
C rrjm= F_ym(n)
C rrkm= F_zm(n)
*
* TLM
* ---
rri= F_x(n)
rrj= F_y(n)
rrk= F_z(n)
*
* TRAJECTORY
* ----------
o1 = (kk)*nijag + (jj-Adw_int_j_off-1)*Adw_nit + (ii-Adw_int_i_off)
o2 = o1 + Adw_nit
*
************************************************************************
* x interpolation
************************************************************************
*
* TRAJECTORY
* ----------
c capxm = (rrim-Adw_bsx_8(ii)) *Adw_xbc_8(ii)
capxm = F_capxm(n)
*
prf1m_8 = (1.0 - capxm) * F_inm(o1) + capxm * F_inm(o1+1)
prf2m_8 = (1.0 - capxm) * F_inm(o2) + capxm * F_inm(o2+1)
*
* TLM
* ---
capx = rri *Adw_xbc_8(ii)
*
prf1_8 = (1.0 - capxm) * F_in (o1) + capxm * F_in (o1+1) +
% ( F_inm(o1+1) - F_inm(o1))* capx
prf2_8 = (1.0 - capxm) * F_in (o2) + capxm * F_in (o2+1) +
% ( F_inm(o2+1) - F_inm(o2))* capx
*
* TRAJECTORY
* ----------
o1 = o1 + nijag
o2 = o2 + nijag
*
* TRAJECTORY
* ----------
prf3m_8 = (1.0 - capxm) * F_inm(o1) + capxm * F_inm(o1+1)
prf4m_8 = (1.0 - capxm) * F_inm(o2) + capxm * F_inm(o2+1)
*
* TLM
* ---
prf3_8 = (1.0 - capxm) * F_in (o1) + capxm * F_in (o1+1) +
% ( F_inm(o1+1) - F_inm(o1))* capx
prf4_8 = (1.0 - capxm) * F_in (o2) + capxm * F_in (o2+1) +
% ( F_inm(o2+1) - F_inm(o2))* capx
************************************************************************
* y interpolation
************************************************************************
* TRAJECTORY
* ----------
c capym = (rrjm-Adw_bsy_8(jj)) *Adw_ybc_8(jj)
capym = F_capym(n)
*
prf1m_y_8= (1.0 - capym) * prf1m_8 + capym * prf2m_8
prf2m_y_8= (1.0 - capym) * prf3m_8 + capym * prf4m_8
*
* TLM
* ---
capy = rrj *Adw_ybc_8(jj)
*
prf1_y_8 = (1.0 - capym) * prf1_8 + capym * prf2_8 +
% ( prf2m_8 - prf1m_8)* capy
prf2_y_8 = (1.0 - capym) * prf3_8 + capym * prf4_8 +
% ( prf4m_8 - prf3m_8)* capy
************************************************************************
* z interpolation
************************************************************************
* TRAJECTORY
* ----------
capzm = F_capzm(n)
*
F_outm(n) = ( (1.0 - capzm) * prf1m_y_8 + capzm * prf2m_y_8 ) * F_dt
*
* TLM
* ---
capz = rrk * Adw_diz_8(kk)
*
F_out(n) = ( (1.0 - capzm) * prf1_y_8 + capzm * prf2_y_8 +
% (prf2m_y_8 - prf1m_y_8) * capz ) * F_dt
*
80 continue
90 continue
100 continue
!$omp enddo
!$omp end parallel
*
Adw_hor_L = .false.
Adw_ver_L = .false.
*
return
end