!-------------------------------------- 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 propsv 1,13
      use mod4dv, only : l4dvar
#if defined (DOC)
*
***s/r propsv  - Propagate SVs using the TLM of GEM
*
*Author  : M. Buehner June, 2002
*Revision:
*
*    -------------------
*    Purpose:  Propagate the initial-time SVs over an arbitrary period using the TLM
*              of GEM.  Mostly for partially evolving SVs for use in B matrix
*     .
*
*Arguments
*    -NONE-
#endif
c
      IMPLICIT NONE
*implicits
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comcva.cdk"
#include "comgem.cdk"
#include "comgd0.cdk"
#include "comsv.cdk"
C
      REAL*8 ZTOL,ZNORM0,ZNORMF,ZFACT,GASDEV
      REAL*8 ZENERGY0,ZENERGYF,ZENERGYF2,MAXU,MAXT
c
      INTEGER JJ,RR,ILEN,J,KDIM,JK,JLON,JLAT,I
      INTEGER JM,JLEV,ILA,JN,ISTAMP,IERR,KULFILE
      INTEGER KULFILE2,IRESLUN
C
      INTEGER FNOM,FCLOS,II,FSTOUV,FSTFRM
      EXTERNAL FNOM,FCLOS,FSTOUV,FSTFRM
      EXTERNAL ABORT3D
c
      call printrev("SUBROUTINE propsv :",19)

      write(NULOUT,*) '********************************'
      write(NULOUT,*) '***PROPAGATE SINGULAR VECTORS***'
      write(NULOUT,*) '********************************'
c
c allocate space and read in initial SVs
c
      ILEN = NI*NJ*NKGDIM*NSV
      CALL HPALLOC(PTSVGD   ,MAX(ILEN,1),IERR,8)
      CALL READSV('SV_TL_T0')
c
c open file for output
c
      KULFILE=0
      IERR =  FNOM(KULFILE,'propsv.fst','RND',0)
      IF(IERR.GE.0)THEN
        IERR =  FSTOUV(KULFILE,'RND')
      ELSE
        CALL ABORT3D(NULOUT,'propsv.fst:PROBLEM WITH FILE')
      END IF
c
c loop over SVs, output initial and propagated SVs
c
      DO RR=1,NSV
c
        DO II=1,NI
          DO JK=1,NKGDIM
            DO JJ=1,NJ
              GD(II,JK,JJ)=SVGD(II,JK,JJ,RR)
            ENDDO
          ENDDO
        ENDDO
c
c scale initial SV (max temp=1C and max wind=10m/s)
c
        maxu=0.0d0
        maxt=0.0d0
        DO II=1,NI
          DO JK=1,NFLEV
            DO JJ=1,NJ
              UT0(II,JK,JJ)= UT0(II,JK,JJ)*conphy(JJ)
              VT0(II,JK,JJ)= VT0(II,JK,JJ)*conphy(JJ)
            ENDDO
          ENDDO
        ENDDO
        DO II=1,NI
          DO JK=1,NFLEV
            DO JJ=1,NJ
              maxt=max(abs(TT0(II,JK,JJ)),maxt)
              maxu=max(max(abs(UT0(II,JK,JJ)),
     +                     abs(VT0(II,JK,JJ)) ),maxu)
            ENDDO
          ENDDO
        ENDDO
        write(nulout,*) 'Max UV,T=',maxu,maxt
        maxt=max(maxt,maxu)
        DO II=1,NI
          DO JK=1,NKGDIM
            DO JJ=1,NJ
c              GD(II,JK,JJ)=10.0*GD(II,JK,JJ)/maxt
              GD(II,JK,JJ)=GD(II,JK,JJ)/maxt
            ENDDO
          ENDDO
        ENDDO
        DO II=1,NI
          DO JK=1,NFLEV
            DO JJ=1,NJ
              UT0(II,JK,JJ)= UT0(II,JK,JJ)/conphy(JJ)
              VT0(II,JK,JJ)= VT0(II,JK,JJ)/conphy(JJ)
            ENDDO
          ENDDO
        ENDDO
c
        call calcenergy(zenergy0)
        call postproc(kulfile,RR,'GRID','SV_T0   ')
c
        nsim3d = nsim3d + 1
        write(nulout,*) 'CALLING NLM:',nsim3d
        call vflush(nulout)
        call putdx2('N')
        call getdx('F')
c
        call postproc(kulfile,RR,'GRID','SV_PROP ')
        call calcenergy(zenergyf)
        write(nulout,*)'TEST of TLM, energy:',zenergy0,zenergyf,zenergyf/zenergy0
c
      ENDDO
c
      IERR =  FSTFRM(KULFILE)
      IERR =  FCLOS(KULFILE)
      if(l4dvar) call endsim
      CALL ABORT3D(nulout,'DONE PROPAGATING SVs')
c
      END