!-------------------------------------- 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 pre_tr - Equivalent to pre for TRAJECTORY * #include "model_macros_f.h"*
subroutine pre_tr 1,1 * implicit none * *author * M.Tanguay * *revision * v2_10 - Tanguay M. - initial MPI version * v2_21 - Tanguay M. - reduce standard output as in model * v2_31 - Tanguay M. - adapt ADJ for new advection code * v3_03 - Tanguay M. - Adjoint NoHyd configuration * v3_11 - Tanguay M. - AIXport+Opti+OpenMP for TLM-ADJ * *object * see id section * *arguments * none * *implicits #include "glb_ld.cdk"
#include "lun.cdk"
#include "rhscm.cdk"
#include "vt1m.cdk"
#include "p_geof.cdk"
#include "schm.cdk"
* *modules integer vmmlod, vmmget, vmmuld external vmmlod, vmmget, vmmuld * integer pnerr, pnlod, pnlkey1(19), i, j * real wijk1 (LDIST_SHAPE,l_nk),wijk2 (LDIST_SHAPE,l_nk) * ______________________________________________________ * * if (Lun_debug_L) write (Lun_out,1000) * pnlkey1(1) = VMM_KEY(rum) pnlkey1(2) = VMM_KEY(rvm) pnlkey1(3) = VMM_KEY(ruw1m) pnlkey1(4) = VMM_KEY(ruw2m) pnlkey1(5) = VMM_KEY(rvw1m) pnlkey1(6) = VMM_KEY(rvw2m) pnlkey1(7) = VMM_KEY(xct1m) pnlkey1(8) = VMM_KEY(yct1m) pnlkey1(9) = VMM_KEY(zct1m) pnlkey1(10) = VMM_KEY(topo) pnlkey1(11) = VMM_KEY(rdm) pnlkey1(12) = VMM_KEY(rcnm) pnlkey1(13) = VMM_KEY(r1m) pnlkey1(14) = VMM_KEY(rthm) pnlkey1(15) = VMM_KEY(rhellm) pnlod = 15 if (.not. Schm_hydro_L) then pnlkey1(16) = VMM_KEY(rwm) pnlkey1(17) = VMM_KEY(rvvm) pnlkey1(18) = VMM_KEY(r3m) pnlkey1(19) = VMM_KEY(r3pm) pnlod = 19 endif * - - - - - - - - - - - - - - - pnerr = vmmlod(pnlkey1,pnlod) * - - - - - - - - - - - - - - - pnerr = VMM_GET_VAR(rum) pnerr = VMM_GET_VAR(rvm) pnerr = VMM_GET_VAR(ruw1m) pnerr = VMM_GET_VAR(ruw2m) pnerr = VMM_GET_VAR(rvw1m) pnerr = VMM_GET_VAR(rvw2m) pnerr = VMM_GET_VAR(xct1m) pnerr = VMM_GET_VAR(yct1m) pnerr = VMM_GET_VAR(zct1m) pnerr = VMM_GET_VAR(topo) pnerr = VMM_GET_VAR(rdm) pnerr = VMM_GET_VAR(rcnm) pnerr = VMM_GET_VAR(r1m) pnerr = VMM_GET_VAR(rthm) pnerr = VMM_GET_VAR(rhellm) if (.not. Schm_hydro_L) then pnerr = VMM_GET_VAR(rwm) pnerr = VMM_GET_VAR(rvvm) pnerr = VMM_GET_VAR(r3m) pnerr = VMM_GET_VAR(r3pm) else rwm_ = 0 rvvm_ = 0 r3m_ = 0 r3pm_ = 0 endif * call prep_2
( rum, rvm, ruw1m, ruw2m, rvw1m, rvw2m, xct1m, yct1m, zct1m, topo, % rdm, rcnm, r1m, rthm, rwm, rvvm, r3m, r3pm, rhellm, % wijk1,wijk2,LDIST_DIM,l_ni,l_nj,l_nk ) * pnerr = vmmuld(-1,0) * 1000 format(3X,'TRAJ of PRE-COMPUTATION FOR THE HELMHOLTZ PROBLEM: (S/R PRE_TR)',/) return end