!-------------------------------------- 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 - Establish list and number of points for * which upstream positions are outside * advection source grid. * * Fill output vectors with coordinates of these * upstream positions in preparation for exchange * with other processors. * * Take note 3D coordinates of points for which * upstream positions are outside advection source * grid. * * Exchange number of points to be exchanged to * allow temporary space allocation. * #include "model_macros_f.h"*
subroutine adw_exch_1 ( F_x_out, F_y_out, F_z_out, F_c_out, 6 % F_x_in, F_y_in, F_z_in ) * #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 ( * ) * *author * alain patoine * *revision * v2_31 - Corbeil L. - replaced MPI calls by rpn_comm * v3_00 - Desgagne & Lee - Lam configuration * *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 "ptopo.cdk"
#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_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_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 ************************************************************************ if ( Adw_exdg_L ) print *,'EXDG',Ptopo_myproc, % Adw_for_n, Adw_for_s, Adw_for_a, % Adw_fro_n, Adw_fro_s, Adw_fro_a * return end