!-------------------------------------- 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 sqrtcgl 4,1
#if defined (DOC)
*
***s/r sqrtcgl  - For grd_typ = 'GU, lcva_hemis = .true.: Sqrt(C) * increment(control variable)
*     .
*Author  : Luc Fillion - 10 Jul 2009
*     .
*Revision:
#endif
C
      IMPLICIT NONE
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comcst.cdk"
#include "comgem.cdk"
#include "comleg.cdk"
#include "comcva.cdk"
#include "comsp.cdk"
#include "comspg.cdk"
#include "comgd0.cdk"
#include "compstat.cdk"
#include "comcorr.cdk"
#include "comcse1.cdk"
#include "comstate.cdk"
      INTEGER ILEN
      INTEGER JN,JM,JK,ILA,jk1,jk2
      REAL*8 SQ2
      REAL*8 , ALLOCATABLE,DIMENSION(:,:,:) :: ZSP, ZSP2

      INTEGER ILENSP, ILENGD, IERR
     S     , ILON, JLEV, JLON, JLAT, JLA, IULOUT
      REAL*8 Z1MNU2, ZSQRTNU2, ZCORIOLIS
      REAL*8 ZGDPSI(NIBEG:NIEND,NFLEV,NJBEG:NJEND)
     S     ,ZGDCHI(NIBEG:NIEND,NFLEV,NJBEG:NJEND)
      REAL*8 DLZSOMME, DLDSOMME, DLA2, DL1SA2, DLFACT
     S     ,DLNORMPSI, DLNORMCHI
!
      INTEGER :: JN0,INS,JNS,NTRUNCHF
      INTEGER :: thdid,numthd,omp_get_thread_num,omp_get_num_threads
      real*8 two
      data two /2.0D0/
*-----------------------------------------------------------------
!
c   3.0 Multiply by EIGENCOR to add in vert corr (scale/rotate)
      IF(NANALVAR.EQ.3) THEN
       SQ2=sqrt(two)
       NTRUNCHF=NTRUNC/2
!$OMP PARALLEL PRIVATE(thdid,numthd,JN,JM,JK,ILA,INS,JN0,JNS,zsp2,zsp)
       thdid=omp_get_thread_num()
       numthd=omp_get_num_threads()

       ALLOCATE(ZSP(NKSDIM,2,0:NTRUNC))
       ALLOCATE(ZSP2(NKSDIM,2,0:NTRUNC))
       DO JN0 = thdid,NTRUNCHF,numthd
          INS=1
          IF(JN0 == (NTRUNC-JN0))INS=0
          DO 222 JNS=0,INS
             JN=(1-JNS)*JN0+JNS*(NTRUNC-JN0)
C
C*    Transfer Dx from global to working array
C
         DO JM = 0, JN
            ILA = NIND(JM) + JN - JM
            DO JK = 1, NKSDIM
               ZSP(JK,1,JM) = SP(ILA,1,JK)
               ZSP(JK,2,JM) = SP(ILA,2,JK)
            END DO
         END DO
C
C*    Compute (CORNS(NKSDIM,NKSDIM,JN) * ZSP)
C
            CALL MXMAOP(CORNS(1,1,JN,1),1,NKSDIM,ZSP(1,1,0),1,NKSDIM
     +        ,ZSP2(1,1,0),1,NKSDIM,NKSDIM,NKSDIM,2*(JN+1))
C
C*    Transfer from working array to global array
C
         ILA = NIND(0) +JN
         DO JK = 1, NKSDIM
            SP(ILA,1,JK) = ZSP2(JK,1,0)*SQ2
            SP(ILA,2,JK) = ZSP2(JK,2,0)*SQ2
         END DO

         DO JM = 1, JN
            ILA = NIND(JM) +JN - JM
            DO JK = 1, NKSDIM
               SP(ILA,1,JK) = ZSP2(JK,1,JM)
               SP(ILA,2,JK) = ZSP2(JK,2,JM)
            END DO
         END DO
C
         DO JK=1,NKSDIM
            DO ILA=1,NTRUNC+1
               SP(ILA,2,JK)=0.0
            ENDDO
         ENDDO
C
222    CONTINUE
       END DO
       DEALLOCATE(zsp)
       DEALLOCATE(zsp2)
!$OMP END PARALLEL
      endif
!
      return
      end