CMAX: [Version 1.0 (6/22/93)]
CMAX: ----------------------------------------------------
CMAX: Transformation of DELMIX from delmix.f
CMAX: ----------------------------------------------------
      SUBROUTINE delmix(nymd,nhms,rhmod,rmixmod,pmand,psfc,data,nobs,im,
     &    jnp,mlev,mmix,sigdat,bq,fg_t)
      
      INTEGER MaxObservPoints
      PARAMETER (MaxObservPoints = 150000)
C Program Name: DELMIX
C         Date:   1984
C   Programmer: Y. Brin
C
C Program DELMIX reads rh/mixing ratio data, does gross and buddy
C checks, and returns mixing ratio deltas.
C
C Modifications:
C
C     6/91  M.Seablom   Adjustable dimensions for DATA array.
C     6/92  M.Seablom   RH and mixing ratio values checked for
C                       consistency by using emperical saturation
C                       vapour pressure formula.
C     2/93  D.Lamich    chkmix not called if nlobs = 0
c.....................................................................
C
C N A S A / D A O  O P T I M U M  I N T E R P O L A T I O N  -  1 . 3
c.....................................................................
c
c     Maximal observation points
c
c
c
      REAL data (MaxObservPoints * 10), psfc (im, jnp), pmand (mlev), rh
     &mod (im, jnp, mlev), rmixmod (im, jnp, mlev), typesum, fg_t (im, j
     &np, mlev)
      COMMON / scan / maxobs, rscan, onestage, MaxData
      LOGICAL strat, slp, fdcos, fexp, flow, sigdat, onestage, repack
C  DATA POINTERS
      COMMON / DATAPTRS / IKX, ILAT, ILON, IPMIX, ITYPE, IMIX, IFCER
      INTEGER bq (MaxObservPoints)
C  DATA AT A PRESSURE LEVEL .
      COMMON / LEVEL / INDX (20000), KX (20000), LAT (20000), LON (20000
     &), PR (20000), RH (20000), MIX (20000), DIFF (20000), QDATA (20000
     &)
      REAL INDX, KX, LAT, LON, MIX
      DIMENSION TYPE (20000)
      EQUIVALENCE (RH (1), TYPE (1))
      INTEGER QDATA
C  PRINT FLAG
      COMMON / PRINT / MSGLEV
C  MANDATORY PRESSURE LEVELS
      COMMON / PRMAND18 / PMAND18 (18), ALOGP18 (18), PKAP18 (18), PKAP1
     &18 (18), PM18 (18)
!hpf$ distribute alogp18(block)
!hpf$ distribute bq(block)
!hpf$ distribute data(block)
!hpf$ distribute diff(block)
!hpf$ distribute fg_t(block,block,block)
!hpf$ distribute indx(block)
!hpf$ distribute kx(block)
!hpf$ distribute lat(block)
!hpf$ distribute lon(block)
!hpf$ distribute mix(block)
!hpf$ distribute pkap118(block)
!hpf$ distribute pkap18(block)
!hpf$ distribute pm18(block)
!hpf$ distribute pmand(block)
!hpf$ distribute pmand18(block)
!hpf$ distribute pr(block)
!hpf$ distribute psfc(block,block)
!hpf$ distribute qdata(block)
!hpf$ distribute rh(block)
!hpf$ distribute rhmod(block,block,block)
!hpf$ distribute rmixmod(block,block,block)
!hpf$ distribute type(block)
      IF (nobs .EQ. 0) THEN
        RETURN
      ENDIF
C  INITIALIZE TYPE PART OF DATA ARRAY TO 0.0
      data(itype:itype + nobs - 1) = 0.0
      irh = imix + nobs
C  LOOP OVER THE PRESSURE LEVELS, TOP TO BOTTOM
      typesum = 0.0
      lev1 = mlev - mmix + 1
      DO 7004 l = lev1 , mlev
        CALL getmix_v1(l,data,ikx,maxobservpoints * 10,data,ilat,
     &      maxobservpoints * 10,data,ilon,maxobservpoints * 10,data,
     &      ipmix,maxobservpoints * 10,data,imix,maxobservpoints * 10,
     &      data,irh,maxobservpoints * 10,bq,1,maxobservpoints,nobs,
     &      nlobs,pmand,mlev,mmix,sigdat)
        IF (msglev .GT. 3) THEN
          WRITE( 6,900 ) pmand(l),nlobs
        ENDIF
C  COMPUTE DELTAS AND DO QUALITY CONTROL FOR MOISTURE DATA
        IF (nlobs .GT. 0) THEN
          CALL chkmix(l,rhmod,rmixmod,nlobs,pmand,im,jnp,mlev,mmix,
     &        sigdat,fg_t)
        ENDIF
C SCATTER MIXING RATIO DELTAS AND TYPE INDICATOR INTO MAIN DATA ARRAY
        DO i = 1 , nlobs
          kk = indx(i) - 0.9
          data(imix + kk) = mix(i)
          data(itype + kk) = type(i)
        ENDDO
        DO i = 1 , nlobs
          typesum = typesum + type(i)
        ENDDO
        CONTINUE
 7004 CONTINUE
C  PRINT OUT TOTAL NUMBER OF DELTAS ACCEPTED .
      WRITE( 6,910 ) typesum
c  Write out to DEL dataset.
      WRITE( 91 ) nobs,nymd,nhms,'MIX'
      DO i = 1 , nobs
        WRITE( 91 ) data(ilat + i - 1),data(ilon + i - 1),
     &      data(itype + i - 1),data(ipmix + i - 1),data(ikx + i - 1),0.
     &      ,0.,data(imix + i - 1)
      ENDDO
      CALL rptlly_v1(data,ikx,maxobservpoints * 10,data,itype,
     &    maxobservpoints * 10,nobs,3)
      RETURN
900   FORMAT (' DELMIX: * * *  LEVEL = ',F10.2,'     NUMBER OF OBS ',I8)
910   FORMAT ('0DELMIX: * *  TOTAL NUMBER OF ACCEPTED DELTAS = ',F8.2,/)
      END
