!-------------------------------------- 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 CALCCORR(KGPOSIT,PCSCL,KLEV,KCORRTYP) 2,1
*
      IMPLICIT NONE
      INTEGER KLEV,KCORRTYP,KGPOSIT
      REAL*8 PCSCL(KLEV)
*
#if defined (DOC)
***s/r CALCSOAR: Computes autoregressive and Gaussian correlation
*
*Author: Simon Pellerin ARMA/AES  - Jan 97
*        Based on sugerco.ftn v7.03 of 3DVAR RCS master.
*
*Revision:
*
#endif
*
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comleg.cdk"
#include "comcst.cdk"
#include "comgem.cdk"
#include "compstat.cdk"
#include "comgd0.cdk"
*
      INTEGER  JLEV, JGL, INI, jlon
      REAL*8 ZR
      REAL*8 DLALPHA, DLFAC, DLTEMP, DLN, DLCSURN, DLC, DLCORR
*
      DLALPHA = 1.D0*RALPHATOAR
      DLFAC   = 1.D0/(1.D0+DLALPHA)
      DLN     = 1.D0*FLOAT(NTOAR)
      DLTEMP  = (3.D0*(1.D0 + DLALPHA))/(1.D0 + DLALPHA/(DLN*DLN))
      DLTEMP  = DSQRT(DLTEMP)
*
      if (KCORRTYP.eq.1) then
*
*     Gaussian correlation
*
        DO  JLEV = 1, KLEV
          DLC = 1.D0/DBLE(PCSCL(JLEV))
          DLC = 0.5*DLC*DLC
*
          DO  JGL = 1, NJ
            ZR = RA * ACOS(RMU(JGL))
            INI = NILON(JGL)
            DLCORR = DEXP(-(ZR**2)*DLC)
            DO  JLON = 1, INI
              GD(JLON,KGPOSIT+JLEV-1,JGL) = DLCORR
            END DO
          END DO
        END DO
*
      elseif (KCORRTYP.eq.2) then
*
*     Autoregressive (SOAR) correlation
*
        DO  JLEV = 1, KLEV
          DLC = DLTEMP/DBLE(pcscl(JLEV))
          DLCSURN = DLC/DLN
          DO  JGL = 1, NJ
            INI = NILON(JGL)
            ZR = RA * ACOS(RMU(JGL))
            DLCORR = (1.D0 + DLC*ZR + ZR*DLC*ZR*DLC/3.D0)*DEXP(-ZR*DLC)
     S           + DLALPHA*(1.D0 + DLCSURN*ZR + ZR*DLCSURN*ZR*DLCSURN/3
     &           .D0)*DEXP(-ZR*DLCSURN)
            DLCORR = DLCORR*DLFAC
            DO  JLON = 1, INI
              GD(JLON,KGPOSIT+JLEV-1,JGL) = DLCORR
            END DO
          END DO
        END DO
      else
        CALL ABORT3D(NULOUT,'SUGERCO- Undefined correlation type')
      endif
C
      RETURN
      END