!-------------------------------------- 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_uvint0_ad - ADJ of v4d_uvint0
*
#include "model_macros_f.h"
*
subroutine v4d_uvint0_ad (flduint,fldvint,px,py,npts,fldu,fldv,ax,ay,cx,cy, 5,6
% wx_8,cox_8,six_8,siy_8,i1,i2,j1,j2,nk,
% grtypi,degree,var)
*
use v4d_interzone
*
implicit none
*
integer npts,i1,i2,j1,j2,nk,degree
*
real, pointer, dimension(:,:) :: flduint,fldvint
real, pointer, dimension(:) :: px,py
*
real fldu(i1:i2,j1:j2,nk),fldv(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(*),cox_8(*),six_8(*),siy_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
* - Add option for profiles done on U-V grids for winds
* v3_30 - Fillion/Tanguay - Avoid polar treatment when in LAM mode
*
*object
* see id section
*
*ADJOINT of
*arguments
* Name I/O Description
*----------------------------------------------------------------
* fldu-vint O Interpolated wind fields at positions px,py
* px I Position x in INPUT grid
* py I Position y in INPUT grid
* npts I Number of positions
* fldu-v I Wind fields 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
* cox,six,siy I Cosinus or Sinus of INPUT grid axes
* 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 fldu-v
*----------------------------------------------------------------
*
*implicits
#include "glb_ld.cdk"
*
integer i,j,k,gni,jmin,jmax,ni,nie,nje
*
real*8, parameter :: ZERO_8 = 0.0
*
character*1 grtypi_x
*
* Use grtypi_x ='Z' for interpolation when grtypi.ne.'G'
* ------------------------------------------------------
grtypi_x = grtypi
if(grtypi.eq.'U'.or.grtypi.eq.'V') grtypi_x = 'Z'
*
* Recall ni = Period if grid='G', Heart if grid.ne.'G'
* ---------------------------------------------------
if(grtypi.ne.'G') ni = l_ni
if(grtypi.eq.'U') ni = l_niu
if(grtypi.eq.'G') ni = i2-i1+1
*
* Recall dimension of a latitude circle in INPUT grid
* ---------------------------------------------------
if(grtypi.ne.'G') gni = G_ni
if(grtypi.eq.'U') gni = G_niu
if(grtypi.eq.'G') gni = ni
*
* Recall j limit
* --------------
jmin=j1
jmax=j2
if(grtypi.ne.'G'.and.l_north) jmax=l_nj
if(grtypi.ne.'G'.and.l_south) jmin=1
if(grtypi.eq.'V'.and.l_north) jmax=l_njv
*
* Adjoint of
* Closing if wind interpolation in polar zones
* --------------------------------------------
if((l_north.or.l_south).and..not.G_lam) call v4d_zonewnd_ad (px,py,npts,fldu,fldv,wx_8,cox_8,six_8,siy_8,
% i1,i2,j1,j2,nk,jmin,jmax,ni,G_lnimax,gni,grtypi_x,
% degree,var,l_north,l_south,2)
*
* Adjoint of
* Wind interpolation at px,py positions using EZSCINT
* ---------------------------------------------------
if(npts.ne.0) call v4d_ezuvint_ad (flduint,fldvint,px,py,npts,fldu,fldv,ax,ay,cx,cy,
% i1,i2,j1,j2,nk,jmin,jmax,ni,grtypi_x,degree)
*
* Adjoint of
* Preparation for polar correction if wind interpolation
* ------------------------------------------------------
if((l_north.or.l_south).and..not.G_lam) call v4d_zonewnd_ad (px,py,npts,fldu,fldv,wx_8,cox_8,six_8,siy_8,
% i1,i2,j1,j2,nk,jmin,jmax,ni,G_lnimax,gni,grtypi_x,
% degree,var,l_north,l_south,1)
*
* Adjoint of
* Fill halo for interpolation between processors if INPUT grid.ne.'G'
* -------------------------------------------------------------------
if(grtypi.ne.'G') then
*
nie = l_ni
nje = l_nj
if(grtypi.eq.'U') nie = l_niu
if(grtypi.eq.'V') nje = l_njv
*
call rpn_comm_adj_halo( fldv, LDIST_DIM,nie,nje,nk,
% G_halox,G_haloy,G_periodx,G_periody,l_ni,0)
call rpn_comm_adj_halo( fldu, LDIST_DIM,nie,nje,nk,
% G_halox,G_haloy,G_periodx,G_periody,l_ni,0)
*
* Zero fldv,fldu halo
* -------------------
call v4d_zerohalo ( fldv,nie,nje,LDIST_DIM,nk)
call v4d_zerohalo ( fldu,nie,nje,LDIST_DIM,nk)
*
endif
*
return
end