!-------------------------------------- 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_polw_ad - ADJ of adw_polw
*
subroutine adw_polw_ad (F_u, F_v, F_cx_8, F_sx_8, F_wx_8, F_sy_8, F_j, 4
% F_nic, F_halox, F_njc, F_haloy, F_nk )
*
#include "impnone.cdk"
*
integer F_j, F_nic, F_halox, F_njc, F_haloy, F_nk
*
real F_u (-F_halox+1:F_nic+F_halox,-F_haloy+1:F_njc+F_haloy,F_nk),
% F_v (-F_halox+1:F_nic+F_halox,-F_haloy+1:F_njc+F_haloy,F_nk)
*
real*8 F_cx_8 (F_nic), F_sx_8 (F_nic), F_wx_8 (F_nic), F_sy_8 (F_njc)
*
*author
* monique tanguay
*
*revision
* v2_31 - Tanguay M. - initial MPI version
* v3_21 - Tanguay M. - Revision Openmp
*
*language
* fortran 77
*
*object
* see id section
*
*ADJ of
*arguments
*______________________________________________________________________
* | | |
* NAME | DESCRIPTION | I/O |
*--------------|-------------------------------------------------|-----|
* | | |
* F_u | \ components of the wind to treat | io |
* F_v | / | io |
* | | |
* F_cx_8 | cos of longitudes | i |
* F_sx_8 | sin of longitudes | i |
* F_wx_8 | weights (proportional to x grid distances) | i |
* F_sy_8 | sin of latitudes | i |
* F_j | j position to fill | 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
* none
*
*modules
* none
************************************************************************
integer i,j,k
*
real*8 vx_8, vy_8, coef1_8, coef2_8
*
real*8 ZERO_8
parameter (ZERO_8 = 0.0)
*
* Zero adjoint variables
* ----------------------
vx_8 = ZERO_8
vy_8 = ZERO_8
*
* TRAJECTORY
* ----------
if ( F_j .eq. 0 ) then
j = 1
coef1_8 = -1.0
coef2_8 = 1.0
else
j = F_njc
coef1_8 = 1.0
coef2_8 = -1.0
endif
*
* ADJ
* ---
!$omp do
do k = 1,F_nk
*
do i = F_halox,1,-1
F_v(F_nic+1-i,F_j,k) = F_v(1-i, F_j,k) + F_v(F_nic+1-i,F_j,k)
F_v(1-i, F_j,k) = ZERO_8
F_u(F_nic+1-i,F_j,k) = F_u(1-i, F_j,k) + F_u(F_nic+1-i,F_j,k)
F_u(1-i, F_j,k) = ZERO_8
F_v(i, F_j,k) = F_v(F_nic+i,F_j,k) + F_v(i, F_j,k)
F_v(F_nic+i, F_j,k) = ZERO_8
F_u(i, F_j,k) = F_u(F_nic+i,F_j,k) + F_u(i, F_j,k)
F_u(F_nic+i, F_j,k) = ZERO_8
enddo
*
do i=F_nic,1,-1
vx_8 = coef1_8 * dble(F_v(i,F_j,k)) * F_cx_8(i) + vx_8
vy_8 = coef2_8 * dble(F_v(i,F_j,k)) * F_sx_8(i) + vy_8
F_v(i,F_j,k)= ZERO_8
vx_8 = dble(F_u(i,F_j,k)) * F_sx_8(i) + vx_8
vy_8 = dble(F_u(i,F_j,k)) * F_cx_8(i) + vy_8
F_u(i,F_j,k)= ZERO_8
enddo
*
do i=F_nic,1,-1
F_u(i,j,k) = F_wx_8(i) * ( F_cx_8(i) * vy_8 ) + F_u(i,j,k)
F_v(i,j,k) = F_wx_8(i) * ( - F_sx_8(i) * F_sy_8(j) * vy_8 ) + F_v(i,j,k)
F_u(i,j,k) = F_wx_8(i) * ( F_sx_8(i) * vx_8 ) + F_u(i,j,k)
F_v(i,j,k) = F_wx_8(i) * ( F_cx_8(i) * F_sy_8(j) * vx_8 ) + F_v(i,j,k)
enddo
*
vx_8 = ZERO_8
vy_8 = ZERO_8
*
enddo
!$omp enddo
*
return
end