!-------------------------------------- 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_vder - compute second derivatives in the vertical in
* preparation for tri-cubic interpolation
*
#include "model_macros_f.h"
*
subroutine adw_vder (F_inzz, F_in, F_nit, F_njt, F_nk) 5,2
*
#include "impnone.cdk"
*
integer F_nit, F_njt, F_nk
*
real F_inzz (F_nit, F_njt, F_nk), F_in (F_nit, F_njt, F_nk)
*
*author
* alain patoine
*
*revision
* v3_00 - Desgagne & Lee - Lam configuration
* v3_01 - Lee V - calls to opinv7,optriss7 instead of
* v3_01 opinv6,optriss6 to correct bug
* v3_10 - Corbeil & Desgagne & Lee - AIXport+Opti+OpenMP
*
*object
* see id section
*
*arguments
*______________________________________________________________________
* | | |
* NAME | DESCRIPTION | I/O |
*--------------|-------------------------------------------------|-----|
* | | |
* F_inzz | second derivative along z of F_in | o |
* F_in | field to be differentiated | i |
* | | |
* F_nit | \ total number of points in x,y direction in | i |
* F_njt | / advection grid (including halos) | i |
* | | |
* F_nk | number of levels | i |
*______________|_________________________________________________|_____|
*
*implicits
#include "glb_ld.cdk"
#include "adw.cdk"
#include "geomg.cdk"
#include "schm.cdk"
************************************************************************
*
integer i, j, i_deb, j_deb, i_fin, j_fin
*
real prd, pr1, pr2, pr1p, pr2p
************************************************************************
i_deb = 1
if ( l_west .and. G_lam) i_deb = Adw_halox-1 +2
j_deb = 1
if ( l_south ) j_deb = Adw_haloy-1
if ( l_south.and. G_lam) j_deb = Adw_haloy-1 +2
*
i_fin = Adw_nit
if ( l_east .and. G_lam) i_fin = Adw_halox + Adw_nic -2
j_fin = Adw_njt
if ( l_north ) j_fin = Adw_haloy + Adw_njc + 2
if ( l_north .and.G_lam) j_fin = Adw_haloy + Adw_njc - 2
*
************************************************************************
call optriss7 (F_inzz,F_in, i_deb,j_deb,i_fin,j_fin,l_nk,
% 'Z', Adw_qzz_8, Adw_qzz_8(G_nk+1),
% Adw_qzz_8(2*G_nk+1), .false.,
% Adw_nit, Adw_njt, l_nk, 1 )
*
call opinv7 (F_inzz, i_deb, j_deb,i_fin, j_fin,l_nk, 'Z', prd, prd,
% prd, Adw_qzi_8, Adw_qzi_8(G_nk+1),
% Adw_qzi_8(2*G_nk+1), Adw_qzi_8(3*G_nk+1), .false.,
% 'D', Adw_nit, Adw_njt, l_nk, 1 )
*
if ( Adw_nkbz_L ) then
if ( l_nk.eq.3 ) then
pr1 = 0.0
pr2 = 0.0
else
pr1= (Geomg_z_8(2)-Geomg_z_8(1))/(Geomg_z_8(3)-Geomg_z_8(2))
pr2= (Geomg_z_8(l_nk )-Geomg_z_8(l_nk-1)) /
% (Geomg_z_8(l_nk-1)-Geomg_z_8(l_nk-2))
endif
pr1p = pr1 + 1.0
pr2p = pr2 + 1.0
pr1 = - pr1
pr2 = - pr2
!$omp parallel do
do j=j_deb,j_fin
do i=i_deb,i_fin
F_inzz(i,j,1 ) = pr1p*F_inzz(i,j,2)
% + pr1 *F_inzz(i,j,3)
F_inzz(i,j,l_nk) = pr2p*F_inzz(i,j,l_nk-1)
% + pr2 *F_inzz(i,j,l_nk-2)
enddo
enddo
!$omp end parallel do
endif
*
return
end