!-------------------------------------- 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 susv 1,161
      use mod4dv, only : l4dvar
#if defined (DOC)
*
***s/r susv  - Calculate singular vectors (BGSV, HSV, or TESV)
*
*Author  : M. Buehner June, 2002
*Revision:
*
*    -------------------
*    Purpose:  Main controlling subroutine for calculating SVs and also a couple other
*              tests and tasks related to SVs (invoked with logical variable near beginning)
*     .
*
*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 "comanl.cdk"
#include "comsv.cdk"
#include "comstate.cdk"
#include "comvfiles.cdk"
#include "comrand.cdk"
C
      CHARACTER*1 :: CLNUMS(9) = (/"1","2","3","4","5","6","7","8","9"/)
      REAL*8 ZTOL,ZNORM0,ZNORMF,ZFACT,GASDEV,MAXT,MAXU
      REAL*8 ZENERGY0,ZENERGYF,ZENERGYF2,ZENERGYFTL(20),
     +       ZENERGY0NL,ZENERGYFNL
      REAL*8 PIN(NSVDIM),POUT(NSVDIM),PIN2(NSVDIM)
      REAL*8 ZWORK(NSVDIM,5)
      REAL*8 ZGDSTD0(NI,NKGDIM,NJ),ZGDSTD(NI,NKGDIM,NJ)
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,REMOVE_C,exdb,exfin
      LOGICAL Ltestinnerprod,Ltestnlmx,Lpropcovtlm,Lexist,Ltestgem
      EXTERNAL FNOM,FCLOS,FSTOUV,FSTFRM
      EXTERNAL ABORT3D, exdb, exfin,gasdev
c
      call printrev("SUBROUTINE susv :",17)

      write(NULOUT,*) '**********************************'
      write(NULOUT,*) '***CALCULATING SINGULAR VECTORS***'
      write(NULOUT,*) '**********************************'
c
c Switches to choose different types of tests
c
      Ltestgem=.false.
      Lpropcovtlm=.false.
      Ltestinnerprod=.false.
      Ltestnlmx=.false.
c
c Initialize jobcode for different restart jobs
c
      NJOBCODE=0
c
c Calculate sqrt(Pa) for PASQRT and its adjoint
c
      IF(CSVNORM.eq.'B'.and.NPRECON.gt.0) THEN
c restore RRNK1 to original eigenvectors
        write(nulout,*) 'ORIGINAL EIGENVALUES:'
        DO RR=1,NPRECON
          write(nulout,*) rr,heseval(rr)
          DO II=1,NVADIM
            RRNK1(II,RR) = RRNK1(II,RR)/sqrt(HesEval(RR))
          ENDDO
        ENDDO
c calculate diagonal matrix for sqrt(Pa)
        write(nulout,*) 'MODIFIED EIGENVALUES:'
        DO RR=1,NPRECON
          HesEval(RR)= ( 1.0d0/sqrt(HesEval(RR) + 1.0d0) ) - 1.0d0
          write(nulout,*) rr,heseval(rr)
        ENDDO
      ENDIF
c
c*****************************************************
c Propagate B or Pa using MC approach and TLM
c*****************************************************
      if(Lpropcovtlm) then
c
c restart random number generator
c
      inquire(file='/sx/mrb/home/arma/bue/randnum.dat',
     +        exist=lexist)
      IF(LEXIST) THEN
        open(unit=39,form='unformatted',
     +       file='/sx/mrb/home/arma/bue/randnum.dat')
        read(39) (RRAND(II),II=1,97)
        read(39) IX1,IX2,IX3,IFF
        close(39)
        write(NULOUT,*) 'READING IN RANDNUM'
      ENDIF
c
      IF(CSVNORM.eq.'B') THEN
        DO II=1,NI
          DO JK=1,NKGDIM
            DO JJ=1,NJ
              ZGDSTD(II,JK,JJ) =0.0d0
              ZGDSTD0(II,JK,JJ)=0.0d0
            ENDDO
          ENDDO
        ENDDO
      ENDIF
c
      KULFILE=0
      IERR =  FNOM(KULFILE,'propcovtlm.fst','RND',0)
      IF(IERR.GE.0)THEN
        IERR =  FSTOUV(KULFILE,'RND')
      ELSE
        CALL ABORT3D(NULOUT,'propcovtlm.fst:PROBLEM WITH FILE')
      END IF
c
c START OF LOOP
c
 123  continue
c
        if(nsim3d.eq.NSV) goto 234
c
c Manage a possible restart of the Lanczos algorithm
c
        if(niterjob.gt.0) then
c
          write(nulout,*) 'RESTART: iteration ',nsim3d,' out of ',niterjob
          write(nulout,*) 'JOBCODE= ',njobcode
          call vflush(nulout)
c
          if(mod(nsim3d,niterjob).eq.0.and..not.LRESTART.and.nsim3d.gt.0) then
c write restart file (internal contents origininally in SAVE statements plus main work arrays)
            ireslun=0
            ierr = fnom(ireslun,crestart, 'FTN+SEQ+UNF' , 0)
            WRITE(ireslun) nsim3d,ZGDSTD,ZGDSTD0
            ierr = fclos(ireslun)
            lrestart=.true.
c writing random number data
            open(unit=39,form='unformatted',
     +        file='/sx/mrb/home/arma/bue/randnum.dat')
            write(39) (RRAND(II),II=1,97)
            write(39) IX1,IX2,IX3,IFF
            close(39)
            write(NULOUT,*) 'WRITING OUT RANDNUM'
c
            WRITE(NULOUT,*) 'GOING TO RESTART!!!'
            call vflush(nulout)
            return
          endif
c
          if(LRESTART) then
c read restart file
            ireslun=0
            ierr = fnom(ireslun,crestart,'FTN+SEQ+UNF+OLD+R/O',0)
            READ(ireslun) nsim3d,ZGDSTD,ZGDSTD0
            ierr = fclos(ireslun)
            ierr = remove_c(crestart)
            write(nulout,*) 'READ RESTART FILE: NSIM=',nsim3d
            call vflush(nulout)
            lrestart=.false.
          endif
c
        endif
c
        write(nulout,*) 'TEST GASDEV:',gasdev(1),gasdev(1),gasdev(1)
        do ii=1,nsvdim
          pin(ii)=gasdev(1)
        enddo
        IF(CSVNORM.eq.'B') THEN
          IF(NPRECON.gt.0) THEN
            CALL pasqrt(pin ,pin ,nsvdim,nsvdim)
          ENDIF
          CALL CAIN(NSVDIM,PIN)
          CALL SPA2SP
          CALL SPGD
        ENDIF
        IF(CSVNORM.eq.'E') THEN
          CALL CAINGD(NSVDIM,PIN)
          call applyenergy(.true.,.true.,.true.,.true.)
          call transfer('GD10')
        ENDIF
        call calcenergy(zenergy0)
c
c accumulate variances of initial Pa or B (for HSV and BGSV, respectively)
c
        IF(CSVNORM.eq.'B') THEN
          DO II=1,NI
            DO JK=1,NKGDIM
              DO JJ=1,NJ
                ZGDSTD0(II,JK,JJ)=ZGDSTD0(II,JK,JJ)+GD(II,JK,JJ)**2
              ENDDO
            ENDDO
          ENDDO
        ENDIF
c
        nsim3d = nsim3d + 1
        write(nulout,*) 'CALLING TLM:',nsim3d
        call vflush(nulout)
        call putdx2('F')
        call getdx('F')
c
c accumulate variances of evolved Pa or B (for HSV and BGSV, respectively)
c
        IF(CSVNORM.eq.'B') THEN
          DO II=1,NI
            DO JK=1,NKGDIM
              DO JJ=1,NJ
                ZGDSTD(II,JK,JJ)=ZGDSTD(II,JK,JJ)+GD(II,JK,JJ)**2
              ENDDO
            ENDDO
          ENDDO
        ENDIF
c
        call calcenergy(zenergyf)
        znorm0=0.0
        do ii=1,nsvdim
          znorm0=znorm0+pin(ii)*pin(ii)
        enddo
        write(nulout,*) 'PROPCOV with TLM, norm:',znorm0
        write(nulout,*) 'Energy (TLM):',zenergy0,zenergyf,zenergyf/zenergy0
c
      goto 123
c
c END OF LOOP
c
 234  continue
      write(nulout,*) 'FINISHED LOOPING'
      call vflush(nulout)
c
      IF(CSVNORM.eq.'B') THEN
        DO II=1,NI
          DO JK=1,NFLEV
            DO JJ=1,NJ
              UT0(II,JK,JJ)=sqrt(ZGDSTD0(II,JK+ngposit(nguu)-1,JJ)/NSV)
              VT0(II,JK,JJ)=sqrt(ZGDSTD0(II,JK+ngposit(ngvv)-1,JJ)/NSV)
              TT0(II,JK,JJ)=sqrt(ZGDSTD0(II,JK+ngposit(ngtt)-1,JJ)/NSV)
              Q0(II,JK,JJ) =sqrt(ZGDSTD0(II,JK+ngposit(ngq) -1,JJ)/NSV)
            ENDDO
          ENDDO
        ENDDO
        DO II=1,NI
          DO JJ=1,NJ
            GPS0(II,1,JJ)=sqrt(ZGDSTD0(II,ngposit(ngps),JJ)/NSV)
          ENDDO
        ENDDO
c
        call postproc(kulfile,NSV,'GRID','EVOLCOV0')
c
        DO II=1,NI
          DO JK=1,NFLEV
            DO JJ=1,NJ
              UT0(II,JK,JJ)=sqrt(ZGDSTD(II,JK+ngposit(nguu)-1,JJ)/NSV)
              VT0(II,JK,JJ)=sqrt(ZGDSTD(II,JK+ngposit(ngvv)-1,JJ)/NSV)
              TT0(II,JK,JJ)=sqrt(ZGDSTD(II,JK+ngposit(ngtt)-1,JJ)/NSV)
              Q0(II,JK,JJ) =sqrt(ZGDSTD(II,JK+ngposit(ngq) -1,JJ)/NSV)
            ENDDO
          ENDDO
        ENDDO
        DO II=1,NI
          DO JJ=1,NJ
            GPS0(II,1,JJ)=sqrt(ZGDSTD(II,ngposit(ngps),JJ)/NSV)
          ENDDO
        ENDDO
c
        call postproc(kulfile,NSV,'GRID','EVOLCOVF')
      ENDIF
c
      IERR =  FSTFRM(KULFILE)
      IERR =  FCLOS(KULFILE)
      if(l4dvar) call endsim
      CALL ABORT3D(nulout,'DONE Propagating B or Pa with TLM')
c
      endif
c*****************************************************
c test inner products used for SV calculation
c*****************************************************
      if(Ltestinnerprod) then
c
      do ii=1,1
c generate random vector in control vector space
        IF(CSVNORM.eq.'E') THEN
          jj=0
          do jk=1,NFLEV*3
            do jlat=1,NJ
              do jlon=1,NI
                jj=jj+1
                pin(jj)=gasdev(1)/sqrt(dble(nsvdim))
              enddo
            enddo
          enddo
          do jk=1,NFLEV
            do jlat=1,NJ
              do jlon=1,NI
                jj=jj+1
                pin(jj)=0.0d0
              enddo
            enddo
          enddo
          do jk=1,1
            do jlat=1,NJ
              do jlon=1,NI
                jj=jj+1
                pin(jj)=gasdev(1)/sqrt(dble(nsvdim))
              enddo
            enddo
          enddo
        ELSE
          do jj=1,NSVDIM
            pin(jj)=gasdev(1)/sqrt(dble(nsvdim))
          enddo
        ENDIF
        do jj=1,nsvdim
          pin2(jj)=pin(jj)
        enddo
c
c test avsv
c
        call avSV(nsvdim,pin,pout)
        znorm0=0.0d0
        do jj=1,nsvdim
          znorm0=znorm0+ pin(jj)*pout(jj)
        enddo
        write(nulout,*) 'FROM AVSV = ',znorm0
c
        IF(CSVNORM.eq.'B') THEN
          IF(NPRECON.gt.0) THEN
            CALL pasqrt(pin ,pin ,nsvdim,nsvdim)
          ENDIF
          CALL CAIN(NSVDIM,PIN)
          CALL SPA2SP
          CALL SPGD
        ENDIF
        IF(CSVNORM.eq.'E') THEN
          CALL CAINGD(NSVDIM,pin)
          CALL APPLYENERGY(.true.,.true.,.true.,.true.)
          CALL TRANSFER('GD10')
        ENDIF
c
        nsim3d = nsim3d + 1
        write(nulout,*) 'CALLING TLM+ADJ:',nsim3d
        call vflush(nulout)
        call putdx2('F')
        call getdx('F')
c now calculate energy directly
        call calcenergy(zenergy0)
c apply energy norm
        call applyenergy(.false.,.false.,.true.,.true.)
        call transfer('GD10')
c now adjoints
        call putdx2('A')
        call getdx('A')
        DO i=1,nsvdim
          pout(i)=0.0
        ENDDO
        IF(CSVNORM.eq.'E') THEN
          CALL APPLYENERGY(.true.,.true.,.true.,.true.)
          CALL TRANSFER('GD10')
          CALL CAINGDAD(NSVDIM,pout)
        ENDIF
        IF(CSVNORM.eq.'B') THEN
          CALL SPGDA
          CALL SPA2SPAD
          CALL CAINAD(NSVDIM,pout)
          IF(NPRECON.gt.0) THEN
            CALL pasqrt(pout ,pout ,nsvdim,nsvdim)
          ENDIF
        ENDIF
c
        zenergyf=0.0d0
        do jj=1,nsvdim
          zenergyf=zenergyf+pout(jj)*pin2(jj)
        enddo
        write(nulout,*) 'energy direct, adjoints=',zenergy0,zenergyf,znorm0,
     +                   zenergy0/zenergyf
        call vflush(nulout)
      enddo
c
      if(l4dvar) call endsim
      CALL ABORT3D(nulout,'DONE TESTING AVSV AND INNER ADJOINTS')
      endif
c*****************************************************
c Test TLM vs NLMX of GEM
c*****************************************************
      if(Ltestnlmx) then
c
      KULFILE=0
      IERR =  FNOM(KULFILE,'testnlmx.fst','RND',0)
      IF(IERR.GE.0)THEN
        IERR =  FSTOUV(KULFILE,'RND')
      ELSE
        CALL ABORT3D(NULOUT,'testnlmx.fst:PROBLEM WITH FILE')
      END IF
c
      write(nulout,*) 'TEST GASDEV:',gasdev(1),gasdev(1),gasdev(1)
      do ii=1,nsvdim
        pin(ii)=gasdev(1)/nsvdim
      enddo
      IF(CSVNORM.eq.'B'.and.NPRECON.gt.0) THEN
        CALL pasqrt(pin ,pin ,nsvdim,nsvdim)
      ENDIF
c
c loop with decreasing perturbation size
c
      zfact=1000.0
      do jj=1,5
c
      zfact=zfact/sqrt(10.0)
      write(nulout,*) 'TESTING NLMX WITH ZFACT=',zfact
      do ii=1,nsvdim
        pin2(ii)=pin(ii)*zfact
      enddo
      IF(CSVNORM.eq.'B') THEN
        CALL CAIN(NSVDIM,PIN2)
        CALL SPA2SP
        CALL SPGD
      ENDIF
      IF(CSVNORM.eq.'E') THEN
        CALL CAINGD(NSVDIM,PIN2)
        call applyenergy(.true.,.true.,.true.,.true.)
        call transfer('GD10')
      ENDIF
      call calcenergy(zenergy0)
      call postproc(kulfile,jj,'GRID','TEST_T0 ')
c
      nsim3d = nsim3d + 1
      write(nulout,*) 'CALLING NLMX:',nsim3d
      call vflush(nulout)
      call putdx2('N')
      call getdx('F')
c
      call postproc(kulfile,jj,'GRID','TESTNLMX')
      call calcenergy(zenergyf)
      write(nulout,*) 'TEST of NLMX, energy:',zenergy0,zenergyf
c
      IF(CSVNORM.eq.'B') THEN
        CALL CAIN(NSVDIM,PIN2)
        CALL SPA2SP
        CALL SPGD
      ENDIF
      IF(CSVNORM.eq.'E') THEN
        CALL CAINGD(NSVDIM,PIN2)
        call applyenergy(.true.,.true.,.true.,.true.)
        call transfer('GD10')
      ENDIF
      call calcenergy(zenergy0)
c
      nsim3d = nsim3d + 1
      write(nulout,*) 'CALLING TLMX:',nsim3d
      call vflush(nulout)
      call putdx2('F')
      call getdx('F')
c
      call postproc(kulfile,jj,'GRID','TESTTLMX')
      call calcenergy(zenergyf2)
      write(nulout,*) 'TEST of TLMX, energy:',zenergy0,zenergyf2
      write(nulout,*) 'RATIO = ',zenergyf/zenergyf2
c
      enddo
c
      IERR =  FSTFRM(KULFILE)
      IERR =  FCLOS(KULFILE)
      if(l4dvar) call endsim
      CALL ABORT3D(nulout,'DONE TESTING NLMX of GEM')
c
      endif
c**************************************************
c Propagate random states using TLM and NLMX of GEM
c**************************************************
      if(Ltestgem) then
c
      KULFILE=0
      IERR =  FNOM(KULFILE,'testgem.fst','RND',0)
      IF(IERR.GE.0)THEN
        IERR =  FSTOUV(KULFILE,'RND')
      ELSE
        CALL ABORT3D(NULOUT,'testgem.fst:PROBLEM WITH FILE')
      END IF
c
c      do jj=0,NSV
      do jj=0,1

      write(nulout,*) 'TEST GASDEV:',gasdev(1),gasdev(1),gasdev(1)
      if(jj.gt.0) then
        do ii=1,nsvdim
          if(CSVNORM.eq.'E') then
            pin(ii)=0.1*gasdev(1)/nsvdim
          else
            pin(ii)=gasdev(1)/nsvdim
          endif
        enddo
      else
        do ii=1,nsvdim
          pin(ii)=0.0
        enddo
      endif
      IF(CSVNORM.eq.'B'.and.NPRECON.gt.0) THEN
        CALL pasqrt(pin ,pin ,nsvdim,nsvdim)
      ENDIF
      IF(CSVNORM.eq.'B') THEN
        CALL CAIN(NSVDIM,PIN)
        CALL SPA2SP
        CALL SPGD
      ENDIF
      IF(CSVNORM.eq.'E') THEN
        CALL CAINGD(NSVDIM,PIN)
        call applyenergy(.true.,.true.,.true.,.true.)
        call transfer('GD10')
      ENDIF
      call calcenergy(zenergy0)
      call postproc(kulfile,jj,'GRID','TEST_T0 ')
c
      nsim3d = nsim3d + 1
      write(nulout,*) 'CALLING NLMX:',nsim3d
      call vflush(nulout)
      call putdx2('N')
      call getdx('F')
c
      call postproc(kulfile,jj,'GRID','TESTNLMX')
      call calcenergy(zenergyf)
      write(nulout,*) 'TEST of NLMX, energy:',zenergy0,zenergyf
c
      IF(CSVNORM.eq.'B') THEN
        CALL CAIN(NSVDIM,PIN)
        CALL SPA2SP
        CALL SPGD
      ENDIF
      IF(CSVNORM.eq.'E') THEN
        CALL CAINGD(NSVDIM,PIN)
        call applyenergy(.true.,.true.,.true.,.true.)
        call transfer('GD10')
      ENDIF
      call calcenergy(zenergy0)
c
      nsim3d = nsim3d + 1
      write(nulout,*) 'CALLING TLMX:',nsim3d
      call vflush(nulout)
      call putdx2('F')
      call getdx('F')
c
      call postproc(kulfile,jj,'GRID','TESTTLMX')
      call calcenergy(zenergyf2)
      write(nulout,*) 'TEST of TLMX, energy:',zenergy0,zenergyf2
      write(nulout,*) 'RATIO = ',zenergyf/zenergyf2
c
      enddo
c
      IERR =  FSTFRM(KULFILE)
      IERR =  FCLOS(KULFILE)
      if(l4dvar) call endsim
      CALL ABORT3D(nulout,'DONE TESTING GEM')
c
      endif
c***************************************************
c MAIN SV CALCULATION
c***************************************************
c
      DO RR=1,NSVCV
        DO II=1,NSVDIM
          SV(II,RR)=0.0d0
        ENDDO
      ENDDO
c
c Check for jobcode in case of restart
c     1 = restart in main ARPACK loop
c     2 = restart in second part of ARPACK algorithm (not implemented)
c     3 = restart to begin propagating and outputting SVs
c
      if(niterjob.gt.0) then
        if(njobcode.eq.0.and.LRESTART) then
          ireslun=0
          ierr = fnom(ireslun,crestart,'FTN+SEQ+UNF+OLD+R/O',0)
          READ(ireslun) nsim3d,njobcode
          ierr = fclos(ireslun)
        endif
        write(nulout,*) 'BEFORE ARPACK, JOBCODE=',njobcode
        call vflush(nulout)
      endif
c
c     Set tolerance and call Lanczos algorithm
c
      IF(NJOBCODE.ne.3) THEN
        ISTAMP=EXDB('ARPACK','DEBUT','NON')
        Ztol=1d-1
        call sveigen(nsvdim,nsv,nsvcv,SVEval,SV,Ztol)
        ISTAMP=EXFIN('ARPACK','FIN','NON')
      ENDIF
c
      IF(NITERJOB.gt.0) THEN
c
c this is going to restart within ARPACK
c
        IF(LRESTART.and.NJOBCODE.eq.1) RETURN
c
        write(nulout,*) 'CHECKING FOR RESTART BEFORE OUTPUTTING SVs'
        call vflush(nulout)
c
c this is going to restart before outputting SVs
c
        if(NJOBCODE.ne.3) then
c write restart file
          ireslun=0
          ierr = fnom(ireslun,crestart, 'FTN+SEQ+UNF' , 0)
          njobcode=3
          WRITE(ireslun) nsim3d,njobcode,SVEval,SV
          ierr = fclos(ireslun)
          lrestart=.true.
          WRITE(NULOUT,*) 'GOING TO RESTART NJOBCODE = 3!!!'
          call vflush(nulout)
          return
        endif
c
c this is reading restart before outputting SVs
c
        if(LRESTART.and.NJOBCODE.eq.3) then
c read restart file
          ireslun=0
          ierr = fnom(ireslun,crestart,'FTN+SEQ+UNF+OLD+R/O',0)
          READ(ireslun) nsim3d,njobcode,SVEval,SV
          ierr = fclos(ireslun)
          ierr = remove_c(crestart)
          write(nulout,*) 'READ RESTART FILE 3, NSIM=',nsim3d,njobcode
          call vflush(nulout)
          lrestart=.false.
        endif
c
      endif
c
c     Open file for growth factors and E-values
c
      KULFILE2=0
      IERR = FNOM(KULFILE2,'growth.dat','SEQ+FTN+FMT',0)
c
c Write out initial and final time Singular vectors
c
      KULFILE=0
      IERR =  FNOM(KULFILE,'sv.fst','RND',0)
      IF(IERR.GE.0)THEN
        IERR =  FSTOUV(KULFILE,'RND')
      ELSE
        CALL ABORT3D(NULOUT,'sv.fst:PROBLEM WITH FILE')
      END IF
c
      IF(CSVNORM.eq.'B') THEN
        DO II=1,NI
          DO JK=1,NKGDIM
            DO JJ=1,NJ
              ZGDSTD(II,JK,JJ) =0.0d0
              ZGDSTD0(II,JK,JJ)=0.0d0
            ENDDO
          ENDDO
        ENDDO
      ENDIF
c
      DO RR=1,NSV
        znorm0=0.0
        DO JJ=1,NSVDIM
          pin(JJ)=SV(JJ,NSV-RR+1)
          znorm0=znorm0+ pin(JJ)*pin(JJ)
        ENDDO
c
        IF(CSVNORM.eq.'B') THEN
          IF(NPRECON.gt.0) THEN
            CALL pasqrt(pin ,pin ,nsvdim,nsvdim)
          ENDIF
          CALL CAIN(NSVDIM,PIN)
          CALL SPA2SP
          CALL SPGD
        ENDIF
        IF(CSVNORM.eq.'E') THEN
          CALL CAINGD(NSVDIM,PIN)
          call applyenergy(.true.,.true.,.true.,.true.)
          call transfer('GD10')
        ENDIF
        call calcenergy(zenergy0)
        call postproc(kulfile,RR,'GRID','SV_TL_T0')
c
c accumulate variances of initial Pa or B (for HSV and BGSV, respectively)
c
        IF(CSVNORM.eq.'B') THEN
          DO II=1,NI
            DO JK=1,NKGDIM
              DO JJ=1,NJ
                ZGDSTD0(II,JK,JJ)=ZGDSTD0(II,JK,JJ)+GD(II,JK,JJ)**2
              ENDDO
            ENDDO
          ENDDO
        ENDIF
c
        nsim3d = nsim3d + 1
        write(nulout,*) 'CALLING TLM:',nsim3d
        call vflush(nulout)
        do ii=1,numseg
          write(nulout,*) 'CALLING TLM SEGMENT:',ii,CLNUMS(ii)
          call vflush(nulout)
          call putdx2('F')
          call getdx('F')
          call calcenergy(zenergyftl(ii))
          call postproc(kulfile,RR,'GRID','SV_TL_T'//CLNUMS(ii))
          write(nulout,*) 'Energy(TLM): ',zenergy0,zenergyftl(ii),
     +                                    zenergyftl(ii)/zenergy0
          write(nulout,*) 'Norm0, ratio energF/norm0: ',znorm0,
     +                     zenergyftl(ii)/znorm0
        enddo
c
c accumulate variances of evolved Pa or B (for HSV and BGSV, respectively)
c
        IF(CSVNORM.eq.'B') THEN
          DO II=1,NI
            DO JK=1,NKGDIM
              DO JJ=1,NJ
                ZGDSTD(II,JK,JJ)=ZGDSTD(II,JK,JJ)+GD(II,JK,JJ)**2
              ENDDO
            ENDDO
          ENDDO
        ENDIF
c
c propagate SV with NL model (presently ignores NUMSEG, only 1 segment)
c
c SKIP NL PROPAGATION FOR NOW (SOMETIMES BLOWS UP WHEN PERTURBATION IS NOISY)
      goto 345
        DO JJ=1,NSVDIM
          pin(JJ)=SV(JJ,NSV-RR+1)
        ENDDO
        IF(CSVNORM.eq.'B') THEN
          IF(NPRECON.gt.0) THEN
            CALL pasqrt(pin ,pin ,nsvdim,nsvdim)
          ENDIF
          CALL CAIN(NSVDIM,PIN)
          CALL SPA2SP
          CALL SPGD
        ENDIF
        IF(CSVNORM.eq.'E') THEN
          CALL CAINGD(NSVDIM,PIN)
          call applyenergy(.true.,.true.,.true.,.true.)
          call transfer('GD10')
        ENDIF
c scale initial SV (max temp=1C and max wind=1m/s)
        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
              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
        call calcenergy(zenergy0nl)
        call postproc(kulfile,RR,'GRID','SV_NL_T0')
        nsim3d = nsim3d + 1
        write(nulout,*) 'CALLING NLM:',nsim3d
        call vflush(nulout)
        call putdx2('N')
        call getdx('F')
        call calcenergy(zenergyfnl)
        call postproc(kulfile,RR,'GRID','SV_NL_TF')
        write(nulout,*) 'Energy(NLM): ',zenergy0nl,zenergyfnl,zenergyfnl/zenergy0nl
        write(nulout,*) 'Norm0, ratio energF/norm0: ',znorm0,zenergyf/znorm0
 345  continue
c
c write out growth factor to file
c
        write(kulfile2,*) RR,SVeval(NSV-RR+1),zenergy0,
     +                    (zenergyftl(ii),ii=1,NUMSEG),
     +                    zenergyftl(NUMSEG)/zenergy0,
     +                    zenergy0nl,zenergyfnl,zenergyfnl/zenergy0nl
c
      ENDDO
c
      IERR =  FSTFRM(KULFILE)
      IERR =  FCLOS(KULFILE)
      IERR =  FCLOS(KULFILE2)
c
c output initial and evolved covariances when NSVNORM='B'
c
      IF(CSVNORM.eq.'B') THEN
        KULFILE=0
        IERR =  FNOM(KULFILE,'evolcov.fst','RND',0)
        IF(IERR.GE.0)THEN
          IERR =  FSTOUV(KULFILE,'RND')
        ELSE
          CALL ABORT3D(NULOUT,'evolcov.fst:PROBLEM WITH FILE')
        END IF
c
        DO II=1,NI
          DO JK=1,NFLEV
            DO JJ=1,NJ
              UT0(II,JK,JJ)=sqrt(ZGDSTD0(II,JK+ngposit(nguu)-1,JJ))
              VT0(II,JK,JJ)=sqrt(ZGDSTD0(II,JK+ngposit(ngvv)-1,JJ))
              TT0(II,JK,JJ)=sqrt(ZGDSTD0(II,JK+ngposit(ngtt)-1,JJ))
              Q0(II,JK,JJ) =sqrt(ZGDSTD0(II,JK+ngposit(ngq) -1,JJ))
            ENDDO
          ENDDO
        ENDDO
        DO II=1,NI
          DO JJ=1,NJ
            GPS0(II,1,JJ)=sqrt(ZGDSTD0(II,ngposit(ngps),JJ))
          ENDDO
        ENDDO
c
        call postproc(kulfile,NSV,'GRID','EVOLCOV0')
c
        DO II=1,NI
          DO JK=1,NFLEV
            DO JJ=1,NJ
              UT0(II,JK,JJ)=sqrt(ZGDSTD(II,JK+ngposit(nguu)-1,JJ))
              VT0(II,JK,JJ)=sqrt(ZGDSTD(II,JK+ngposit(ngvv)-1,JJ))
              TT0(II,JK,JJ)=sqrt(ZGDSTD(II,JK+ngposit(ngtt)-1,JJ))
              Q0(II,JK,JJ) =sqrt(ZGDSTD(II,JK+ngposit(ngq) -1,JJ))
            ENDDO
          ENDDO
        ENDDO
        DO II=1,NI
          DO JJ=1,NJ
            GPS0(II,1,JJ)=sqrt(ZGDSTD(II,ngposit(ngps),JJ))
          ENDDO
        ENDDO
c
        call postproc(kulfile,NSV,'GRID','EVOLCOVF')
c
        IERR =  FSTFRM(KULFILE)
        IERR =  FCLOS(KULFILE)
      ENDIF
c
      END