!-------------------------------------- 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 --------------------------------------
!

      subroutine lvtap 1,1
#if defined (DOC)
*
*S/P LVTAP:
*         CALCULE Y A PARTIR DE R PAR SOLUTION DE L'EQUATION R*CON=S**E*D(Y)
*         AVEC UN SCHEME DU 4EME ORDRE DU A J. COTE.
*         NOTE: CET ALGORITHME EST EXACTEMENT REVERSIBLE (VOIR VPAT).
*
*         ON DOIT FOURNIR LA COND
*         A LA LIMITE INF. Y(N). LA MATRICE MATAP A ETE CALCULEE DANS LA
*         SUBR. MATAPAT.
*
*
* AUTHOR: MICHEL BELAND - AVRIL 1984 - ADAPTE AU MODELE SEF, AVRIL 1984.
*
* REVISION: LUC FILLION - AUG 94 - MODIFIED FOR VARIATIONAL ANALYSIS.
*           S. Pellerin - Sept 98 - Use of gomt1 for virtual
*                                   temperatures
*                                 - GZ(nflev) = 0 (tangent linear
*                                   version of vtap).
*                                 - Introduction of surface pressure
*                                   dependant factor (rtapfac) for eta
*                                   coordinates
*                                 - Introduction of site constants
*                                   common (comphy)
*          C. Charette *ARMA/AES November 1998
*                      - Added LLPRINT for diagnostics
*          L. Fillion *ARMA/AES - 3 Feb 1999
*                      - remove rtapfac
*           C. Charette ARMA/SMC FEV. 2002
*            - Commented out the if(llprint...) statements within
*              the do loops. They were preventing vectorization.
*           Bin He  *ARMA      - June 25,2005
*            -  OpenMP parallelization.
*           Bin He  *ARMA*   - July, 2011 *
*            - 4Dvar Optimization .  
*
*
*
#endif
      USE modfgat,only : istepobs,nobs,notag  

      IMPLICIT NONE
      INTEGER  KILG, KLEV
      REAL*8     PCON
*
      LOGICAL  LLPRINT
      INTEGER  JLON, IKLEVM2, JK, IK, jobs,iobs
      REAL*8     ZAK0, ZBK0, ZCK0
      REAL*8     ZAK, ZBK, ZCK, ZCON
      INTEGER myid,numthd
      INTEGER OMP_GET_THREAD_NUM,OMP_GET_NUM_THREADS
*implicits
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comode.cdk"
#include "commvo.cdk"
#include "commvo1.cdk"
#include "comphy.cdk"
*modules
*
**
      IF(nobs(istepobs) == 0) RETURN
c
c gomt1 : working vector of virtual temperatures.
c
      LLPRINT = .FALSE.
      ZCON = -RGASD
      ZAK0  = -2.0*ZCON*VMA(nflev)
      ZBK0  = -2.0*ZCON*VMB(nflev)
      ZCK0  = -2.0*ZCON*VMC(nflev)
!$OMP PARALLEL PRIVATE(jobs,iobs,jk,IKLEVM2,myid,numthd)
!$OMP+ PRIVATE(zak,zbk,zck)
      myid=omp_get_thread_num()+1
      numthd=omp_get_num_threads()
      do iobs = myid, nobs(istepobs),numthd
         jobs=notag(iobs,istepobs) 
        gomgz(nflev,jobs) = 0.0
        gomgz(nflev-1,jobs)=ZAK0*gomt1(nflev-1,jobs)+
     $                      ZBK0*gomt1(nflev,jobs)+
     &                      ZCK0*gomt1(nflev-2,jobs)+
     $                      gomgz(nflev,jobs)
********************************************************
c       if (LLPRINT .and. jobs.eq.1) then
c       print *,'lvtap:nflev,jobs,zak,zbk,zck,gomgz(nflev,) ',
c     &       nflev,jobs,zak,zbk,zck,gomgz(nflev,jobs)
c       print *,'lvtap:nflev-1,jobs,zak,zbk,zck,gomgz(nflev-1,) ',
c     &       nflev-1,jobs,zak,zbk,zck,gomgz(nflev-1,jobs)
c       endif
********************************************************
*
      IKLEVM2 = nflev-2
      do JK = 1, IKLEVM2
        IK = nflev-1-JK
        ZAK = -2.0*ZCON*VMA(IK+1)
        ZBK = -2.0*ZCON*VMB(IK+1)
        ZCK = -2.0*ZCON*VMC(IK+1)
!        do jobs = 1, nobtot
          gomgz(ik,jobs)= ZAK*gomt1(IK,jobs)+
     $                    ZBK*gomt1(IK+1,jobs)+
     $                    ZCK*gomt1(IK+2,jobs)+
     +                    gomgz(IK+2,jobs)
********************************************************
c       if (LLPRINT .and. jobs.eq.1) then
c          print *,'lvtap:ik,jobs,zak,zbk,zck gomgz(ik,)= ',
c     &       ik,jobs,zak,zbk,zck,gomgz(ik,jobs)
c          print *,'lvtap:ik,jobs,gomt1(ik,),gomt1(ik+1,),gomt1(ik+2,)= '
c     &       ,ik,jobs,gomt1(IK,jobs),gomt1(IK+1,jobs),gomt1(IK+2,jobs)
c          print *,'lvtap:ik,jobs= '
c     &       ,ik,jobs
c       endif
**********************************************************
        enddo
      enddo
!$OMP END PARALLEL
C
      RETURN
      END