!-------------------------------------- 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_ad - ADJ of adw_trilin_turbo_tl
*
#include "model_macros_f.h"
*
subroutine adw_trilin_turbo_ad ( F_out, F_in, F_dt, F_x, F_y, F_z, 8
% F_inm,
% 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_capxm(F_num),F_capym(F_num),F_capzm(F_num)
*
*authors
* Monique Tanguay
*
* (Based on adw_trilin_ad v_3.1.1)
*
*revision
* v3_20 - Tanguay M. - initial version
* v3_21 - Tanguay M. - OPENMP based on min-max vertical CFL
*
*object
* see id section
*
*ADJ of
*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"
#include "ptopo.cdk"
#include "lun.cdk"
#include "v4dcfl.cdk"
************************************************************************
integer n,nn,n0,nijag,o1,o2,i,j,k,nij,shift
*
integer ii,jj,kk
real*8 rri, rrj, rrk
*
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
*
real*8, parameter :: ZERO_8 = 0.0
*
logical done_L
data done_L /.false./
save done_L
integer cflp(Ptopo_numproc),cfln(Ptopo_numproc),iproc,err
*
* ------------------------------------------------------------------
*
if(.not.done_L) then
*
* Evaluate min-max vertical CFL
* -----------------------------
V4dcfl_p0 = V4dcfl_p(1)
V4dcfl_n0 = V4dcfl_n(1)
do k=2,l_nk
if (V4dcfl_p(k).gt.V4dcfl_p0) then
V4dcfl_p0 = V4dcfl_p(k)
endif
if (V4dcfl_n(k).lt.V4dcfl_n0) then
V4dcfl_n0 = V4dcfl_n(k)
endif
enddo
*
call RPN_COMM_gather (V4dcfl_p0,1,"MPI_INTEGER",cflp,1,
$ "MPI_INTEGER",0,"GRID", err)
call RPN_COMM_gather (V4dcfl_n0,1,"MPI_INTEGER",cfln,1,
$ "MPI_INTEGER",0,"GRID", err)
*
if (Ptopo_myproc.eq.0) then
*
V4dcfl_p0 = cflp(1)
V4dcfl_n0 = cfln(1)
do iproc = 2, Ptopo_numproc
if (cflp(iproc).gt.V4dcfl_p0)
% V4dcfl_p0 = cflp(iproc)
if (cfln(iproc).lt.V4dcfl_n0)
% V4dcfl_n0 = cfln(iproc)
end do
*
endif
*
call RPN_COMM_bcast(V4dcfl_p0,1,"MPI_INTEGER",0,"grid",err )
call RPN_COMM_bcast(V4dcfl_n0,1,"MPI_INTEGER",0,"grid",err )
*
* Evaluate admissible distance between threads
* --------------------------------------------
V4dcfl_dist = max((kn+Ptopo_npeOpenMP-1)/Ptopo_npeOpenMP,
% 2 + V4dcfl_p0 - V4dcfl_n0)
*
if (Ptopo_myproc.eq.0.and.Lun_out.gt.0) then
write(Lun_out,*) 'ADW_TRILIN_AD: max vertical CFL =',V4dcfl_p0
write(Lun_out,*) 'ADW_TRILIN_AD: min vertical CFL =',V4dcfl_n0
write(Lun_out,*) 'ADW_TRILIN_AD: Distance between threads =',V4dcfl_dist
endif
*
done_L = .true.
endif
*
* Initializations
* ---------------
nij = l_ni*l_nj
nijag = Adw_nit * Adw_njt
*
* Distribute levels respecting admissible distance between threads
* ----------------------------------------------------------------
do shift=1,V4dcfl_dist
*
!$omp parallel do private(n,nn,n0,o1,o2,i,j,k,
!$omp& ii,jj,kk,rri,rrj,rrk,
!$omp& capx, capy, capz, capxm, capym, capzm,
!$omp& prf1_8, prf2_8, prf3_8, prf4_8,
!$omp& prf1_y_8,prf2_y_8,prf1m_8, prf2m_8,
!$omp& prf3m_8, prf4m_8, prf1m_y_8,prf2m_y_8)
!$omp& shared(shift)
*
do k=shift,kn,V4dcfl_dist
*
do j=j0,jn
*
n0 = (k-1)*nij + ((j-1)*l_ni)
*
do i=i0,in
*
n = n0 + i
*
* ------------------
* TRAJECTORY (START)
* ------------------
ii = and( Fn_I(n) , 4095 )
jj = and( ishft( Fn_I(n) , -12 ) , 4095 )
kk = ishft(Fn_I(n) , -24)
*
o1 = (kk)*nijag + (jj-Adw_int_j_off-1)*Adw_nit + (ii-Adw_int_i_off)
o2 = o1 + Adw_nit
*
************************************************************************
* x interpolation
************************************************************************
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)
*
o1 = o1 + nijag
o2 = o2 + nijag
*
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)
************************************************************************
* y interpolation
************************************************************************
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
*
************************************************************************
* z interpolation
************************************************************************
capzm = F_capzm(n)
*
* ----------------
* TRAJECTORY (END)
* ----------------
*
************************************************************************
* ADJ of
* z interpolation
************************************************************************
prf2_y_8 = capzm * F_out(n) * F_dt
prf1_y_8 = (1.0-capzm) * F_out(n) * F_dt
capz = (prf2m_y_8 - prf1m_y_8) * F_out(n) * F_dt
F_out (n) = ZERO_8
*
rrk = capz * Adw_diz_8(kk)
*
************************************************************************
* ADJ of
* y interpolation
************************************************************************
prf4_8 = capym * prf2_y_8
prf3_8 = (1.0-capym) * prf2_y_8
*
prf2_8 = capym * prf1_y_8
prf1_8 = (1.0-capym) * prf1_y_8
*
capy = (prf4m_8 - prf3m_8) * prf2_y_8
% + (prf2m_8 - prf1m_8) * prf1_y_8
*
rrj = capy *Adw_ybc_8(jj)
*
************************************************************************
* x interpolation
************************************************************************
F_in(o2+1) = F_in(o2+1) + capxm * prf4_8
F_in(o2 ) = F_in(o2 ) + (1.0-capxm) * prf4_8
*
F_in(o1+1) = F_in(o1+1) + capxm * prf3_8
F_in(o1 ) = F_in(o1 ) + (1.0-capxm) * prf3_8
*
capx = (F_inm(o2+1) - F_inm(o2)) * prf4_8
% + (F_inm(o1+1) - F_inm(o1)) * prf3_8
*
o1 = o1 - nijag
o2 = o2 - nijag
*
F_in(o2+1) = F_in(o2+1) + capxm * prf2_8
F_in(o2 ) = F_in(o2 ) + (1.0-capxm) * prf2_8
*
F_in(o1+1) = F_in(o1+1) + capxm * prf1_8
F_in(o1 ) = F_in(o1 ) + (1.0-capxm) * prf1_8
*
capx = (F_inm(o2+1) - F_inm(o2)) * prf2_8
% + (F_inm(o1+1) - F_inm(o1)) * prf1_8 + capx
*
rri = capx *Adw_xbc_8(ii)
*
F_x(n) = rri + F_x(n)
F_y(n) = rrj + F_y(n)
F_z(n) = rrk + F_z(n)
*
enddo
enddo
enddo
!$omp end parallel do
*
enddo
*
return
end