!-------------------------------------- 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 sutg_cor(KULSSF) 1,7
#if defined (DOC)
*
***s/r sutg_cor  - Compute the correlation for TG using a specified length scale.
*
*Author  : Luc Fillion - 12 Jul 2010 (from sutg.ftn).
*
*Revision:
*
* Arguments:
*     KULSSF    : logical unit to be used to access the SSF file
#endif
      IMPLICIT NONE
*implicits
*
*     Global variables
*
#include "comlun.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comcva.cdk"
#include "comcorr.cdk"
#include "compstat.cdk"
#include "comstate.cdk"
#include "comsp.cdk"
#include "comgd0.cdk"
#include "comspg.cdk"
#include "rpnstd.cdk"
#include "comleg.cdk"
#include "comcst.cdk"
*
*     Arguments
*
      INTEGER KULSSF
*
*     Local variables
*
      LOGICAL  LLPB
*
      INTEGER IKEY, ILEN, JLAT, JLON, JLA, ezgprm, igdgid, ezqkdef
      INTEGER JN, JM, JM0, ILA, inlev, itggid, inmxlev,ier, iset
      integer ezdefset, vezsint
      integer ip1style,ip1kind,jlatbin
*
      REAL*8 ZSPCORR(NTRUNC+1)
*
      REAL*8 ZABS, ZPOLE, ZCONST, DLFAC, DLCORR
*
      POINTER (PXSPCORR ,ZSPCORR)

      integer vfstlir
      integer koutmpg
      external vfstlir
!---------------------------------------------------------------------
!!
      write(nulout,fmt='(8x,2A)')'sutg_cor- Set TG background error Correlations'
      clnomvar='TG'
      idateo=-1
      inmxlev=1
!
!     Allocating local arrays
!     --------------------------
!
      ILEN = NTRUNC+1
      CALL HPALLOC(PXSPCORR,MAX(ILEN,1),IERR,8)
!
 9420 FORMAT(//,6x,'--Reading standard deviations for TG in'
     S     ,' physical space from the file ',A)
!
      CALL TRANSFER('ZGD0')
      CALL TRANSFER('ZSP0')
!
      cortgg(:,:,:) = 0.0
!
!     Compute correlations in physical space
!
      write(nulout,*) ' sutg_cor. RCSCLTG    = ', RCSCLTG
      write(nulout,*) ' sutg_cor. NTGCORRTYP = ', NTGCORRTYP
      if (ngexist(ngtg) .eq. 1) then
        call calccorr(ngposit(ngtg),RCSCLTG,1,NTGCORRTYP)
      endif
!
!     Bring back the result in spectral space
!
      if(lcva_hsp) then
        CALL REESPE_hem(NKSDIM,SP,GD,NLA,NIBEG,NIEND,NJBEG,NJEND,NKSDIM)
      else
        CALL REESPE(NKSDIM,SP,GD,NLA,NIBEG,NIEND,NJBEG,NJEND,NKSDIM)
      endif 
!
!     Check positiveness
!
      LLPB = .FALSE.
      DO JLA=1,NTRUNC+1
        ZABS = ABS(SPTG(JLA,1,1))
        LLPB = LLPB.OR.((SPTG(JLA,1,1).LT.0.)
     S         .AND.(ZABS.GT.RPRECIS))
      END DO
      IF(LLPB) THEN
        WRITE(UNIT=NULOUT
     S       ,FMT='(" AUTOCORRELATION  NEGATIVES ")')
        CALL ABORT3D(NULOUT,' Problem in  sutg_cor')
      ENDIF
      DO JLA = 1, NTRUNC+1
        SPTG(JLA,1,1) = ABS(SPTG(JLA,1,1))
      END DO
!
      ZPOLE = 0.
      DO  JLA = 1, NTRUNC+1
        JN = JLA-1
        ZPOLE = ZPOLE + SPTG(JLA,1,1)*SQRT((2.*JN+1.)/2.)
      END DO
      IF(ZPOLE.LE.0.) THEN
        WRITE(UNIT=NULOUT
     S       ,FMT='("POLE VALUE NEGATIVE IN sutg_cor")')
        CALL ABORT3D(NULOUT,'sutg_cor:')
      ENDIF
      DO JLA = 1, NTRUNC+1
        SPTG(JLA,1,1) = SPTG(JLA,1,1)/ZPOLE
        SPTG(JLA,2,1) = SPTG(JLA,2,1)/ZPOLE
      END DO
!
!     Correlation
!
      ZCONST  = 1.E10
!
      DO JN = 1, NTRUNC + 1
        ZSPCORR(JN) = SPTG(JN,1,1)
      END DO
!
      DO JM   = 0, NTRUNC
        DO JN   = JM, NTRUNC
          JLA  = NIND(JM) + JN - JM
          JM0  = JN + 1
          DLFAC = 0.5/DSQRT((2*JN+1.D0)/2.D0)
          DLCORR = DLFAC * ZSPCORR(JM0)
          CORTGG(JLA,1,1) = DLCORR
          CORTGG(JLA,2,1) = DLCORR
        ENDDO
      ENDDO
!
!     For zonal modes : set to zero the imaginary part
!     and set the correct factor 1.0 for the real part
!     ------------------------------------------------
!
      DO JLA = 1, NTRUNC + 1
        CORTGG(JLA,1,1) = 0.5*CORTGG(JLA,1,1)
        CORTGG(JLA,2,1) = 0.0
      END DO
!
!     Result in corns array
!     ---------------------
!
      DO JN = 0, NTRUNC
        ILA = JN + 1
        DO JLATBIN=1,NLATBIN
          CORNS(nsposit(nstg),nsposit(nstg),JN,JLATBIN) = 2.D0*CORTGG(ILA,1,1)
        END DO
      END DO
!
!     Deallocate local arrays
!
      CALL HPDEALLC(PXSPCORR,IERR,1)
      WRITE(nulout,*)'DONE in sutg_cor'
!
      RETURN
      END