CMAX: [Version 1.0 (6/22/93)]
CMAX: ----------------------------------------------------
CMAX: Transformation of CHKMIX from chkmix.f
CMAX: ----------------------------------------------------
C......................................................................
C                                                                     .
C  Program:    CHKMIX                                                 .
C  Language:   FORTRAN V (ANSI-77 STANDARD)                           .
C  Computer:   Cray YMP 4/832                                         .
C                                                                     .
C  Programmer: J. Pfaendtner                                          .
C  Date:       July, 1990                                             .
C                                                                     .
C  Modifications:                                                     .
C                                                                     .
C     6/92  M.Seablom   RH and mixing ratio values checked for        .
C                       consistency by using emperical saturation     .
C                       vapour pressure formula.                      .
C......................................................................
      SUBROUTINE chkmix(ll,rhmod,rmixmod,nlobs,pmand,im,jnp,mlev,mmix,
     &    sigdat,fg_t)
      include '/usr/include/cm/CMF_defs.h'
C  COMPUTE DELTAS AND DO QUALITY CONTROL FOR MOISTURE DATA
      COMMON CUTVAL (20000)
      INTEGER I
      INTEGER KK
      INTEGER LL
      COMMON LQU (20000)
      REAL LQU
      INTEGER NLOBS
      INTEGER NPASS
      REAL pmand (mlev)
      COMMON PWT (20000)
      DIMENSION RHMOD (im, jnp, mlev)
      DIMENSION RMIXMOD (im, jnp, mlev)
      real              fg_t( im,jnp,mlev ), obs_t( nlobs ),
     &                  sat_vap_prs( nlobs ), test_RH( nlobs )
      CHARACTER * 60 message
      COMMON / BUDBITS / BGRS (20000), BACC (20000), BBUD (20000), BCHK 
     &(20000)
      INTEGER BGRS, BACC, BBUD, BCHK
      LOGICAL sigdat
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
     &)
      DIMENSION TYPE (20000)

cmm$  This equivalence is suspicious, see if you can avoid it, or use align
      EQUIVALENCE (RH (1), TYPE (1))

      REAL INDX, KX, LAT, LON, MIX
      INTEGER QDATA
C  PRINT FLAG
      COMMON / PRINT / MSGLEV
c      INTEGER Tobs_t_auto, Ttest_RH_auto, Tsat_vap_prs_auto
!hpf$ distribute bacc(block)
!hpf$ distribute bbud(block)
!hpf$ distribute bchk(block)
!hpf$ distribute bgrs(block)
!hpf$ distribute cutval(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 lqu(block)
!hpf$ distribute mix(block)
!hpf$ distribute obs_t(block)
!hpf$ distribute pmand(block)
!hpf$ distribute pr(block)
!hpf$ distribute pwt(block)
!hpf$ distribute qdata(block)
!hpf$ distribute rh(block)
!hpf$ distribute rhmod(block,block,block)
!hpf$ distribute rmixmod(block,block,block)
!hpf$ distribute sat_vap_prs(block)
!hpf$ distribute test_rh(block)
!hpf$ distribute type(block)
      message(1:60) = ' '
C  Use 50% as the cutoff value for all reports.
      DO 7000 i = 1 , nlobs
        kk = kx(i) + 0.5
        cutval(i) = 50.
  100   CONTINUE
 7000 CONTINUE
c  Check for consistency in computation of mixing ratio. Interpolate
c  first guess temperature to observation locations. Compute saturation
c  vapour pressure and mixing ratio based upon pressure, temperature,
c  and relative humidity.

      CALL vterpv(lat,lon,pr,obs_t,nlobs,fg_t)

      DO 7002 i = 1 , nlobs
        IF (obs_t(i) .GE. 273.16) THEN
          sat_vap_prs(i) = 6.1078 * exp(17.269 *
     &         (obs_t(i) - 273.16) / (obs_t(i) - 35.86))
        ELSE
          sat_vap_prs(i) = 6.1078 * exp( 21.8747*(obs_t(i)-273.16)/
     &                    (obs_t(i)- 7.66) )
        ENDIF
 7002 CONTINUE

      DO 7004 i = 1 , nlobs
       test_RH(i) = 100.*(mix(i) / sat_vap_prs(i) )
 7004 CONTINUE

C  INTERPOLATE FIRST GUESS TO OBS LOCATIONS AND COMPUTE DELTAS
C  CASE 1:  NO SIGNIFICANT LEVEL DATA IS BEING USED
      IF (.NOT.sigdat) THEN
        CALL terpv(lat,lon,diff,nlobs,rhmod(1,1,ll))
         DO 110 I = 1, NLOBS
            RH(I)   = RH(I) - DIFF(I)
            test_RH(i) = test_RH(i) - diff(i)
  110    CONTINUE
        CALL terpv(lat,lon,diff,nlobs,rmixmod(1,1,ll))
         DO 120 I = 1, NLOBS
            MIX(I)  = MIX(I) - DIFF(I)
  120    CONTINUE

C  CASE 2:  SIGNIFICANT LEVEL DATA IS BEING USED
      ELSE
        CALL prefac(ll,pr,nlobs,lqu,pwt)
        CALL terpv3(ll,nlobs,lat,lon,rh,rhmod,pwt,lqu,diff)

         DO 130 I = 1, NLOBS
            RH(I)  = DIFF(I)
  130    CONTINUE

        CALL terpv3(ll,nlobs,lat,lon,mix,rmixmod,pwt,lqu,diff)
        DO 140 i = 1 , nlobs
          mix(i) = diff(i)
  140     CONTINUE
      ENDIF
c  Perform the gross check.
      FORALL (i = 1:nlobs, (abs(rh(i)) .LE. cutval(i)) .AND. (
     &    abs(test_rh(i)) .LE. cutval(i))) bgrs(i) = 1
      FORALL (i = 1:nlobs, .NOT.((abs(rh(i)) .LE. cutval(i)) .AND. (
     &    abs(test_rh(i)) .LE. cutval(i)))) bgrs(i)= 0
      DO i = 1 , nlobs
        bacc(i) = bgrs(i) * qdata(i)
      ENDDO
C  DETAIL PRINT OF DATA NOT PASSING THE GROSS CHECK
      IF (msglev .GT. 5) THEN
        WRITE( 6,900 ) 
        DO i = 1 , nlobs
          IF (bacc(i) .EQ. 0) THEN
            WRITE( 6,910 ) i,kx(i),lat(i),lon(i),pr(i),rh(i)
          ENDIF
        ENDDO
      ENDIF
C  PERFORM BUDDY CHECK OF MOISTURE DATA
      CALL budchk(kx,lat,lon,rh,nlobs)
C  MARK REPORTS OF ORIGINALLY SUSPICIOUS QUALITY THAT PASSED THE GROSS
C  CHECK BUT FAILED THE BUDDY CHECK
      DO i = 1 , nlobs
        bchk(i) = (1 - qdata(i)) * bgrs(i) * (1 - bchk(i))
      ENDDO
      bbud(:nlobs) = bbud(:nlobs) + bchk(:nlobs) - bbud(:nlobs) 
     &    * bchk(:nlobs)
C  NEXT LINE DOES LOGICAL   BBUD = BBUD .OR. BCHK    WITH INTEGERS
      IF (sigdat .AND. (msglev .GT. 2)) THEN
        WRITE( 6,920 ) pmand(ll)
        CALL sigrms(kx,pr,mix,mix,1,nlobs)
      ENDIF
      IF (msglev .GT. 2) THEN
        WRITE( 6,920 ) pmand(ll)
        CALL prtrms(kx,mix,bgrs,bacc,qdata,bbud,bchk,nlobs)
      ENDIF
C  SET 'TYPE' ARRAY AND REPORT THE NUMBER OF GOOD OBSERVATIONS.
      npass = 0
      npass = npass + sum(bbud(:nlobs))
      FORALL (i = 1:nlobs) type(i) = bbud(i)
      WRITE( 6,'(1x," No. of observations passing full quality cont",   
     &   "rol:",i8)' ) npass
      RETURN
900   FORMAT ('0CHKMIX: MOISTURE DATA WHICH DID NOT PASS GROSS CHECK'/)
910   FORMAT (1x,I8,4F10.2,' ',E14.7)
920   FORMAT (25X,' Mixing ratio quality control for level',F7.2,'mb.')
      END
