!-------------------------------------- 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_polx - extension of a scalar field beyond the poles
* in view of cubic lagrange interpolation along the
* north-south direction
*
#include "model_macros_f.h"
*
subroutine adw_polx ( F_field, F_xg, F_sud, 18
% F_nic, F_halox, F_njc, F_haloy, F_nk )
*
#include "impnone.cdk"
*
logical F_sud
*
integer F_nic, F_halox, F_njc, F_haloy, F_nk
*
real F_field (-F_halox+1:F_nic+F_halox,
% -F_haloy+1:F_njc+F_haloy, F_nk)
real*8 F_xg (-F_halox+1:F_nic+F_halox)
*
*author
* alain patoine
*
*revision
* v3_21 - Desgagne M. - Revision Openmp
*
*language
* fortran 77
*
*object
* see id section
*
*arguments
*______________________________________________________________________
* | | |
* NAME | DESCRIPTION | I/O |
*--------------|-------------------------------------------------|-----|
* | | |
* F_field | field to treat | io |
* F_xg | x coordinates of global grid | i |
* F_sud | switch: .true.: pole extension is for south pole| i |
* | .false.: pole extension is for north pole| i |
* | | |
* F_nic | number of points in x direction (advection grid)| i |
* F_njc | number of points in y direction (advection grid)| i |
* | | |
* F_halox | size of halo in x direction (advection grid) | i |
* F_haloy | size of halo in y direction (advection grid) | i |
* | | |
* F_nk | number of levels | i |
*______________|_________________________________________________|_____|
*
*implicits
#include "adw.cdk"
*
*modules
* none
************************************************************************
integer m, ns, nd, i, j, k
real e(0:F_nic+49)
*
* Basic statement functions for cubic int. on a non-uniform mesh
*
real triprd, delta, poly
real*8 y, y1, y2, y3, y4
real v1, v2, v3, v4
triprd( y1, y2, y3, y4 ) = ( y1 - y2 ) * ( y1 - y3 ) * ( y1 - y4 )
*
* triprd is fully symmetric in y2, y3, y4.
* and hence delta is symmetric in y2, y3, y4.
*
delta( y, y1, y2, y3, y4 ) = triprd( y, y2, y3, y4 )
% / triprd( y1, y2, y3, y4 )
*
* delta is a cubic in y which asumes the value 1.0 at y = y1,
* and the value 0.0 for y = y2, y3, y4.
* consequently a cubic which takes the values v1, v2, v3, v4 at
* y = y1, y2, y3, y4, is
*
*
poly( v1, v2, v3, v4, y, y1, y2, y3, y4 ) =
% v1 * delta( y, y1, y2, y3, y4 ) +
% v2 * delta( y, y2, y1, y3, y4 ) +
% v3 * delta( y, y3, y1, y2, y4 ) +
% v4 * delta( y, y4, y1, y2, y3 )
*
**
*
ns = F_njc
if ( F_sud ) ns = 1
nd = F_njc+2
if ( F_sud ) nd = -1
m = F_nic + 1
*
!$omp do
do k = 1, F_nk
*
e(0) = F_field(F_nic, ns, k)
e(m) = F_field(1, ns, k)
e(m+1) = F_field(2, ns, k)
*
do i=1,F_nic
e(i) = F_field(i,ns,k)
enddo
*
do i=1,F_nic
j = Adw_iln(i)
F_field(i,nd,k) = poly(e(j-1),e(j),e(j+1),e(j+2),Adw_lnr_8(i),
% F_xg(j-1),F_xg(j),F_xg(j+1),F_xg(j+2))
enddo
*
do i = 1, F_halox
F_field(F_nic+i,nd,k)=F_field(i, nd,k)
F_field(1-i, nd,k)=F_field(F_nic+1-i,nd,k)
enddo
*
enddo
!$omp enddo
*
return
end