!-------------------------------------- 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 frstgss_tr - Equivalent to frstgss for TRAJECTORY * #include "model_macros_f.h"*
subroutine frstgss_tr () 2 * #include "impnone.cdk"
* *author * M.Tanguay * *revision * v2_10 - Tanguay M. - initial MPI version * v2_30 - Edouard S. - replace Schm_elast_L by Schm_cptop_L * v2_31 - Tanguay M. - adapt for vertical hybrid coordinate * v3_03 - Tanguay M. - Adjoint NoHyd configuration * v3_21 - Tanguay M. - Revision Openmp * *object * see id section * *arguments * none * *implicits #include "glb_ld.cdk"
#include "lun.cdk"
#include "schm.cdk"
#include "cori.cdk"
#include "vt0m.cdk"
#include "vt1m.cdk"
* *modules integer vmmlod,vmmget,vmmuld external vmmlod,vmmget,vmmuld * integer pnerr, pnlkey1(12),pnlod integer i, j, k * ______________________________________________________ * if (Lun_debug_L) write (Lun_out,1000) * pnlkey1(1) = VMM_KEY(qt0m) pnlkey1(2) = VMM_KEY(tpt0m) pnlkey1(3) = VMM_KEY(pipt0m) pnlkey1(4) = VMM_KEY(tplt0m) pnlkey1(5) = VMM_KEY(st0m) pnlkey1(6) = VMM_KEY(qt1m) pnlkey1(7) = VMM_KEY(tpt1m) pnlkey1(8) = VMM_KEY(pipt1m) pnlkey1(9) = VMM_KEY(tplt1m) pnlkey1(10)= VMM_KEY(st1m) * pnlod=10 pnerr = vmmlod(pnlkey1,pnlod) pnerr = VMM_GET_VAR(qt0m) pnerr = VMM_GET_VAR(tpt0m) pnerr = VMM_GET_VAR(pipt0m) pnerr = VMM_GET_VAR(tplt0m) pnerr = VMM_GET_VAR(st0m) pnerr = VMM_GET_VAR(qt1m) pnerr = VMM_GET_VAR(tpt1m) pnerr = VMM_GET_VAR(pipt1m) pnerr = VMM_GET_VAR(tplt1m) pnerr = VMM_GET_VAR(st1m) * !$omp parallel !$omp do do k=1,l_nk do j= 1, l_nj do i= 1, l_ni qt0m(i,j,k) = qt1m(i,j,k) tpt0m(i,j,k) = tpt1m(i,j,k) pipt0m(i,j,k) = pipt1m(i,j,k) tplt0m(i,j,k) = tplt1m(i,j,k) end do end do end do !$omp end do !$omp do do j= 1 , l_nj do i= 1 , l_ni st0m(i,j) = st1m(i,j) end do end do !$omp end do * !$omp end parallel pnerr = vmmuld(-1,0) * pnlod=0 if ( Cori_cornl_L ) then pnlkey1(pnlod+1) = VMM_KEY(ut0m) pnlkey1(pnlod+2) = VMM_KEY(vt0m) pnlkey1(pnlod+3) = VMM_KEY(ut1m) pnlkey1(pnlod+4) = VMM_KEY(vt1m) pnlod= pnlod+4 endif if ( .not. Schm_cptop_L .or. .not. Schm_hydro_L) then pnlkey1(pnlod+1) = VMM_KEY(fipt0m) pnlkey1(pnlod+2) = VMM_KEY(fipt1m) pnlod = pnlod+2 endif if ( .not. Schm_hydro_L ) then pnlkey1(pnlod+1) = VMM_KEY(mut0m) pnlkey1(pnlod+2) = VMM_KEY(mut1m) pnlod = pnlod+2 endif pnerr = vmmlod(pnlkey1,pnlod) if ( Cori_cornl_L ) then pnerr = VMM_GET_VAR(ut0m) pnerr = VMM_GET_VAR(ut1m) pnerr = VMM_GET_VAR(vt0m) pnerr = VMM_GET_VAR(vt1m) !$omp parallel do do k=1,l_nk do j= 1 , l_nj do i= 1 , l_ni ut0m(i,j,k) = ut1m(i,j,k) vt0m(i,j,k) = vt1m(i,j,k) end do end do end do !$omp end parallel do endif * if ( .not. Schm_cptop_L .or. .not. Schm_hydro_L) then pnerr = VMM_GET_VAR(fipt0m) pnerr = VMM_GET_VAR(fipt1m) !$omp parallel do do k=1,l_nk do j= 1 , l_nj do i= 1 , l_ni fipt0m(i,j,k) = fipt1m(i,j,k) end do end do end do !$omp end parallel do endif * if ( .not. Schm_hydro_L ) then pnerr = VMM_GET_VAR(mut0m) pnerr = VMM_GET_VAR(mut1m) !$omp parallel do do k=1,l_nk do j= 1 , l_nj do i= 1 , l_ni mut0m(i,j,k) = mut1m(i,j,k) end do end do end do !$omp end parallel do endif * pnerr = vmmuld(-1,0) 1000 format(3X,'TRAJ of FIRST GUESS: (S/R FRSTGSS_TR)') return end