!-------------------------------------- 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_tr - Equivalent to adw_exch_1 for TRAJECTORY * #include "model_macros_f.h"*
subroutine adw_exch_1_tr ( F_x_out, F_y_out, F_z_out, F_c_out, 6 % F_x_in, F_y_in, F_z_in, F_y_K) * #include "impnone.cdk"
* integer F_c_out( * ) * real F_x_out ( * ), F_y_out ( * ), F_z_out ( * ), % F_x_in ( * ), F_y_in ( * ), F_z_in ( * ) * real F_y_K ( * ) * *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 *______________________________________________________________________ * | | | * 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 "geomg.cdk"
#include "adw.cdk"
************************************************************************ * integer nwrn,nwrs,status * integer n, nijk,i,j,k,npts * ************************************************************************ * nijk = l_ni*l_nj*l_nk * Adw_for_n = 0 Adw_for_s = 0 Adw_fro_n = 0 Adw_fro_s = 0 * ************************************************************************ if (.not. l_north) then * do n = 1, nijk * if ( F_y_in(n).ge.Adw_yy_8(Adw_njt-1) ) then * Adw_for_n = Adw_for_n + 1 * F_x_out ( Adw_for_n ) = F_x_in (n) F_y_out ( Adw_for_n ) = F_y_in (n) F_z_out ( Adw_for_n ) = F_z_in (n) F_c_out ( Adw_for_n ) = n * F_y_K ( Adw_for_n ) = F_y_in (n) * F_y_in ( n ) = Geomg_y_8(1) endif enddo endif ************************************************************************ if (.not. l_south) then * do n = 1, nijk * if ( F_y_in(n).le.Adw_yy_8(2) ) then * Adw_for_s = Adw_for_s + 1 * F_x_out ( Adw_for_n+Adw_for_s ) = F_x_in (n) F_y_out ( Adw_for_n+Adw_for_s ) = F_y_in (n) F_z_out ( Adw_for_n+Adw_for_s ) = F_z_in (n) F_c_out ( Adw_for_n+Adw_for_s ) = n * F_y_K ( Adw_for_n+Adw_for_s ) = F_y_in (n) * F_y_in ( n ) = Geomg_y_8(1) endif enddo endif call RPN_COMM_swapns(1,Adw_for_n,1,Adw_for_s, % 1,nwrn,Adw_fro_n,1,nwrs,Adw_fro_s,G_periody, % status) * ************************************************************************ Adw_for_a = Adw_for_n + Adw_for_s Adw_fro_a = Adw_fro_n + Adw_fro_s ************************************************************************ * return end