!-------------------------------------- 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 setcrosscorr(kn,klatbin) 3
#if defined (DOC)
*
***s/r SETCROSSCORR - Set to zero all cross-variable correlations
*                     but T'ln(ps')
*Author  : S.Pellerin *ARMA/AES March 2000
*Revision:
*          M. Buehner ARMA May 2008
*          - modifications for using correlations over multiple
*            latitude bands (NANALVAR=4)
*
*Arguments
*
#endif
      IMPLICIT NONE
*implicits
#include "comdim.cdk"
#include "comlun.cdk"
#include "comcorr.cdk"
#include "comstate.cdk"
*
      INTEGER kn,klatbin,jblock1,inbrblock,jblock2
      REAL*8 DLFACT
      INTEGER JK1, JK2
!
!!
      write(nulout,*) 'setcrosscorr: Set to zero all cross-variable correlations
     & but T_u ln(ps_u'
*
      inbrblock = NVSP+NVSAUX
c
c Set cross-variable correlations to 0 ...
c
      do jblock1 = 1, inbrblock
        do jblock2 = 1, inbrblock
          if (jblock1.ne.jblock2) then
            do jk2 = 1, nflev
              do jk1 = 1,nflev
                corns(jk1 + nflev*(jblock1 -1),jk2 + nflev*(jblock2 -1
     &               ),kn,klatbin) = 0.0
              enddo
            enddo
          endif
        enddo
      enddo
c
c ... but T'ln(ps') correlations
c
      do jk2 = 1,nksdim
        do jk1 = inbrblock*nflev+1,inbrblock*nflev+nvsp2d
          if ((jk1.ne.nsposit(nsps).or.jk2.lt.nsposit(nstt).or.jk2.ge
     &         .(nsposit(nstt)+nflev)).and.(jk1.ne.jk2)) then
            corns(jk1,jk2,kn,klatbin) = 0.0
          endif
        enddo
      enddo
c
      do jk2 = inbrblock*nflev+1,inbrblock*nflev+nvsp2d
        do jk1 = 1,nksdim
          if ((jk2.ne.nsposit(nsps).or.jk1.lt.nsposit(nstt).or.jk1.ge
     &         .(nsposit(nstt)+nflev)).and.(jk1.ne.jk2)) then
            corns(jk1,jk2,kn,klatbin) = 0.0
          endif
        enddo
      enddo
c
      return
      end