!-------------------------------------- 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 v4d_scint0_ad - ADJ of v4d_scint0
*
#include "model_macros_f.h"
*
subroutine v4d_scint0_ad (fldscint,px,py,npts,fldsc,ax,ay,cx,cy,wx_8, 9,5
% i1,i2,j1,j2,nk,grtypi,degree,var)
*
use v4d_interzone
*
implicit none
*
integer npts,i1,i2,j1,j2,nk,degree
*
real, pointer, dimension(:,:) :: fldscint
real, pointer, dimension(:) :: px,py
*
real fldsc(i1:i2,j1:j2,nk),ax(i1:i2),ay(j1:j2),cx(i1:i2,6),cy(j1:j2,6)
*
character*2 var
*
character*1 grtypi
*
real*8 wx_8(*)
*
*author Tanguay M.
*
*revision
* v3_00 - Tanguay M. - initial MPI version
* v3_03 - Tanguay M. - use v4d_zerohalo
* v3_11 - Tanguay M. - correct for nk in v4d_zerohalo
* v3_30 - Fillion/Tanguay - Avoid polar treatment when in LAM mode
*
*object
* see id section
*
*ADJOINT of
*arguments
* Name I/O Description
*----------------------------------------------------------------
* fldscint O Interpolated scalar field at positions px,py
* px I Position x in INPUT grid
* py I Position y in INPUT grid
* npts I Number of positions in fldscint
* fldsc I Scalar field on INPUT grid
* ax I X axe of INPUT grid
* ay I Y axe of INPUT grid
* cx I AX difference on INPUT grid
* cy I AY difference on INPUT grid
* wx I Weights on INPUT grid x axe
* i1-i2 I Dimension x in INPUT grid
* j1-j2 I Dimension y in INPUT grid
* nk I Dimension z in INPUT grid
* grtypi I Type of INPUT grid
* degree I Degree of interpolation
* var I Name of fldsc
*----------------------------------------------------------------
*
*implicits
#include "glb_ld.cdk"
*
integer i,j,k,gni,jmin,jmax,ni
*
real*8, parameter :: ZERO_8 = 0.0
*
* Recall ni = Period if grid='G', Heart if grid='Z'
* -------------------------------------------------
if(grtypi.eq.'Z') ni = l_ni
if(grtypi.eq.'G') ni = i2-i1+1
*
* Recall dimension of a latitude circle in INPUT grid
* ---------------------------------------------------
if(grtypi.eq.'Z') gni = G_ni
if(grtypi.eq.'G') gni = ni
*
* Recall j limit
* --------------
jmin=j1
jmax=j2
if(grtypi.eq.'Z'.and.l_north) jmax=l_nj
if(grtypi.eq.'Z'.and.l_south) jmin=1
*
* Adjoint of
* Closing if scalar interpolation in polar zones
* ----------------------------------------------
if((l_north.or.l_south).and..not.G_lam) call v4d_zonesca_ad (px,py,npts,fldsc,wx_8,i1,i2,j1,j2,
% nk,jmin,jmax,ni,G_lnimax,gni,grtypi,degree,
% var,l_north,l_south,2)
*
* Adjoint of
* Scalar interpolation at px,py positions using EZSCINT
* -----------------------------------------------------
if(npts.ne.0) call v4d_ezscint_ad (fldscint,px,py,npts,fldsc,ax,ay,cx,cy,
% i1,i2,j1,j2,nk,jmin,jmax,ni,grtypi,degree)
*
* Adjoint of
* Preparation for polar correction if scalar interpolation
* --------------------------------------------------------
if((l_north.or.l_south).and..not.G_lam) call v4d_zonesca_ad (px,py,npts,fldsc,wx_8,i1,i2,j1,j2,
% nk,jmin,jmax,ni,G_lnimax,gni,grtypi,degree,
% var,l_north,l_south,1)
*
* Adjoint of
* Fill halo for interpolation between processors if INPUT grid='Z"
* ----------------------------------------------------------------
if(grtypi.eq.'Z') then
*
call rpn_comm_adj_halo( fldsc, LDIST_DIM,l_ni,l_nj,nk,
% G_halox,G_haloy,G_periodx,G_periody,l_ni,0)
*
* Zero fldsc halo
* ---------------
call v4d_zerohalo ( fldsc,l_ni,l_nj,LDIST_DIM,nk)
*
endif
*
return
end