CMAX: [Version 1.0 (6/22/93)]
CMAX: ----------------------------------------------------
CMAX: Transformation of OBSCOVH from obscovh.f
CMAX: ----------------------------------------------------
CFPP$ NOCONCUR R
      SUBROUTINE obscovh(ocv,zkx,obserr,kq,pi,pj,d,xki,hco,vco,nz,nzs)
C-----------------------------------------------------------------------
C             NASA / DAO  OPTIMUM INTERPOLATION ANALYSIS GROUP
C--------------------------- ANALYSIS VERSION 1.3 ----------------------
C     Programmer: S. Bloom
C     Date:       September, 1991
C
c     This subroutine generates the observation error covariances,
c     horizontal and vertical, for high latitude volumes.
C
C     INPUTS:
C
C             D         OBS-OBS DISTANCES (FROM MMCOV)
C             NZ        NUMBER OF HEIGHT OBSEVATIONS
C             PI        PRSI (OBS PRESSURES AT 'I' POINTS)
C             PJ        PRSJ (OBS PRESSURES AT 'J' POINTS)
C
C     OUTPUT:
C
C             OCV       OBS-OBS HEIGHT ERROR COVARIANCES
C
C     Modifications:
C       Sept. 1991  ( M. Seablom ) Removal of matrix pointers; upgrade
C                                  to version 1.2 ( variable minivolumes
C       May 1992  ( M. Seablom ) Introduction of hybrid matrix setup.
C----------------------------------------------------------------
      DIMENSION obserr(200,4,19),vco(:),hco(:),xki(:),pj(:),pi(:),d(:),
     &    kq(*),zkx(:),ocv(:)
      DIMENSION gj (6000), gi (6000), IHOLD (4000), IARR (4000)
      INTEGER mycount
      COMMON / OBSCORR / VCORLIST (200), HCORLIST (200), VCOROE (13, 13,
     & 4), HCOROE (400, 5)
!hpf$ distribute d(block)
!hpf$ distribute gi(block)
!hpf$ distribute gj(block)
!hpf$ distribute hco(block)
!hpf$ distribute hcorlist(block)
!hpf$ distribute hcoroe(block,block)
!hpf$ distribute iarr(block)
!hpf$ distribute ihold(block)
!hpf$ distribute kq(block)
!hpf$ distribute obserr(block,block,block)
!hpf$ distribute ocv(block)
!hpf$ distribute pi(block)
!hpf$ distribute pj(block)
!hpf$ distribute vco(block)
!hpf$ distribute vcorlist(block)
!hpf$ distribute vcoroe(block,block,block)
!hpf$ distribute xki(block)
!hpf$ distribute zkx(block)
      INTEGER  IOFFSET100(nz)
!hpf$ distribute IOFFSET100(block)
      INTEGER  IZZ100(nz)
!hpf$ distribute IZZ100(block)
      INTEGER  IOFFSET101(nz)
!hpf$ distribute IOFFSET101(block)
      INTEGER  IZZ101(nz)
!hpf$ distribute IZZ101(block)
      INTEGER  IOFFSET102(nz)
!hpf$ distribute IOFFSET102(block)
      INTEGER  IZZ102(nz)
!hpf$ distribute IZZ102(block)
      LOGICAL lif(nzs)
!hpf$ distribute lif(block)
      DATA ZERO / 0.0 /
      DATA ONE / 1.0 /
      DATA TENTH / 0.10 /
      DATA TENM3 / .001 /
      INTEGER Ti1
C------------------------------------------------------------
C------------------------------------------------------------
      i2(i) = i * (i + 1) / 2
      i1(i) = i * (i - 1) / 2
      FORALL (kz = 1:nz) izz100(kz) = i1(kz)
      FORALL (kz = 1:nz) ioffset100(kz) = (kz - 1) * nz
      DO kz = 1 , nz
        DO kzz = 1 , kz
          ocv(izz100(kz) + kzz) = d(ioffset100(kz) + kzz)
        ENDDO
      ENDDO
      d(:nzs) = ocv(:nzs)
      FORALL (kz = 1:nz) izz101(kz) = i1(kz)
      FORALL (kz = 1:nz) ioffset101(kz) = (kz - 1) * nz
      DO kz = 1 , nz
        DO kzz = 1 , kz
          ocv(izz101(kz) + kzz) = pi(ioffset101(kz) + kzz)
        ENDDO
      ENDDO
      pi(:nzs) = ocv(:nzs)
      FORALL (kz = 1:nz) izz102(kz) = i1(kz)
      FORALL (kz = 1:nz) ioffset102(kz) = (kz - 1) * nz
      DO kz = 1 , nz
        DO kzz = 1 , kz
          ocv(izz102(kz) + kzz) = pj(ioffset102(kz) + kzz)
        ENDDO
      ENDDO
      pj(:nzs) = ocv(:nzs)
      mycount = 0
      DO i = 1 , nz
        DO j = 1 , i
          mycount = mycount + 1
          gi(mycount) = float(i)
          gj(mycount) = float(j)
        ENDDO
      ENDDO
      CALL ahgather_v2(zkx,gi,xki,nzs)
      CALL ahgather_v2(zkx,gj,hco,nzs)
      CALL ahgather_v2(vcorlist,hco,vco,nzs)
      CALL ahgather_v2(hcorlist,xki,ocv,nzs)
      ncount = 0
C
C     FIRST SECTION COUNTS THE NUMBER OF OBSERVATION PAIRS TO
C     CORRELATE (NCOUNT). ALSO COMPRESSES THE ARRAYS, REMEMBERING
C     THE CORRECT LOCATION IN IARR.
C
C     THE COMPRESSION STEP USES IHOLD AS A "PLACEHOLDER", WITH ALL
C     ELEMENTS INITIALLY ONE.  THEN DIAGONAL ELEMENTS ARE SET TO ZERO.
C     FINALLY, ALL APPROPRIATE LOCATIONS ARE MARKED WITH INTEGERS.
C     INDEX ARRAY "IARR" IS OBTAINED BY USING WHENIGT FUNCTION, WHICH
C     POINTS TO ALL NON-ZERO ELEMENTS OF IHOLD.
C
      DO ti1 = 1 , nzs
        ihold(ti1) = 1
      ENDDO
      DO 7016 n = 1 , nz
        ihold(i2(n)) = 0
 7016 CONTINUE
      DO k = 1 , nzs
        lif(k) = (xki(k) .EQ. hco(k) .AND. vco(k) .NE. zero) .AND. ihold
     &      (k) .NE. 0
        IF ((xki(k) .EQ. hco(k) .AND. vco(k) .NE. zero) .AND. ihold(k) 
     &        .NE. 0) THEN
          ncount = ncount + 1
          ihold(k) = ncount
        ENDIF
      ENDDO
      DO k = 1 , nzs
        IF (.NOT.lif(k)) THEN
          ihold(k) = 0
        ENDIF
      ENDDO
      IF (ncount .EQ. 0) THEN
        RETURN
      ENDIF
      CALL whenigt(nzs,ihold,1,0,iarr,ncnt)
      IF (ncnt .NE. ncount) THEN
        WRITE( 6,401 ) ncnt,ncount
      ENDIF
401   FORMAT ('  WHENIGT PROBLEM, NCNT  NCOUNT ',2I8)

      do ti1=1, ncount
              D(ti1)  =   D(IARR(ti1))
             PI(ti1)  =  PI(IARR(ti1))
             PJ(ti1)  =  PJ(IARR(ti1))
            XKI(ti1)  = XKI(IARR(ti1))
            VCO(ti1)  = VCO(IARR(ti1))
            OCV(ti1)  = OCV(IARR(ti1))
      enddo

C
C     NEXT SECTION GENERATES HORIZONTAL CORRELATIONS,
C     CHECKING FOR RAWINSONDES (ITY=-1) WHICH ARE NOT
C     HORIZONTALLY CORRELATED (HENCE THE CHECK FOR D >0,
C     SINCE RAWINSONDES HAVE VERTICAL CORRELATION...)
C
      DO l = 1 , ncount
        id = int(tenth * d(l) + tenm3)
        r = tenth * d(l) - id
        id = id + 1
        id1 = id + 1
        ity = int(ocv(l) + tenm3)
        IF (ity .GT. 0) THEN
          t1 = hcoroe(id,ity)
          t2 = hcoroe(id1,ity)
          ocv(l) = t1 + r * (t2 - t1)
        ELSE
          ocv(l) = one
          IF (d(l) .GT. zero) THEN
            ocv(l) = zero
          ENDIF
        ENDIF
      ENDDO
C
C     THIS SECTION OBTAINS THE OBSERVATION HEIGHT ERROR VARIANCES,
C     AND ACCUMULATES THEM INTO OCV.
C
C     NOTE: REDEFINING VARIABLES TO SAVE SPACE,
C             D   = 'OBERI' (IN OLD ZUVCOV CODE)
C             HCO = 'OBERJ' ( " )
C
      CALL obertrp0(xki,pi,d,obserr,kq(1),ncount)
      CALL obertrp0(xki,pj,hco,obserr,kq(1),ncount)
      ocv(:ncount) = d(:ncount) * hco(:ncount) * ocv(:ncount)
C
C     THIS SECTION OBTAINS THE VERTICAL CORRELATION TERMS, TAKING
C     CARE TO USE THE CORRECT VERTICAL CORRELATION FUNCTION FOR EACH
C     INSTRUMENT
C
      hco(:ncount) = zero
      CALL vcorroe(pi,pj,hco,vco,ncount)
C     FINALLY, COMBINE THE RESULTS.
C             1. COMBINE VERTICAL CORRELATIONS WITH REST OF TERMS
C                (SAVING COMPRESSED COVARIANCES IN VCO)
C
C             2. ZERO THE OCV ARRAY
C
C             3. LOAD COVARIANCES INTO PROPER LOCATIONS IN OCV USING
C                IARR
C
      vco(:ncount) = ocv(:ncount) * hco(:ncount)
      ocv(:nzs) = zero
      DO l = 1 , ncount
        ocv(iarr(l)) = vco(l)
      ENDDO
      RETURN
      END
