C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    MRDRAOBLEV   READ RAOB OBS FOR 1 LEVEL TYPE
C   PRGMMR: M. BARTH         ORG: FSL        DATE: 09-12-05
C
C ABSTRACT: INPUT DATA TO BE QC'ED FOR A SINGLE LEVEL TYPE (E.G.,
C   MANDATORY) FROM A SINGLE RAOB NETCDF FILE.
C
C PROGRAM HISTORY LOG:
C   01-05-04  M. BARTH    ORIGINAL VERSION
C   01-07-13  M. BARTH    CHANGED CONCATENATION OF STRING VARIABLES
C                         TO CONFORM WITH G77 COMPILER
C   02-05-30  M. BARTH    ONLY DEAL WITH THE MASTER_P QC CHECK
C                         VALUES IN THE QCDEP ARRAYS
C   04-10-16  L. BENJAMIN ADDED NO SUCH VARIABLE CHECK FOR QCA CHECKS
C   05-09-12  L. BENJAMIN RESTRICTED LEVELS TO EXPECTED MAXIMUMS
C   05-12-02  L. BENJAMIN FOR BACKWARDS COMPATIBILITY, CHECK FOR 
C                         VARIABLES IN NECTDF FILE, INSTEAD OF 
C                         A HARDCODED LIST.  DO NOT REPORT MISSING 
C                         VARIABLES.
C   06-01-24  M. BARTH    SIGW LEVELS ARE NOW STORED IN TWO SETS
C                         OF VARIABLES.  WE'LL COMBINE THEM INTO
C                         ONE SET, BUT INDICATE WHICH IS WHICH BY
C                         USING THE NEW SIGWTYPE ARRAY.
C   08-06-13  L. BENJAMIN MOVED QCSTATUS SETTING UP ONE LEVEL.
C                         THE QCSTATUS CODED VALUE IN RETURNED BY 
C                         STATUSQC.  THE CODES ARE:
C                           -1        = NOT USED
C                           SUCCESS_P = EQCOK_P               
C                           FAILURE_P = STATUSQC  
C                         CHANGED MRDNUM CALL TO MRDNUM1.  CHANGED 
C                         "MADISCON" INCLUDE TO "INTQC1CON2".
C                         CHANGED "MADISCOM" INCLUDE TO "INTQC1COM1".
C                         ADDED "RAOBCON" INCLUDE.  CHANGED MRDNUM1
C                         BACK TO MRDNUM  

C
C USAGE:    CALL MRDRAOBLEV (TSTR,NDLEV,NDSTA,NDVAR,NCID,RECDIM,STARTR,
C                            NRECS,SCRATCH,CSCRATCH,TDIM,QCINFO,NLEVELS,
C                            O,LTYPE,SIGWTYPE,LEVELS,QCAPP,QCRES,QCDESC,
C                            QCDEP,STATUS)
C
C   INPUT ARGUMENT LIST:
C     TSTR     - C       SUFFIX TO USE FOR NETCDF VARS FOR THIS TYPE
C     NDLEV    - I       SIZE TO USE FOR LEVEL DIMENSION IN ARRAYS
C     NDSTA    - I       SIZE TO USE FOR STATION DIMENSION IN ARRAYS
C     NDVAR    - I       SIZE TO USE FOR VARIABLE DIMENSION IN ARRAYS
C     NCID     - I       ID OF THE OPEN NETCDF FILE
C     RECDIM   - I       NETCDF RECORD DIMENSION
C     STARTR   - I       STARTING RECORD TO READ
C     NRECS    - I       NUMBER OF RECORDS TO READ
C     SCRATCH  - RA      TEMPORARY NUMERIC ARRAY
C     CSCRATCH - CA      TEMPORARY CHARACTER ARRAY
C     TDIM     - I       LEVELS DIMENSION TO USE FOR TEMPORARY ARRAYS
C     QCINFO   - L       .TRUE. --> READ QC INFO, .FALSE. --> DON'T
C
C   INPUT/OUTPUT ARGUMENT LIST:
C     NLEVELS  - IA      ACCUMULATED NUMBER OF LEVELS
C
C   OUTPUT ARGUMENT LIST:
C     O        - RA      OBS
C     LTYPE    - IA      LEVEL TYPES (E.G., MANDATORY, SIGT)
C     SIGWTYPE - IA      SIGW TYPE (0 = NOT SIGW, OR SIGW-BY-HT,
C                                   1 = SIGW-BY-P)
C     LEVELS   - RA      NUMBER OF LEVELS FOR TYPE JUST READ IN
C     QCAPP    - RA      QC APPLIED WORDS FOR THE OB RECORDS
C     QCRES    - RA      QC RESULTS WORDS FOR THE OB RECORDS
C     QCDESC   - CA      QC DATA DESCRIPTORS FOR THE OB RECORDS
C     QCDEP    - RA      QC DEPARTURE VALUES FOR THE OB RECORDS
C     STATUS   - I       SUCCESS_P OR FAILURE_P IF INPUT FILE PROBLEM
C
C   INPUT FILES:
C     NETCDF FILE OPEN ON NCID
C
C SUBPROGRAMS CALLED:
C     UNIQUE:  M_CTRN2DIM, MRDCHR, MRDDEP, MRDNUM, M_RTRN2DIM
C     NETCDF:  NCDID, NCDINQ
C
C REMARKS:
C   NONE
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN-77 + EXTENSIONS
C   MACHINE:  UNIX
C$$$


      SUBROUTINE MRDRAOBLEV (TSTR,NDLEV,NDSTA,NDVAR,NCID,RECDIM,
     1                       STARTR,NRECS,SCRATCH,CSCRATCH,TDIM,QCINFO,
     2                       NLEVELS,O,LTYPE,SIGWTYPE,LEVELS,QCAPP,
     3                       QCRES,QCDESC,QCDEP,STATUS,STATUSQC)



C     ------------------------------------------------------------------
C     INCLUDES AND COMMONS
C     ------------------------------------------------------------------
      INCLUDE 'IMPLICIT'
      INCLUDE 'INTQC1CON2'
      INCLUDE 'RAOBCON'
      INCLUDE 'INTQC1COM1'
      INCLUDE 'NETCDFI'

C     ------------------------------------------------------------------
C     ARGUMENTS
C     ------------------------------------------------------------------
      CHARACTER*(*) TSTR
      INTEGER       NDLEV
      INTEGER       NDSTA
      INTEGER       NDVAR
      INTEGER       NCID
      INTEGER       RECDIM
      INTEGER       STARTR
      INTEGER       NRECS
      INTEGER       TDIM
      LOGICAL       QCINFO
      REAL          SCRATCH(*)
      CHARACTER*(*) CSCRATCH(*)
      INTEGER       NLEVELS(NDSTA)
      REAL          O(NDLEV,NDSTA,NDVAR)
      INTEGER       LTYPE(NDLEV,NDSTA)
      INTEGER       SIGWTYPE(NDLEV,NDSTA)
      REAL          LEVELS(NDSTA)
      REAL          QCAPP(NDLEV,NDSTA,NDVAR)
      REAL          QCRES(NDLEV,NDSTA,NDVAR)
      CHARACTER*1   QCDESC(NDLEV,NDSTA,NDVAR)
      REAL          QCDEP(NDLEV,NDSTA,NDVAR)
      INTEGER       STATUS
      INTEGER       MAXLEVELS
      INTEGER       STATUSQC

C     ------------------------------------------------------------------
C     LOCAL
C     ------------------------------------------------------------------
      INTEGER       MXTMP
      PARAMETER (MXTMP = MXRAOB_P * MXRAOBLEV_P)
      INTEGER       I,J,K,L,TYPE,IVAR,RCODE,PASS,NPASS,DIMID
      INTEGER       PASS1LEV(MXTMP)
      CHARACTER*2   VSTR(6)
      CHARACTER*8   NUMSTR
      CHARACTER*6   SFSTR
      LOGICAL       VAREXISTS(6)
      CHARACTER*(MAXNCNAM) DIMNAM
      INTEGER       CNT

      REAL RDATA(MXTMP)
      INTEGER IDATA(MXTMP)
      INTEGER*2 I2DATA(MXTMP)
      BYTE BDATA(MXTMP)
      INTEGER N
      EQUIVALENCE(RDATA,IDATA,I2DATA,BDATA)
      
C     ------------------------------------------------------------------
C     DATA STATEMENTS (KEEP AT BOTTOM OF DECLARATIONS)
C     ------------------------------------------------------------------
      DATA VSTR/'pr','ht','tp','td','wd','ws'/


C     *****************************************************************
C     ******************* BEGIN OF MRDRAOBLEV *************************
C     *****************************************************************

C     ------------------------------------------------------------------
C     SET THE VALUES TO BE USED THAT ARE BASED ON LEVEL TYPE.
C     ------------------------------------------------------------------
      MAXLEVELS = 0
      NPASS = 1
      PASS = 1
      STATUSQC = -1

      IF(TSTR.EQ.'Man')THEN
         NUMSTR = 'Mand'
         SFSTR = 'Man'
         K = 3
         MAXLEVELS = MXRAOBMAN_P
      ELSE IF(TSTR.EQ.'SigT')THEN
         NUMSTR = 'SigT'
         SFSTR = 'SigT'
         K = 4
         MAXLEVELS = MXRAOBSIGT_P
      ELSE IF(TSTR.EQ.'SigW')THEN
         NUMSTR = 'SigW'
         SFSTR = 'SigW'
         K = 4
         MAXLEVELS = MXRAOBSIGWHT_P
         NPASS = 2
         PASS = 1
      ELSE IF(TSTR.EQ.'MaxW')THEN
         NUMSTR = 'Mwnd'
         SFSTR = 'MaxW'
         K = 4
         MAXLEVELS = MXRAOBMXWND_P
      ELSE IF(TSTR.EQ.'Trop')THEN
         NUMSTR = 'Trop'
         SFSTR = 'Trop'
         K = 4
         MAXLEVELS = MXRAOBTROP_P
      ENDIF

C     ------------------------------------------------------------------
C     WE NEED TO DO A BUNCH OF KLUGY STUFF FOR PASS 2 OF THE SIGW
C     PROCESSING.  SOME OF THIS WILL BE DONE HERE, SOME BELOW...
C     WHAT WE NEED TO DO HERE IS GET THE DIMENSION OF THE ARRAYS FOR
C     THE SIGW-BY-P IN THE DATA FILES AND PUT THAT INTO TDIM.  OUR
C     CALLER HAS SENT IN THE SIGW-BY-HT DIMENSION IN TDIM.  NOTE THAT
C     IF THAT DIMENSION DOESN'T EXIST, IT'S NOT A PROBLEM -- JUST MEANS
C     THAT WE'RE READING AN AWIPS FILE OR AN FSL FILE FROM BEFORE
C     THE SIGW-BY-P DATA WERE ADDED.
C     ------------------------------------------------------------------
 100  IF(NPASS.EQ.2.AND.PASS.EQ.2)THEN

         NUMSTR = 'SigPresW'
         MAXLEVELS = MXRAOBSIGWP_P

         DIMID = NCDID(NCID,'sigPresWLevel',RCODE)
         IF(RCODE.NE.SUCCESS_P)GO TO 900
         CALL NCDINQ(NCID,DIMID,DIMNAM,TDIM,STATUS)
         IF(STATUS.NE.SUCCESS_P)THEN
            WRITE(*,*)'          - NCDINQ ERROR sigPresWLevel: ',STATUS
            GO TO 900
         ENDIF

      ENDIF

C     ------------------------------------------------------------------
C     READ THE NUMBER OF LEVELS FOR THIS LEVEL TYPE.
C     ------------------------------------------------------------------
      CALL MRDNUM1('num'//NUMSTR,NCID,RECDIM,STARTR,NRECS,MISS_P,LEVELS,
     1     MXTMP,RDATA,IDATA,I2DATA,BDATA,CNT,STATUS)
      IF(STATUS .NE. SUCCESS_P)GO TO 900

C     ------------------------------------------------------------------
C     RESTRICT THE LEVELS AVAILABLE TO EXPECTED MAXIMUMS.  THIS ALLOWS
C     US TO ADD LEVELS TO THE FILES WHEN THE INPUT RAOB DATA FORMAT
C     CHANGES WITHOUT HAVING TO FORCE USERS TO SWITCH TO THE NEW API
C     VERSION.
C     ------------------------------------------------------------------
      DO I = 1,NRECS
         IF(LEVELS(I).GT.MAXLEVELS)LEVELS(I)=MAXLEVELS
      ENDDO

C     ------------------------------------------------------------------
C     READ THE REQUESTED VARIABLES FOR THIS LEVEL TYPE AND TRANSFER THEM
C     TO THE CALLER'S ARRAY.  IF THE QCINFO OPTION'S BEEN SELECTED, GET
C     THAT DATA AS WELL.
C     ------------------------------------------------------------------
      DO 1 IVAR = 1, 6

C     ------------------------------------------------------------------
C     NEXT SIGW-BY-P KLUGE:  THE PRESSURE VARIABLE USES THE SUFFIX
C     FOR THE SIGW-BY-HT SET (SHEESH!).  WE HANDLE THIS BY *NOT*
C     RESETTING SFSTR AND K UNTIL *AFTER* WE'VE READ THE PRESSURE
C     VARIABLE ON THE SECOND PASS.
C     ------------------------------------------------------------------
         IF(PASS.EQ.2.AND.IVAR.EQ.2)THEN
            SFSTR = 'SigPrW'
            K = 6
         ENDIF

C     ------------------------------------------------------------------
C     A FOLLOW-UP TO THE "SHEESH" CLAUSE IN THE PREVIOUS COMMENT IS
C     THAT IN PASS 1 (SIGW-BY-HT) WE DO *NOT* WANT TO TRY TO READ THE
C     PRESSURE VARIABLE, SINCE THE LEVELS DIMENSION WOULDN'T BE RIGHT.
C     WE'LL HANDLE THIS BY FORCING VAREXISTS(1) TO FALSE.
C     ------------------------------------------------------------------
         VAREXISTS(IVAR) = .FALSE.

         IF(.NOT.(IVAR.EQ.1.AND.NPASS.EQ.2.AND.PASS.EQ.1))THEN

            L = NCVID(NCID,VSTR(IVAR)//SFSTR(1:K),RCODE)
            IF(RCODE.EQ.0)THEN
               VAREXISTS(IVAR) = .TRUE.
            ENDIF

         ENDIF

         IF(VAREXISTS(IVAR))THEN

            CALL MRDNUM1(VSTR(IVAR)//SFSTR(1:K),NCID,RECDIM,STARTR,NRECS
     1           ,MISS_P,SCRATCH,MXTMP,RDATA,IDATA,I2DATA,BDATA,CNT,
     2           STATUS)

            IF(STATUS .NE. SUCCESS_P)GO TO 900
            CALL M_RTRN2DIM(NDLEV,NDSTA,NRECS,TDIM,SCRATCH,LEVELS,
     1                      NLEVELS,O(1,1,IVAR))

            IF(QCINFO)THEN

C     ASSUME QC OK, SET FOR DIFFERNET CONDITIONS
               STATUSQC = SUCCESS_P

               CALL MRDNUM1(VSTR(IVAR)//SFSTR(1:K)//'QCA',NCID,RECDIM,
     1                     STARTR,NRECS,MISS_P,SCRATCH,MXTMP,RDATA,
     2              IDATA,I2DATA,BDATA,CNT,STATUS)
               IF(STATUS.EQ.VAR_NOTINDB_P)THEN
                  STATUSQC = FAILURE_P
                  STATUS = SUCCESS_P

                  DO 22 J = 1, NRECS
                     
                     IF(LEVELS(J).NE.MISS_P)THEN
                        DO 17 I = 1, INT(LEVELS(J))

                           QCAPP(I+NLEVELS(J),J,IVAR) = 0
                           QCRES(I+NLEVELS(J),J,IVAR) = 0
                           QCDESC(I+NLEVELS(J),J,IVAR) = 'Z'
                     
                           QCDEP(I+NLEVELS(J),J,IVAR) = MISS_P

 17                     CONTINUE
                     ENDIF
 22               CONTINUE
               ELSE IF(STATUS .NE. SUCCESS_P)THEN
                  GO TO 900
               ELSE
                  CALL M_RTRN2DIM(NDLEV,NDSTA,NRECS,TDIM,SCRATCH,LEVELS,
     1                         NLEVELS,QCAPP(1,1,IVAR))

                  CALL MRDNUM1(VSTR(IVAR)//SFSTR(1:K)//'QCR',NCID,RECDIM
     1                 ,STARTR,NRECS,MISS_P,SCRATCH,MXTMP,RDATA,
     2                 IDATA,I2DATA,BDATA,CNT,STATUS)
                  IF(STATUS .NE. SUCCESS_P)GO TO 900
                  CALL M_RTRN2DIM(NDLEV,NDSTA,NRECS,TDIM,SCRATCH,LEVELS,
     1                         NLEVELS,QCRES(1,1,IVAR))

                  CALL MRDDEP(VSTR(IVAR)//SFSTR(1:K)//'QCD',NCID,RECDIM,
     1                     STARTR,NRECS,MISS_P,MASTER_P,SCRATCH,STATUS,
     1                MXTMP+MXRAOBLEV_P)

                  IF(STATUS .NE. SUCCESS_P)GO TO 900
                  CALL M_RTRN2DIM(NDLEV,NDSTA,NRECS,TDIM,SCRATCH,LEVELS,
     1                         NLEVELS,QCDEP(1,1,IVAR))

                  CALL MRDCHR(VSTR(IVAR)//SFSTR(1:K)//'DD',NCID,RECDIM,
     1                     STARTR,NRECS,CSCRATCH,J,STATUS)
                  IF(STATUS .NE. SUCCESS_P)GO TO 900
                  CALL M_CTRN2DIM(NDLEV,NDSTA,NRECS,TDIM,CSCRATCH,
     1                 LEVELS,NLEVELS,QCDESC(1,1,IVAR))

               ENDIF
            ENDIF

         ENDIF

 1    CONTINUE

C     ------------------------------------------------------------------
C     UPDATE NLEVELS, FILL IN LTYPE, FILL IN MISSING FLAGS FOR VARIABLES
C     THAT DON'T EXIST FOR THIS LEVEL TYPE.
C     ------------------------------------------------------------------
      IF(TSTR.EQ.'Man')THEN
         TYPE = 0
      ELSE IF(TSTR.EQ.'SigT')THEN
         TYPE = 3
      ELSE IF(TSTR.EQ.'SigW')THEN
         TYPE = 4
      ELSE IF(TSTR.EQ.'MaxW')THEN
         TYPE = 5
      ELSE IF(TSTR.EQ.'Trop')THEN
         TYPE = 6
      ENDIF

      DO 2 J = 1, NRECS

         IF(LEVELS(J).NE.MISS_P)THEN

            IF(TYPE.EQ.0)THEN

               DO 3 I = 1, INT(LEVELS(J))

                  IF(I.EQ.1)THEN
                     LTYPE(I+NLEVELS(J),J) = SFC_RAOB_P
                  ELSE
                     LTYPE(I+NLEVELS(J),J) = MAN_RAOB_P
                  ENDIF

 3             CONTINUE

            ELSE

               DO 4 I = 1, INT(LEVELS(J))

                  LTYPE(I+NLEVELS(J),J) = TYPE
 4             CONTINUE

               IF(NPASS.EQ.2)THEN

C     ------------------------------------------------------------------
C     IF SIGW, FILL IN THE SIGW TYPE.
C     ------------------------------------------------------------------
                  IF(PASS.EQ.1)THEN
                     L = 0
                  ELSE
                     L = 1
                  ENDIF

                  DO I = 1, INT(LEVELS(J))

                     SIGWTYPE(I+NLEVELS(J),J) = L

                  ENDDO

               ENDIF

            ENDIF

            DO 5 IVAR = 1, 6

               IF(.NOT. VAREXISTS(IVAR))THEN

                  DO 6 I = 1, INT(LEVELS(J))

                     O(I+NLEVELS(J),J,IVAR) = MISS_P

 6                CONTINUE

                  IF(QCINFO)THEN

                     DO 7 I = 1, INT(LEVELS(J))

                        QCAPP(I+NLEVELS(J),J,IVAR) = 0
                        QCRES(I+NLEVELS(J),J,IVAR) = 0
                        QCDESC(I+NLEVELS(J),J,IVAR) = 'Z'

                        QCDEP(I+NLEVELS(J),J,IVAR) = MISS_P

 7                   CONTINUE

                  ENDIF

               ENDIF

 5          CONTINUE

            NLEVELS(J) = NLEVELS(J) + LEVELS(J)

         ENDIF

 2    CONTINUE

C     ------------------------------------------------------------------
C     IF THIS IS THE FIRST PASS OF THE SIGW PROCESSING:  SAVE THE
C     LEVELS ARRAY AND GO TO THE SECOND PASS.
C     ------------------------------------------------------------------
      IF(NPASS.EQ.2.AND.PASS.EQ.1)THEN

         DO J = 1, NRECS

            PASS1LEV(J) = LEVELS(J)

         ENDDO
         
         PASS = 2
         GO TO 100

C     ------------------------------------------------------------------
C     IF THIS IS THE SECOND PASS OF THE SIGW PROCESSING:  ADD IN THE
C     PASS 1 LEVELS TO THE PASS 2 LEVELS.
C     ------------------------------------------------------------------
      ELSE IF(NPASS.EQ.2.AND.PASS.EQ.2)THEN

         DO J = 1, NRECS

            IF(PASS1LEV(J).NE.MISS_P)THEN

               IF(LEVELS(J).NE.MISS_P)THEN

                  LEVELS(J) = LEVELS(J) + PASS1LEV(J)

               ELSE

                  LEVELS(J) = PASS1LEV(J)

               ENDIF

            ENDIF

         ENDDO

      ENDIF

C     ------------------------------------------------------------------
C     THAT'S ALL FOLKS...
C     ------------------------------------------------------------------
 900  RETURN
      END
C**---------------------------------------------------------------------
C**REQUIRED STANDARD FSL DISCLAIMER (NOVEMBER 2000)
C**---------------------------------------------------------------------
C**  OPEN SOURCE LICENSE/DISCLAIMER,  FORECAST SYSTEMS LABORATORY
C**  NOAA/OAR/FSL, 325 BROADWAY BOULDER, CO 80305
C**
C**  THIS SOFTWARE IS DISTRIBUTED UNDER THE OPEN SOURCE DEFINITION, 
C**  WHICH MAY BE FOUND AT http://www.opensource.org/osd.html.
C**
C**  IN PARTICULAR, REDISTRIBUTION AND USE IN SOURCE AND BINARY FORMS,
C**  WITH OR WITHOUT MODIFICATION, ARE PERMITTED PROVIDED THAT THE 
C**  FOLLOWING CONDITIONS ARE MET:
C**
C**  - REDISTRIBUTIONS OF SOURCE CODE MUST RETAIN THIS NOTICE, THIS LIST
C**    OF CONDITIONS AND THE FOLLOWING DISCLAIMER.
C**
C**  - REDISTRIBUTIONS IN BINARY FORM MUST PROVIDE ACCESS TO THIS 
C**    NOTICE, THIS LIST OF CONDITIONS AND THE FOLLOWING DISCLAIMER, AND
C**    THE UNDERLYING SOURCE CODE.
C**
C**  - ALL MODIFICATIONS TO THIS SOFTWARE MUST BE CLEARLY DOCUMENTED, 
C**    AND ARE SOLELY THE RESPONSIBILITY OF THE AGENT MAKING THE 
C**    MODIFICATIONS.
C**
C**  - IF SIGNIFICANT MODIFICATIONS OR ENHANCEMENTS ARE MADE TO THIS
C**    SOFTWARE, THE FSL SOFTWARE POLICY MANAGER 
C**    (softwaremgr.fsl@noaa.gov) BE NOTIFIED.
C**
C**  THIS SOFTWARE AND ITS DOCUMENTATION ARE IN THE PUBLIC DOMAIN AND 
C**  ARE FURNISHED "AS IS."  THE AUTHORS, THE UNITED STATES GOVERNMENT,
C**  ITS INSTRUMENTALITIES, OFFICERS, EMPLOYEES, AND AGENTS MAKE NO 
C**  WARRANTY, EXPRESS OR IMPLIED, AS TO THE USEFULNESS OF THE SOFTWARE
C**  AND DOCUMENTATION FOR ANY PURPOSE.  THEY ASSUME NO RESPONSIBILITY 
C**  (1) FOR THE USE OF THE SOFTWARE AND DOCUMENTATION; OR (2) TO 
C**  PROVIDE TECHNICAL SUPPORT TO USERS.
C**---------------------------------------------------------------------
