!-------------------------------------- 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 vspng_drv_lam_tr - Equivalent to vspng_drv_lam for TRAJECTORY 
*                         (F_pip, F_qp (No Hyd) ONLY)
*
#include "model_macros_f.h"
*

      subroutine vspng_drv_lam_tr (F_pip,F_qp,DIST_DIM,Nk) 1,2
*
#include "impnone.cdk"
*
      integer DIST_DIM, Nk
      real    F_pip(DIST_SHAPE,Nk), F_qp(DIST_SHAPE,Nk)
*
*author
*     M.Tanguay
*
*revision
* v3_03 - Tanguay M.        - Adjoint NoHyd configuration
*
*object
*     see id section 
*
*arguments
* 
*implicits
#include "glb_ld.cdk"
#include "cstv.cdk"
#include "schm.cdk"
#include "geomg.cdk"
#include "vspng.cdk"
*
      integer i, j, k, nkspng
*
      real work(LDIST_SHAPE,Nk)
*     __________________________________________________________________
*
*     Mass related fields
*     ~~~~~~~~~~~~~~~~~~~
         if (Vspng_uvwdt_L) then
            nkspng   = Vspng_nk
            Vspng_nk = 1
         endif
*         
*     Save pi' for the diffusion of q'
*     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
         if ( (.not.Schm_hydro_L) .and. Schm_difqp_L ) then
            do k = 1, Vspng_nk
            do j=1, l_nj
            do i=1, l_ni
               work(i,j,k) = F_pip(i,j,k)
            end do
            end do
            end do
         endif 
*
*     The hydrostatic pressure: pi'  
*     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
         call vspng_lam ( F_pip, LDIST_DIM, l_ni, l_nj)
*
*****************************
*  3. Nonyhydrostatic model * 
*****************************
*
         if ( .not. Schm_hydro_L ) then
*
         if ( Schm_difqp_L ) then ! q' & related variables
*
*        Indirect diffusion of q' 
*        ~~~~~~~~~~~~~~~~~~~~~~~~
         do k=1, Vspng_nk 
         do j=1, l_nj
         do i=1, l_ni
            work(i,j,k) = ( Geomg_z_8(k) + dble(work(i,j,k)) )
     %                       *exp( dble(F_qp(i,j,k)) )
         end do
         end do
         end do
*
         call vspng_lam ( work, LDIST_DIM, l_ni, l_nj)
*
         do k=1, Vspng_nk
            do j=1+pil_s, l_nj-pil_n
            do i=1+pil_w, l_ni-pil_e
            F_qp(i,j,k) = log(             dble(work(i,j,k))
     %                       /( Geomg_z_8(k) + dble(F_pip(i,j,k)) )  )
         end do
         end do
         end do
*
         endif
         endif         
*
         if (Vspng_uvwdt_L) Vspng_nk = nkspng
*
*     __________________________________________________________________
*
      return
      end