!-------------------------------------- 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 nlip_2 - compute non-linear portion of momentum, divergence and
* thermodynamic equations
* compute non-linear portion of reduced set of equations
* ( computation and microtasking )
*
***********************************************************************
*
#include "model_macros_f.h"
*
subroutine nlip_2 ( F_nu, F_nv, F_n1, F_nth, F_n3, F_n3p, 2,1
$ F_rheln, F_rhell, F_tpt0, F_tplt0, F_pipt0,
$ F_ncn, F_st0 , F_qt0 , F_fipt0, F_fis ,
$ F_ut0, F_vt0, F_mut0 , F_multx,
$ F_wijk1, F_wijk2, DIST_DIM, Nk )
*
implicit none
*
integer DIST_DIM, Nk
real F_nu (DIST_SHAPE,Nk), F_nv (DIST_SHAPE,Nk),
% F_n1 (DIST_SHAPE,Nk), F_nth (DIST_SHAPE,Nk),
% F_n3 (DIST_SHAPE,Nk), F_n3p (DIST_SHAPE,Nk),
% F_rheln(DIST_SHAPE,Nk), F_rhell(DIST_SHAPE,Nk),
% F_tpt0 (DIST_SHAPE,Nk), F_tplt0(DIST_SHAPE,Nk),
% F_pipt0(DIST_SHAPE,Nk), F_ncn (DIST_SHAPE,Nk),
% F_st0 (DIST_SHAPE) , F_qt0 (DIST_SHAPE,Nk),
% F_fipt0(DIST_SHAPE,Nk), F_fis (DIST_SHAPE) ,
% F_ut0 (DIST_SHAPE,Nk), F_vt0 (DIST_SHAPE,Nk),
% F_mut0 (DIST_SHAPE,Nk), F_multx(DIST_SHAPE,Nk),
% F_wijk1(DIST_SHAPE,Nk), F_wijk2(DIST_SHAPE,Nk)
*
*author
* Alain Patoine - split from nli.ftn
*
*revision
* v2_00 - Desgagne M. - initial MPI version (from rhs v1_03)
* v2_21 - Lee V. - modifications for LAM version
* v2_30 - Edouard S. - adapt for vertical hybrid coordinate
* remove F_pptt0 and introduce Ncn
* v3_00 - Qaddouri & Lee - For LAM, set Nu, Nv values on the boundaries
* v3_00 of the LAM grid to zeros.
* v3_02 - Edouard S. - correct non-hydrostatic version (F_mut0,F_tpt0,b2)
* v3_10 - Corbeil & Desgagne & Lee - AIXport+Opti+OpenMP
* v3_21 - Desgagne M. - Revision OpenMP
* v3_30 - Desgagne M. - Revision OpenMP
*
*object
*
*arguments
* see documentation of appropriate comdecks
*
*implicits
#include "glb_ld.cdk"
*
integer i01, in1, j01, jn1, nij, i02, in2, j02, jn2
**
* __________________________________________________________________
*
*
* Prepare the nonlinear perturbation q" of log hydro pressure
* and the "relative" geopotential ( phi' + phis ) for gradient
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
i01=1
in1=l_ni
j01=1
jn1=l_nj
i02=1
in2=l_ni
j02=1
jn2=l_nj
if (G_lam) then
if (l_west) i01=1+pil_w -1
if (l_east) in1=l_ni-pil_e +1
if (l_south)j01=1+pil_s -1
if (l_north)jn1=l_nj-pil_n +1
if (l_west) i02=1+pil_w
if (l_east) in2=l_ni-pil_e
if (l_south)j02=1+pil_s
if (l_north)jn2=l_nj-pil_n
endif
*
call nlip_2_2 ( F_nu, F_nv, F_n1, F_nth, F_n3, F_n3p,
$ F_rheln, F_rhell, F_tpt0, F_tplt0, F_pipt0,
$ F_ncn, F_st0 , F_qt0 , F_fipt0, F_fis ,
$ F_ut0, F_vt0, F_mut0 , F_multx,
$ F_wijk1, F_wijk2, DIST_DIM, Nk,
$ i01,j01,in1,jn1,i02,j02,in2,jn2 )
return
end
!
! 2nd stage added for OpenMP
!
subroutine nlip_2_2 ( F_nu, F_nv, F_n1, F_nth, F_n3, F_n3p, 1,1
$ F_rheln, F_rhell, F_tpt0, F_tplt0, F_pipt0,
$ F_ncn, F_st0 , F_qt0 , F_fipt0, F_fis ,
$ F_ut0, F_vt0, F_mut0 , F_multx,
$ F_wijk1, F_wijk2, DIST_DIM, Nk,
$ i01,j01,in1,jn1,i02,j02,in2,jn2 )
*
implicit none
*
integer DIST_DIM, Nk,i01,j01,in1,jn1,i02,j02,in2,jn2
real F_nu (DIST_SHAPE,Nk), F_nv (DIST_SHAPE,Nk),
% F_n1 (DIST_SHAPE,Nk), F_nth (DIST_SHAPE,Nk),
% F_n3 (DIST_SHAPE,Nk), F_n3p (DIST_SHAPE,Nk),
% F_rheln(DIST_SHAPE,Nk), F_rhell(DIST_SHAPE,Nk),
% F_tpt0 (DIST_SHAPE,Nk), F_tplt0(DIST_SHAPE,Nk),
% F_pipt0(DIST_SHAPE,Nk), F_ncn (DIST_SHAPE,Nk),
% F_st0 (DIST_SHAPE) , F_qt0 (DIST_SHAPE,Nk),
% F_fipt0(DIST_SHAPE,Nk), F_fis (DIST_SHAPE) ,
% F_ut0 (DIST_SHAPE,Nk), F_vt0 (DIST_SHAPE,Nk),
% F_mut0 (DIST_SHAPE,Nk), F_multx(DIST_SHAPE,Nk),
% F_wijk1(DIST_SHAPE,Nk), F_wijk2(DIST_SHAPE,Nk)
#include "glb_ld.cdk"
#include "cstv.cdk"
#include "dcst.cdk"
#include "geomg.cdk"
#include "cori.cdk"
#include "schm.cdk"
#include "intuv.cdk"
#include "inuvl.cdk"
#include "ptopo.cdk"
*
integer i, j, k, i00, inn, j00, jnn, i0, in, j0, jn, nij
real wk2(DIST_SHAPE), w1, w2, w3, q1
real*8 eps, gamma, p1,p2,p3,p4,p5,p6,p7, t1,t2,t3,t4
*
real*8 one, half, quarter
parameter ( one=1.0, half=.5, quarter=.25 )
*
real*8, dimension(i01:in1,j01:jn1) :: xlog, ylog
real*8, dimension(i02:in2,j02:jn2) :: xexp2, yexp2, xlog2, ylog2
*
* --------------------------------------------------------------------
call rpn_comm_xch_halo( F_tpt0 , LDIST_DIM,l_ni,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
call rpn_comm_xch_halo( F_qt0 , LDIST_DIM,l_ni,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
if (.not. Schm_hydro_L) then
call rpn_comm_xch_halo( F_mut0 ,LDIST_DIM,l_ni,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
endif
if (Cori_cornl_L) then
call rpn_comm_xch_halo( F_ut0 ,LDIST_DIM,l_niu,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
call rpn_comm_xch_halo( F_vt0 ,LDIST_DIM,l_ni,l_njv,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
endif
*
gamma = one
if (.not. Schm_hydro_L) then
eps = Schm_nonhy_8 * Dcst_rgasd_8 * Cstv_tstr_8
% /( Dcst_cappa_8 * Dcst_grav_8**2 * Cstv_tau_8**2 )
gamma = one/( one + eps )
endif
p1 = Dcst_rayt_8*Dcst_rayt_8
p2 = one / Cstv_tau_8
p3 = one / p1
p4 = Dcst_rgasd_8 / p1
p5 = one / Cstv_tstr_8
p6 = gamma / Cstv_tau_8
p7 = p6 / Dcst_cappa_8
q1 = one / Cstv_tau_8
*
!$omp parallel shared (yexp2) private(xlog, ylog, xlog2, ylog2, wk2,
!$omp$ i0,in,j0,jn,nij,i00,j00,inn,jnn,w1,w2,w3,t1,
!$omp$ t2,t3,t4)
i0=i01
j0=j01
in=in1
jn=jn1
nij = (in - i0 + 1)*(jn - j0 + 1)
!$omp do
do k=1,l_nk
t1 = one/Geomg_z_8(k)
do j= j0, jn
do i= i0, in
ylog(i,j) = one + F_pipt0(i,j,k)*t1
end do
end do
call vlog (ylog, ylog, nij)
do j= j0, jn
do i= i0, in
F_wijk1(i,j,k) = ylog(i,j) - ( geomg_pib(k)* F_st0(i,j))*t1
enddo
enddo
*
if (.not. Schm_hydro_L) then
do j= j0, jn
do i= i0, in
F_wijk2(i,j,k) = F_fipt0(i,j,k) + F_fis(i,j)
enddo
enddo
endif
*
enddo
!$omp enddo
*
************************************************************
* The nonlinear deviation of horizontal momentum equations *
************************************************************
*
!$omp single
call rpn_comm_xch_halo( F_wijk1, LDIST_DIM,l_ni,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
if (.not. Schm_hydro_L) then
call rpn_comm_xch_halo( F_wijk2,LDIST_DIM,l_ni,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
endif
!$omp end single
*
!$omp do
do 100 k=1,l_nk
*
* Compute Nu for hydrostatic version
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
i0 = 1
in = l_niu
j0 = 1+pil_s
jn = l_nj-pil_n
if (G_lam) then
if (l_west) i0=1+pil_w
if (l_east) in=l_niu-pil_e
endif
*
do j= j0, jn
do i= i0, in
w1 = ( 1. - intuv_c0xxu_8(i) ) * F_tpt0(i ,j,k)
% + intuv_c0xxu_8(i) * F_tpt0(i+1,j,k)
w2 = ( F_qt0(i+1,j,k) - F_qt0(i,j,k) ) * Geomg_invhx_8(i)
w3 = ( F_wijk1(i+1,j,k) - F_wijk1(i,j,k) ) * Geomg_invhx_8(i)
F_nu(i,j,k) = p4 * ( w1*w2 + Cstv_tstr_8*w3 )
end do
end do
*
if (Cori_cornl_L) then
* Set indices for calculating wk2
i00 = minx
inn = maxx
j00 = 1+pil_s
jnn = l_njv
if (G_lam) then
if (l_west) i00 = 1+pil_w -2
if (l_east) inn = l_niu-pil_e +3
if (l_north)jnn = l_njv-pil_n +1
else
if (l_south) j00 = 3
if (l_north) jnn = l_njv-1
endif
*
do j = j00, jnn
do i = i00, inn
wk2(i,j) = inuvl_wyvy3_8(j,1) * F_vt0(i,j-2,k)
% + inuvl_wyvy3_8(j,2) * F_vt0(i,j-1,k)
% + inuvl_wyvy3_8(j,3) * F_vt0(i,j ,k)
% + inuvl_wyvy3_8(j,4) * F_vt0(i,j+1,k)
end do
end do
*
if (.not.G_lam) then
if (l_south) then
do i = i00, inn
wk2(i,j00-2)= inuvl_wyvy3_8(j00-2,3)*F_vt0(i,j00-2,k)
% + inuvl_wyvy3_8(j00-2,4)*F_vt0(i,j00-1,k)
wk2(i,j00-1)= inuvl_wyvy3_8(j00-1,2)*F_vt0(i,j00-2,k)
% + inuvl_wyvy3_8(j00-1,3)*F_vt0(i,j00-1,k)
% + inuvl_wyvy3_8(j00-1,4)*F_vt0(i,j00 ,k)
end do
endif
if (l_north) then
do i = i00, inn
wk2(i,jnn+2)= inuvl_wyvy3_8(jnn+2,1)*F_vt0(i,jnn ,k)
% + inuvl_wyvy3_8(jnn+2,2)*F_vt0(i,jnn+1,k)
wk2(i,jnn+1)= inuvl_wyvy3_8(jnn+1,1)*F_vt0(i,jnn-1,k)
% + inuvl_wyvy3_8(jnn+1,2)*F_vt0(i,jnn ,k)
% + inuvl_wyvy3_8(jnn+1,3)*F_vt0(i,jnn+1,k)
end do
endif
endif
*
do j= j0, jn
do i= i0, in
F_nu(i,j,k) = F_nu(i,j,k) - Cori_fcoru_8(i,j) *
% (inuvl_wxxu3_8(i,1)*wk2(i-1,j)+inuvl_wxxu3_8(i,2)*wk2(i ,j)
% + inuvl_wxxu3_8(i,3)*wk2(i+1,j)+inuvl_wxxu3_8(i,4)*wk2(i+2,j))
end do
end do
endif
*
* Compute Nv for hydrostatic version
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
i0 = 1+pil_w
in = l_ni-pil_e
j0 = 1
jn = l_njv
if (G_lam) then
if (l_south) j0=1+pil_s
if (l_north) jn=l_njv-pil_n
endif
do j= j0, jn
t1 = geomg_cyv2_8(j) * Geomg_invhsy_8(j)
do i= i0, in
w1 = ( 1. - intuv_c0yyv_8(j) ) * F_tpt0(i,j ,k)
% + intuv_c0yyv_8(j) * F_tpt0(i,j+1,k)
w2 = (F_qt0 (i,j+1,k) - F_qt0 (i,j,k)) * t1
w3 = (F_wijk1(i,j+1,k) - F_wijk1(i,j,k)) * t1
F_nv(i,j,k) = p4 * ( w1*w2 + Cstv_tstr_8*w3 )
end do
end do
*
if (Cori_cornl_L) then
* Set indices for calculating wk2
j00 = miny
jnn = maxy
i00 = 1+pil_w
inn = l_niu
if (G_lam) then
if (l_south) j00=1+pil_s-2
if (l_north) jnn=l_njv-pil_n+3
if (l_east) inn = l_niu-pil_e +1
endif
*
do j = j00, jnn
do i = i00, inn
wk2(i,j) = inuvl_wxux3_8(i,1)*F_ut0(i-2,j,k)
% + inuvl_wxux3_8(i,2)*F_ut0(i-1,j,k)
% + inuvl_wxux3_8(i,3)*F_ut0(i ,j,k)
% + inuvl_wxux3_8(i,4)*F_ut0(i+1,j,k)
end do
end do
*
* Set indices for calculating Nv
if (.not.G_lam) then
if (l_south) j0 = 2
if (l_north) jn = l_njv-1
endif
do j = j0, jn
do i = i0, in
F_nv(i,j,k) = F_nv(i,j,k) + Cori_fcorv_8(i,j) *
% (inuvl_wyyv3_8(j,1)*wk2(i,j-1)+inuvl_wyyv3_8(j,2)*wk2(i,j )
% + inuvl_wyyv3_8(j,3)*wk2(i,j+1)+inuvl_wyyv3_8(j,4)*wk2(i,j+2))
end do
end do
*
if (.not.G_lam) then
if (l_south) then
do i = i0, in
F_nv(i,1,k) = F_nv(i,1,k) + Cori_fcorv_8(i,1)
% * (inuvl_wyyv3_8(1,2)*wk2(i,1)+inuvl_wyyv3_8(1,3)*wk2(i,2)
% +inuvl_wyyv3_8(1,4)*wk2(i,3))
end do
endif
*
if (l_north) then
do i = i0, in
F_nv(i,l_njv,k)=F_nv(i,l_njv,k)+Cori_fcorv_8(i,l_njv) *
% ( inuvl_wyyv3_8(l_njv,1)*wk2(i,l_njv-1)
% + inuvl_wyyv3_8(l_njv,2)*wk2(i,l_njv )
% + inuvl_wyyv3_8(l_njv,3)*wk2(i,l_njv+1) )
end do
endif
endif
endif
*
if (.not. Schm_hydro_L) then
i0 = 1
in = l_niu
j0 = 1+pil_s
jn = l_nj-pil_n
if (G_lam) then
if (l_west) i0 = 1+pil_w
if (l_east) in = l_niu-pil_e
endif
i00 = 1+pil_w
inn = l_ni-pil_e
j00 = 1
jnn = l_njv
if (G_lam) then
if (l_south) j00 = 1+pil_s
if (l_north) jnn = l_njv-pil_n
endif
*
* Add nonhydrostatic contributions to Nu
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
do j= j0, jn
do i= i0, in
w1 = ( 1. - intuv_c0xxu_8(i) ) * F_mut0(i ,j,k)
% + intuv_c0xxu_8(i) * F_mut0(i+1,j,k)
w2 = ( F_wijk2(i+1,j,k)-F_wijk2 (i,j,k) ) * Geomg_invhx_8(i)
F_nu(i,j,k) = F_nu(i,j,k) + p3*w1*w2
end do
end do
*
* Add nonhydrostatic contributions to Nv
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
do j= j00, jnn
do i= i00, inn
w1 = ( 1. - intuv_c0yyv_8(j) ) * F_mut0(i,j ,k)
% + intuv_c0yyv_8(j) * F_mut0(i,j+1,k)
w2 = (F_wijk2 (i,j+1,k) - F_wijk2(i,j,k) )
% *geomg_cyv2_8(j) * Geomg_invhsy_8(j)
F_nv(i,j,k) = F_nv(i,j,k) + p3*w1*w2
end do
end do
endif
*
if (k.eq.1) then
i0=1
in=l_ni
j0=1
jn=l_nj
if (G_lam) then
if (l_west) i0 = 1+pil_w
if (l_east) in = l_ni-pil_e
if (l_south) j0 = 1+pil_s
if (l_north) jn = l_nj-pil_n
endif
nij = (in - i0 +1)*(jn - j0 +1)
do j = j0, jn
do i = i0, in
yexp2(i,j) = F_st0(i,j)
end do
end do
call vexp ( yexp2, yexp2, nij )
endif
*
100 continue
!$omp enddo
*
* For LAM, set Nu,Nv values on the boundaries of the LAM grid
*
if (G_lam) then
if (l_west) then
!$omp do
do k=1,l_nk
do j=1+pil_s,l_nj-pil_n
F_nu(pil_w,j,k) = 0.
end do
enddo
!$omp enddo
endif
if (l_east) then
!$omp do
do k=1,l_nk
do j=1+pil_s,l_nj-pil_n
F_nu(l_ni-pil_e,j,k) = 0.
end do
enddo
!$omp enddo
endif
if (l_south) then
!$omp do
do k=1,l_nk
do i=1+pil_w,l_ni-pil_e
F_nv(i,pil_s,k) = 0.
end do
enddo
!$omp enddo
endif
if (l_north) then
!$omp do
do k=1,l_nk
do i=1+pil_w,l_ni-pil_e
F_nv(i,l_nj-pil_n,k) = 0.
end do
enddo
!$omp enddo
endif
endif
*
i0=1
in=l_ni
j0=1
jn=l_nj
if (G_lam) then
if (l_west) i0 = 1+pil_w
if (l_east) in = l_ni-pil_e
if (l_south) j0 = 1+pil_s
if (l_north) jn = l_nj-pil_n
endif
nij = (in - i0 +1)*(jn - j0 +1)
*
**************************************
* Combination of governing equations *
**************************************
*
* compute Ncn
* ~~~~~~~~~~~
!$omp do
do k = 1, l_nk
do j = j0, jn
do i = i0, in
ylog2(i,j) = 1. + geomg_dpba(k) * (yexp2(i,j) - 1.0)
end do
end do
call vlog(ylog2, ylog2, nij)
do j = j0, jn
do i = i0, in
w1 = ylog2(i,j)
w2 = geomg_dpib(k) * F_st0(i,j)
F_ncn(i,j,k) = q1 * ( w1 - w2 )
enddo
enddo
enddo
!$omp enddo
*
* Compute the nonlinear deviation of horizontal divergence
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!$omp single
call rpn_comm_xch_halo( F_nu, LDIST_DIM,l_niu,l_nj,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
call rpn_comm_xch_halo( F_nv, LDIST_DIM,l_ni,l_njv,G_nk,
$ G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
!$omp end single
*
!$omp do
do k=1,l_nk
*
if (G_lam) then
do j= j0,jn
do i= i0,in
F_n1(i,j,k) = ( F_nu(i,j,k) - F_nu(i-1,j,k) )
$ /( geomg_cy2_8(j)*geomg_hxu_8(i-1) )
$ + ( F_nv(i,j,k) - F_nv(i,j-1,k) ) * Geomg_invhsyv_8(j-1)
end do
end do
else
call caldiv_2 ( F_n1(minx,miny,k), F_nu(minx,miny,k),
$ F_nv(minx,miny,k), LDIST_DIM, 1 )
endif
*
do j= j0, jn
do i= i0, in
ylog2(i,j) = one+F_tpt0(i,j,k)*p5
end do
end do
call vlog ( ylog2, ylog2, nij )
*
do j= j0, jn
do i= i0, in
t1 = ylog2(i,j) - F_tplt0(i,j,k)*p5
F_nth(i,j,k) = (-Dcst_cappa_8*F_wijk1(i,j,k)+t1)*p2
F_wijk1(i,j,k) = F_n1(i,j,k) - q1 * F_ncn(i,j,k)
F_wijk2(i,j,k) = p7*F_nth(i,j,k)
end do
end do
*
if (.not. Schm_hydro_L) then
do j= j0, jn
do i= i0, in
F_n3 (i,j,k) = ( F_multx(i,j,k) - F_mut0(i,j,k) )*p2
F_n3p(i,j,k) = F_n3(i,j,k) - eps*F_nth(i,j,k)
F_wijk1(i,j,k) = F_wijk1(i,j,k) + p6*F_n3p(i,j,k)
F_wijk2(i,j,k) = F_wijk2(i,j,k) + p7*F_n3 (i,j,k)
end do
end do
endif
*
end do
!$omp enddo
*
***********************************************
* The RHS of the nonlinear Helmholtz equation *
***********************************************
*
*
!$omp do
do 300 k=1,l_nk
*
if ( k .eq. 1 ) then
*
t1 = quarter*Geomg_hz_8(k)
t3 = half*Geomg_z_8(k)
t4 = half*Geomg_z_8(k+1)
do j= j0, jn
do i= i0, in
F_rheln(i,j,k) = p1 * (F_rhell(i,j,k)
$ - t1*( F_wijk1(i,j,k) + F_wijk1(i,j,k+1) )
$ + t3*F_wijk2(i,j,k) + t4*F_wijk2(i,j,k+1))
end do
end do
*
elseif ( k .eq. l_nk ) then
*
t1 = quarter*Geomg_hz_8(k-1)
t3 = half*Geomg_z_8(k-1)
t4 = half*Geomg_z_8(k)
do j= j0, jn
do i= i0, in
F_rheln(i,j,k) = p1 * (F_rhell(i,j,k)
$ - t1*( F_wijk1(i,j,k-1) + F_wijk1(i,j,k) )
$ - t3*F_wijk2(i,j,k-1) - t4*F_wijk2(i,j,k))
end do
end do
*
else
*
t1 = quarter*Geomg_hz_8(k-1)
t2 = quarter*Geomg_hz_8(k)
t3 = half*Geomg_z_8(k-1)
t4 = half*Geomg_z_8(k+1)
do j= j0, jn
do i= i0, in
F_rheln(i,j,k) = p1 * (F_rhell(i,j,k)
$ - t1*( F_wijk1(i,j,k-1) + F_wijk1(i,j,k ) )
$ - t2*( F_wijk1(i,j,k ) + F_wijk1(i,j,k+1) )
$ - t3*F_wijk2(i,j,k-1) + t4*F_wijk2(i,j,k+1))
end do
end do
*
endif
300 continue
!$omp enddo
!$omp end parallel
*
* __________________________________________________________________
*
return
end