!-------------------------------------- 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_3_tl - TLM of adw_exch_3 * #include "model_macros_f.h"*
subroutine adw_exch_3_tl ( F_1_out, F_2_out, 5 % F_1_in, F_2_in, F_c_in, % F_1_m_out, F_2_m_out, % F_1_m_in, F_2_m_in, F_c_m_in, % F_n_treat ) * #include "impnone.cdk"
* integer F_n_treat, F_c_in (*) * real F_1_out (*), F_2_out (*), % F_1_in (*), F_2_in (*) * integer F_c_m_in (*) * real F_1_m_out (*), F_2_m_out (*), % F_1_m_in (*), F_2_m_in (*) * *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_1_out | \ interpolated fields for which some values | io | * F_2_out | / obtained from neighbors have to be fetched | io | * | back in the appropriate positions | | * | | | * F_1_in | \ interpolated values obtained from neighbors | i | * F_2_in | / | i | * | | | * F_c_in | 3D coordinates of points for which upstream | i | * | positions were outside advection source grid and| | * | interpolated values were obtained from neighbors| i | * | | | * F_n_treat | number of vectors to treat | i | *______________|_________________________________________________|_____| * *implicits #include "adw.cdk"
*********************************************************************** integer n * *********************************************************************** * if ( F_n_treat .eq. 1 ) then * * TRAJECTORY * ---------- do n = 1, Adw_for_a F_1_m_out(F_c_m_in(n)) = F_1_m_in(n) enddo * * TLM * --- do n = 1, Adw_for_a F_1_out(F_c_m_in(n)) = F_1_in(n) enddo * elseif ( F_n_treat .eq. 2 ) then * * TRAJECTORY * ---------- do n = 1, Adw_for_a F_1_m_out(F_c_m_in(n)) = F_1_m_in(n) F_2_m_out(F_c_m_in(n)) = F_2_m_in(n) enddo * * TLM * --- do n = 1, Adw_for_a F_1_out(F_c_m_in(n)) = F_1_in(n) F_2_out(F_c_m_in(n)) = F_2_in(n) enddo * endif * return end