!-------------------------------------- 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_exch_1_ad - ADJ of adw_exch_1_tl
*
#include "model_macros_f.h"
*
subroutine adw_exch_1_ad ( F_x_out, F_y_out, F_z_out, 5
% F_x_in, F_y_in, F_z_in ,
% F_c_m_out,
% F_y_m_in )
*
#include "impnone.cdk"
*
real F_x_out ( * ), F_y_out ( * ), F_z_out ( * ),
% F_x_in ( * ), F_y_in ( * ), F_z_in ( * )
*
real F_y_m_in ( * )
*
integer F_c_m_out ( * )
*
*author
* M.Tanguay
*
*revision
* v3_31 - Tanguay M. - initial MPI version
* v3_31 - Tanguay M. - Do adjoint of outsiders in advection
*
*language
* fortran 77
*
*object
* see id section
*
*arguments
*ADJ of
*______________________________________________________________________
* | | |
* NAME | DESCRIPTION | I/O |
*--------------|-------------------------------------------------|-----|
* F_x_out | \ coordinates of upstream | o |
* F_y_out | positions outside advection | o |
* F_z_out | / source grid | o |
* | | |
* F_c_out | 3D coordinates of points for which upstream | o |
* | positions are outside advection source grid | |
* | | |
* F_x_in | \ | i |
* F_y_in | upstream positions | i |
* F_z_in | / | i |
*______________|_________________________________________________|_____|
*
*notes
*______________________________________________________________________
* |
* The positions are stored in the following manner: |
* |
* Adw_for_n values followed by Adw_for_s values = Adw_for_a values |
* --------- --------- --------- |
*______________________________________________________________________|
*
*implicits
#include "glb_ld.cdk"
#include "adw.cdk"
*
************************************************************************
*
integer nwrn,nwrs,status
*
integer n, nijk,i,j,k,npts,ind
*
real*8, parameter :: ZERO_8 = 0.0
*
integer Adw_for_n_K,Adw_for_s_K
integer Adw_for_n_R,Adw_for_s_R
*
nijk = l_ni*l_nj*l_nk
*
Adw_for_n_R = 0
Adw_for_s_R = 0
*
Adw_for_n_K = Adw_for_n
Adw_for_s_K = Adw_for_s
*
************************************************************************
c call RPN_COMM_swapns(1,Adw_for_n,1,Adw_for_s,
c % 1,nwrn,Adw_fro_n,1,nwrs,Adw_fro_s,G_periody,
c % status)
call RPN_COMM_swapns(1,Adw_fro_n,1,Adw_fro_s,
% 1,nwrn,Adw_for_n_R,1,nwrs,Adw_for_s_R,G_periody,
% status)
*
************************************************************************
if (.not. l_south) then
*
do ind = (Adw_for_s_R + Adw_for_n_R),(Adw_for_n_R + 1),-1
*
n = F_c_m_out(ind)
*
Adw_for_s = ind - Adw_for_n_R
Adw_for_n = Adw_for_n_R
*
if ( F_y_m_in(Adw_for_n+Adw_for_s).le.Adw_yy_8(2) ) then
*
F_y_in ( n ) = 0.
*
C F_c_out ( Adw_for_n+Adw_for_s ) = 0
F_z_in (n) = F_z_out ( Adw_for_n+Adw_for_s ) + F_z_in (n)
F_z_out ( Adw_for_n+Adw_for_s ) = ZERO_8
F_y_in (n) = F_y_out ( Adw_for_n+Adw_for_s ) + F_y_in (n)
F_y_out ( Adw_for_n+Adw_for_s ) = ZERO_8
F_x_in (n) = F_x_out ( Adw_for_n+Adw_for_s ) + F_x_in (n)
F_x_out ( Adw_for_n+Adw_for_s ) = ZERO_8
*
endif
enddo
*
endif
************************************************************************
if (.not. l_north) then
*
do ind = Adw_for_n_R,1,-1
*
n = F_c_m_out(ind)
*
Adw_for_n = ind
*
if ( F_y_m_in(Adw_for_n).ge.Adw_yy_8(Adw_njt-1) ) then
*
F_y_in ( n ) = 0.
*
C F_c_out ( Adw_for_n ) = 0
F_z_in (n) = F_z_out ( Adw_for_n ) + F_z_in (n)
F_z_out ( Adw_for_n ) = ZERO_8
F_y_in (n) = F_y_out ( Adw_for_n ) + F_y_in (n)
F_y_out ( Adw_for_n ) = ZERO_8
F_x_in (n) = F_x_out ( Adw_for_n ) + F_x_in (n)
F_x_out ( Adw_for_n ) = ZERO_8
*
endif
enddo
endif
************************************************************************
C Adw_for_a = Adw_for_n + Adw_for_s
C Adw_fro_a = Adw_fro_n + Adw_fro_s
Adw_for_n = Adw_for_n_K
Adw_for_s = Adw_for_s_K
************************************************************************
*
return
end