C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    MRAOBINT    READ & CREATE INTEGRATED RAOB SOUNDINGS
C   PRGMMR: M. BARTH         ORG: FSL        DATE: 01-05-03
C
C ABSTRACT: READ ALL RAOB DATA INTO COMMON AND CREATE AN INTEGRATED
C   SOUNDING GIVEN THE CURRENT DATA
C
C PROGRAM HISTORY LOG:
C   00-05-03  M. BARTH    ORIGINAL VERSION
C   01-07-02  M. BARTH    DON'T TRY TO GET QC INFO FOR DATABASES THAT
C                         DON'T HAVE IT.  JUST FILL IN "NO QC" INTO THE
C                         QC STRUCTURES.
C   02-05-30  M. BARTH    - RESTRUCTURED QCDEP TO ONLY GET DATA WE NEED
C                         - RESTRUCTURED TEMPORARY MEMORY ARRAY USAGE
C   05-09-24  L.BENJAMIN  CHANGED THE LOGIC TO HANDLE DIFFERENT NUMBER 
C                         OF LEVELS IN THE DATA FILE THAN IN THE API.  
C                         THE NUMBER OF LEVELS FOR THE DATA FILE IS NOW 
C                         FROM THE DATA FILE.
C   05-12-02  L.BENJAMIN  REMOVED HARDCODED LIST OF VARIABLES.  FOR
C                         BACKWARDS COMPATIBILITY, THE LIST WILL BE 
C                         CREATED BY READING THE FILE'S VARAIBELS.
C   06-01-25  M. BARTH    ADDED STMP ARGUMENT FOR MRDRAOBLEV.
C                         THIS IS NOT USED BY THE API, BUT IS NEEDED
C                         BY THE RAOB.EXE SUBROUTINE THAT ALSO CALLS
C                         MRDRAOBLEV.
C   06-02-13  L. BENJAMIN MOVED LOCAL MEMORY AREA
C   08-06-13  L. BENJAMIN CHANGED MRDNUM TO MRDNUM1..  MOVED QCSTATUS 
C                         TO THIS LEVEL FROM MRDRAOBLEV.  CHANGED 
C                         MRDNUM1 BACK TO MRDNUM
C
C
C USAGE:    CALL MRAOBINT (NCID,FNUM,RECDIM,STARTR,NRECS,NLEVELS,STATUS)
C
C   INPUT ARGUMENT LIST:
C     NCID     - I       ID OF THE OPEN NETCDF QC FILE
C     FNUM     - I       INDEX OF THE FILE IN STRCCOM
C     RECDIM   - I       DIMENSION ID OF THE FILE'S RECORD DIMENSION
C     STARTR   - I       STARTING RECORD TO READ
C     NRECS    - I       NUMBER OF RECORDS TO READ TO CONFORM TO
C                        SETTING "GET STATION" AT MEMORY LEVEL 1
C
C   OUTPUT ARGUMENT LIST:
C     NLEVELS  - IA      NUM LEVELS FOR THE OB RECORDS
C     STATUS   - I       SUCCESS_P OR ERROR CODE
C
C   INPUT FILES:
C     NETCDF FILE OPENED USING DATA STRUCTURES FOR FNUM IN STRCCOM
C
C SUBPROGRAMS CALLED:
C     UNIQUE:  M_ASCSORT, M_CSWAP, M_DSCSORT, M_ISWAP,
C              MREMRAOBLV, MRDNUM, MRDRAOBLEV, M_PHTINT, M_RSWAP
C
C
C REMARKS:
C   - THIS ROUTINE IS ASSUMED TO BE CALLED BY A HIGHER-LEVEL MADIS
C     ROUTINE, SO NO ERROR CHECKING IS DONE ON THE INPUT VARIABLES.
C   - LOCAL ARRAYS ARE DIMENSIONED TO MXDATA_P.  IF THIS NUMBER
C     PROVES TOO LARGE FOR A GIVEN COMPUTER, THEN PORTIONS OF THE
C     MADIS API (E.G., RAOB) THAT RELY ON THIS VOLUME OF DATA
C     BEING HANDLED IN A SINGLE NETCDF CALL MAY NEED TO BE
C     RESTRUCTURED!
C   - IF THE CURRENT DATABASE DOESN'T HAVE QC INFO, THEN THE HYDROSTATIC
C     CORRECTION CANNOT BE APPLIED.
C   - SEE madistmp.f FOR AN EXPLANATION OF HOW TEMPORARY STORAGE
C     IS HANDLED (ALL ARRAYS NAMED *TMP*).
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN-77 + EXTENSIONS
C   MACHINE:  UNIX
C$$$

      SUBROUTINE MRAOBINT (NCID,FNUM,RECDIM,STARTR,NRECS,NLEVELS,STATUS)

C     ------------------------------------------------------------------
C     INCLUDES AND COMMONS
C     ------------------------------------------------------------------
      INCLUDE 'IMPLICIT'
      INCLUDE 'MADISCON'
      INCLUDE 'MADISCOM'
      INCLUDE 'STRCCOM'
      INCLUDE 'MADISTMP'
      INCLUDE 'NETCDFI'

C     ------------------------------------------------------------------
C     LOCAL PARAMETERS USED FOR NEATNESS (SHORTER STRINGS).
C     ------------------------------------------------------------------
      INTEGER       NDSTA
      INTEGER       NDLEV
      INTEGER       NDVAR
      PARAMETER     (NDSTA = MXRAOB_P)
      PARAMETER     (NDLEV = MXRAOBLEV_P)
      PARAMETER     (NDVAR = MXRAOBVAR_P)

C     ------------------------------------------------------------------
C     ARGUMENTS
C     ------------------------------------------------------------------
      INTEGER NCID,FNUM,RECDIM,STARTR,NRECS,STATUS
      INTEGER NLEVELS(*)

C     ------------------------------------------------------------------
C     LOCAL
C     ------------------------------------------------------------------
      INTEGER       I,J,K
      REAL          RTMP(MXDATA_P)
      CHARACTER*1   CTMP(MXDATA_P)
      INTEGER       STMP(NDLEV,NDSTA)
      REAL          ELEV(NDSTA)
      INTEGER       LAST_NLEV(NDSTA)
      CHARACTER*4   LTYPESTR(5)
      LOGICAL       PROC_STA(NDSTA)
      INTEGER       PHTYPE(NDLEV,NDSTA)
      INTEGER       LINDEX(NDLEV,NDSTA)
      LOGICAL       QCINFO

      INTEGER       NCIDI,DIMID
      INTEGER       VDIMS(MAXVDIMS),DIMSIZ,RCODE
      CHARACTER*(MAXNCNAM) DIMNAM
      INTEGER       NX
      INTEGER       STATUSQC
      CHARACTER*1   SUBCTMP(MXDATA_P)
      REAL          SUBRTMP(MXDATA_P)
      INTEGER       SUBITMP(MXDATA_P)

C     ------------------------------------------------------------------
C     TEMPORARY STORAGE DEFINITIONS
C     ------------------------------------------------------------------
      EQUIVALENCE(RTMP,TMP_L3_N1)
      EQUIVALENCE(CTMP,TMP_L3_C1)
      EQUIVALENCE(STMP,TMP_L3_N2)

C     ------------------------------------------------------------------
C     DATA STATEMENTS (KEEP AT BOTTOM OF DECLARATIONS)
C     ------------------------------------------------------------------
      DATA LTYPESTR/'Man','SigT','SigW','MaxW','Trop'/

C     ------------------------------------------------------------------
C     READ THE STATION ELEVATIONS, WHICH ARE NEEDED TO FILL IN SIGW'S
C     SFC HT.
C     ------------------------------------------------------------------
      CALL MRDNUM('staElev',NCID,RECDIM,STARTR,NRECS,MISS_P,ELEV,
     1     STATUS)
      IF(STATUS .NE. SUCCESS_P)GO TO 900

C     ------------------------------------------------------------------
C     INITIALIZE NLEVELS TO 0 AND PROC_STA TO "YES - PROCESS" (.TRUE.).
C     ------------------------------------------------------------------
      DO 1 I = 1, NRECS
         NLEVELS(I) = 0
         PROC_STA(I) = .TRUE.
 1    CONTINUE

C     ------------------------------------------------------------------
C     DETERMINE IF QC INFORMATION IS AVAILABLE IN THE CURRENT DATABASE.
C     ------------------------------------------------------------------
      IF(CDBTYPE.EQ.FSL_DB_P)THEN
         QCINFO = .TRUE.
      ELSE
         QCINFO = .FALSE.
      ENDIF

C     ------------------------------------------------------------------
C     READ IN THE DIFFERENT LEVEL TYPES IN THIS ORDER:
C
C     - MANDATORY (INCLUDES SFC LEVEL)
C     - SIG T
C     - SIG W
C     - MAX WIND
C     - TROPOPAUSE
C
C     ALSO FILL IN THE NUMBER OF LEVELS OF EACH TYPE ARRAY FOR THIS
C     FILE AFTER EACH CALL TO MRDRAOBLEV.  (AND NOTE THAT THE
C     SFC_RAOB_P LEVEL OF RAOB_LT_COUNT IS NEVER FILLED IN -- SFC GOES
C     ALONG WITH MANDATORY FOR RAOB_LT_COUNT PURPOSES.)
C
C     GET THE NUMBER OF LEVELS FROM THE DATA FILE, DO NOT ASSUME THAT 
C     IT WILL MATCH THE API LEVELS.
C     ------------------------------------------------------------------

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

      STATUSQC = -1

      CALL MRDRAOBLEV(LTYPESTR(1),NDLEV,NDSTA,NDVAR,
     1                NCID,RECDIM,STARTR,NRECS,RTMP,CTMP,DIMSIZ,
     2                QCINFO,NLEVELS,RAOB_OB(1,1,1,FNUM),
     3                RAOB_LT(1,1,FNUM),STMP,RAOB_LT_COUNT(1,2,FNUM),
     4                RAOB_QCA(1,1,1,FNUM),RAOB_QCR(1,1,1,FNUM),
     5                RAOB_QCDD(1,1,1,FNUM),RAOB_QCDEP(1,1,1,FNUM),
     6                STATUS,STATUSQC)
C     SET QCSTATUS VALUE
      IF(STATUSQC .EQ. SUCCESS_P)THEN
         QCSTATUS = EQCOK_P               
      ELSE IF(STATUSQC .EQ. FAILURE_P)THEN
         QCSTATUS = EQCFAILED_P
      ENDIF

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

      STATUSQC = -1

      CALL MRDRAOBLEV(LTYPESTR(2),NDLEV,NDSTA,NDVAR,
     1                NCID,RECDIM,STARTR,NRECS,RTMP,CTMP,DIMSIZ,
     2                QCINFO,NLEVELS,RAOB_OB(1,1,1,FNUM),
     3                RAOB_LT(1,1,FNUM),STMP,RAOB_LT_COUNT(1,3,FNUM),
     4                RAOB_QCA(1,1,1,FNUM),RAOB_QCR(1,1,1,FNUM),
     5                RAOB_QCDD(1,1,1,FNUM),RAOB_QCDEP(1,1,1,FNUM),
     6                STATUS,STATUSQC)
C     SET QCSTATUS VALUE
      IF(STATUSQC .EQ. SUCCESS_P)THEN
         QCSTATUS = EQCOK_P               
      ELSE IF(STATUSQC .EQ. FAILURE_P)THEN
         QCSTATUS = EQCFAILED_P
      ENDIF

      IF(STATUS .NE. SUCCESS_P)GO TO 900

C     ------------------------------------------------------------------
C     SAVE THE NUMBER OF LEVELS ALREADY READ IN, THEN GET THE SIGW'S.
C     THE FIRST SIGW LEVEL IS SUPPOSED TO BE THE SFC, AND IF SO, IT'S
C     HT WILL BE MISSING (BUT ACTUALLY SET TO 0, NOT MISS_P).  IF WE
C     ALREADY HAVE THE MANDATORY SFC LEVEL, THIS IS OK AND THE 0 WILL
C     TRIGGER ITS DELETION WHEN DUPLICATES ARE HANDLED.  HOWEVER, IF
C     THE MANDATORY SFC LEVEL DOESN'T EXIST, WE'LL WANT TO KEEP THIS
C     ONE -- IN ORDER TO DO THIS, WE'LL PUT THE STATION ELEVATION IN
C     FOR THE MISSING HT.
C     ------------------------------------------------------------------
      DO 1000 J = 1, NRECS

         LAST_NLEV(J) = NLEVELS(J)

 1000 CONTINUE

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

      STATUSQC = -1

      CALL MRDRAOBLEV(LTYPESTR(3),NDLEV,NDSTA,NDVAR,
     1                NCID,RECDIM,STARTR,NRECS,RTMP,CTMP,DIMSIZ,
     2                QCINFO,NLEVELS,RAOB_OB(1,1,1,FNUM),
     3                RAOB_LT(1,1,FNUM),STMP,RAOB_LT_COUNT(1,4,FNUM),
     4                RAOB_QCA(1,1,1,FNUM),RAOB_QCR(1,1,1,FNUM),
     5                RAOB_QCDD(1,1,1,FNUM),RAOB_QCDEP(1,1,1,FNUM),
     6                STATUS,STATUSQC)
C     SET QCSTATUS VALUE
      IF(STATUSQC .EQ. SUCCESS_P)THEN
         QCSTATUS = EQCOK_P               
      ELSE IF(STATUSQC .EQ. FAILURE_P)THEN
         QCSTATUS = EQCFAILED_P
      ENDIF


      IF(STATUS .NE. SUCCESS_P)GO TO 900

      DO 1001 J = 1, NRECS

         IF(LAST_NLEV(J).EQ.NLEVELS(J))GO TO 1001
         IF(RAOB_OB(LAST_NLEV(J)+1,J,HT_RAOB_P,FNUM).EQ.0.AND.
     1      ELEV(J).NE.MISS_P.AND.RAOB_OB(1,J,P_RAOB_P,FNUM).EQ.MISS_P)
     1      RAOB_OB(LAST_NLEV(J)+1,J,HT_RAOB_P,FNUM) = ELEV(J)

 1001 CONTINUE

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

      STATUSQC = -1

      CALL MRDRAOBLEV(LTYPESTR(4),NDLEV,NDSTA,NDVAR,
     1                NCID,RECDIM,STARTR,NRECS,RTMP,CTMP,DIMSIZ,
     2                QCINFO,NLEVELS,RAOB_OB(1,1,1,FNUM),
     3                RAOB_LT(1,1,FNUM),STMP,RAOB_LT_COUNT(1,5,FNUM),
     4                RAOB_QCA(1,1,1,FNUM),RAOB_QCR(1,1,1,FNUM),
     5                RAOB_QCDD(1,1,1,FNUM),RAOB_QCDEP(1,1,1,FNUM),
     6                STATUS,STATUSQC)
C     SET QCSTATUS VALUE
      IF(STATUSQC .EQ. SUCCESS_P)THEN
         QCSTATUS = EQCOK_P               
      ELSE IF(STATUSQC .EQ. FAILURE_P)THEN
         QCSTATUS = EQCFAILED_P
      ENDIF


      IF(STATUS .NE. SUCCESS_P)GO TO 900

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

      STATUSQC = -1

      CALL MRDRAOBLEV(LTYPESTR(5),NDLEV,NDSTA,NDVAR,
     1                NCID,RECDIM,STARTR,NRECS,RTMP,CTMP,DIMSIZ,
     2                QCINFO,NLEVELS,RAOB_OB(1,1,1,FNUM),
     3                RAOB_LT(1,1,FNUM),STMP,RAOB_LT_COUNT(1,6,FNUM),
     4                RAOB_QCA(1,1,1,FNUM),RAOB_QCR(1,1,1,FNUM),
     5                RAOB_QCDD(1,1,1,FNUM),RAOB_QCDEP(1,1,1,FNUM),
     6                STATUS,STATUSQC)
C     SET QCSTATUS VALUE
      IF(STATUSQC .EQ. SUCCESS_P)THEN
         QCSTATUS = EQCOK_P               
      ELSE IF(STATUSQC .EQ. FAILURE_P)THEN
         QCSTATUS = EQCFAILED_P
      ENDIF


      IF(STATUS .NE. SUCCESS_P)GO TO 900

C     ------------------------------------------------------------------
C     IF NO QC INFO IS AVAILABLE IN THE CURRENT DATABASE, SET THE QC
C     STRUCTURES TO INDICATE THAT.
C     ------------------------------------------------------------------
      IF(.NOT.QCINFO)THEN

         DO 49 I = 1, NDVAR

            DO 50 J = 1, NRECS

               DO 51 K = 1, NLEVELS(J)

                  RAOB_QCA(K,J,I,FNUM) = 0
                  RAOB_QCR(K,J,I,FNUM) = 0
                  RAOB_QCDD(K,J,I,FNUM) = 'Z'

                  RAOB_QCDEP(K,J,I,FNUM) = MISS_P

 52               CONTINUE

 51            CONTINUE

 50         CONTINUE

 49      CONTINUE

      ENDIF

C     ------------------------------------------------------------------
C     IF NEEDED, CORRECT THE HT & T OBS.
C     ------------------------------------------------------------------
      IF(CORTYP.EQ.0.AND.QCINFO)THEN

         DO 100 I = 1, NRECS

            DO 101 J = 1, NLEVELS(I)

               IF(RAOB_QCDEP(J,I,HT_RAOB_P,FNUM).NE.MISS_P)THEN

                  RAOB_OB(J,I,HT_RAOB_P,FNUM) =
     1                 RAOB_OB(J,I,HT_RAOB_P,FNUM) +
     2                 RAOB_QCDEP(J,I,HT_RAOB_P,FNUM)
                  RAOB_QCDD(J,I,HT_RAOB_P,FNUM) = 'W'
               ENDIF

               IF(RAOB_QCDEP(J,I,T_RAOB_P,FNUM).NE.MISS_P)THEN

                  RAOB_OB(J,I,T_RAOB_P,FNUM) =
     1                 RAOB_OB(J,I,T_RAOB_P,FNUM) +
     2                 RAOB_QCDEP(J,I,T_RAOB_P,FNUM)
                  RAOB_QCDD(J,I,T_RAOB_P,FNUM) = 'W'

               ENDIF

 101        CONTINUE

 100     CONTINUE

      ENDIF

C     ------------------------------------------------------------------
C     INTERPOLATE P & HT WHERE MISSING.
C     ------------------------------------------------------------------
      CALL M_PHTINT(NDLEV,NDSTA,NRECS,NLEVELS,PROC_STA,
     1              RAOB_LT(1,1,FNUM),RAOB_OB(1,1,T_RAOB_P,FNUM),
     2              RAOB_OB(1,1,P_RAOB_P,FNUM),
     3              RAOB_OB(1,1,HT_RAOB_P,FNUM),PHTYPE)

C     ------------------------------------------------------------------
C     FOR EACH STATION, DO A DESCENDING SORT ON THE PRESSURE ARRAY, THEN
C     USE THE INDICES RETURNED BY THE SORT ROUTINE TO MOVE THE OTHER
C     DATA ARRAYS AROUND TO MATCH THAT ORDER.  THIS IS DONE SO THAT WE
C     CAN REMOVE USELESS DATA AND MOST DUPLICATES IN THE SAME WAY AS IS
C     DONE IN THE MADIS RAOB QC PROCESSING PROGRAM.  WHILE WE'RE AT IT,
C     REPLACE THE QCDESC VALUES FOR P OR HT WHERE THE VALUE IS
C     INTERPOLATED WITH AN "I" DESCRIPTOR VALUE, AND IF QC INFO IS
C     AVAILABLE, A QCA VALUE OF 3 (VALIDITY CHECK & MASTER CHECK).
C     ALSO CONVERT THE PRESSURES AND THEIR DEPARTURE VALUES FROM
C     MILLIBARS TO PASCALS.  THEN DO AN ASCENDING SORT BY HEIGHT (THE
C     WAY WE WANT TO USE IT IN THE API).  FINALLY, PUT NLEVELS INTO
C     THE VERSION STORED IN COMMON.
C     ------------------------------------------------------------------
      DO 2 I = 1, NRECS

         IF(NLEVELS(I).GT.0)THEN

            CALL M_DSCSORT(RAOB_OB(1,I,P_RAOB_P,FNUM),LINDEX(1,I),
     1                     NLEVELS(I))
            CALL M_ISWAP(NLEVELS(I),LINDEX(1,I),RAOB_LT(1,I,FNUM),
     1           SUBITMP)
            CALL M_ISWAP(NLEVELS(I),LINDEX(1,I),PHTYPE(1,I),SUBITMP)

            DO 4 J = 1, 6

               IF(J.NE.P_RAOB_P)CALL M_RSWAP(NLEVELS(I),LINDEX(1,I),
     1              RAOB_OB(1,I,J,FNUM),SUBRTMP)
               CALL M_RSWAP(NLEVELS(I),LINDEX(1,I),RAOB_QCA(1,I,J,FNUM),
     1              SUBRTMP)
               CALL M_RSWAP(NLEVELS(I),LINDEX(1,I),RAOB_QCR(1,I,J,FNUM),
     1              SUBRTMP)
               CALL M_CSWAP(NLEVELS(I),LINDEX(1,I),
     1                      RAOB_QCDD(1,I,J,FNUM),SUBCTMP)
               CALL M_RSWAP(NLEVELS(I),LINDEX(1,I),
     1                      RAOB_QCDEP(1,I,J,FNUM),SUBRTMP)

 4          CONTINUE

            CALL MREMRAOBLV(I,FNUM,NLEVELS(I),LINDEX(1,I),
     1                      RAOB_LT(1,I,FNUM),PHTYPE(1,I),
     2                      RAOB_OB(1,I,1,FNUM),RAOB_OB(1,I,2,FNUM),
     3                      RAOB_OB(1,I,3,FNUM),RAOB_OB(1,I,4,FNUM),
     4                      RAOB_OB(1,I,5,FNUM),RAOB_OB(1,I,6,FNUM))
            IF(NLEVELS(I).EQ.0)GO TO 22

            DO 23 J = 1, NLEVELS(I)

               IF(PHTYPE(J,I).EQ.1)THEN

                  RAOB_QCDD(J,I,P_RAOB_P,FNUM) = 'I'
                  IF(QCINFO)RAOB_QCA(J,I,P_RAOB_P,FNUM) = 3

               ELSE IF(PHTYPE(J,I).EQ.2)THEN

                  RAOB_QCDD(J,I,HT_RAOB_P,FNUM) = 'I'
                  IF(QCINFO)RAOB_QCA(J,I,HT_RAOB_P,FNUM) = 3

               ENDIF

               IF(RAOB_OB(J,I,P_RAOB_P,FNUM).NE.MISS_P)THEN

                  RAOB_OB(J,I,P_RAOB_P,FNUM) =
     1                 RAOB_OB(J,I,P_RAOB_P,FNUM) * 100

                  IF(RAOB_QCDEP(J,I,P_RAOB_P,FNUM).NE.MISS_P)
     1                    RAOB_QCDEP(J,I,P_RAOB_P,FNUM) =
     2                       RAOB_QCDEP(J,I,P_RAOB_P,FNUM) * 100

               ENDIF

 23         CONTINUE

            CALL M_ASCSORT(RAOB_OB(1,I,HT_RAOB_P,FNUM),LINDEX(1,I),
     1                     NLEVELS(I))
            CALL M_ISWAP(NLEVELS(I),LINDEX(1,I),RAOB_LT(1,I,FNUM),
     1           SUBITMP)

            DO 44 J = 1, 6

               IF(J.NE.HT_RAOB_P)CALL M_RSWAP(NLEVELS(I),LINDEX(1,I),
     1              RAOB_OB(1,I,J,FNUM),SUBRTMP)
               CALL M_RSWAP(NLEVELS(I),LINDEX(1,I),RAOB_QCA(1,I,J,FNUM),
     1              SUBRTMP)
               CALL M_RSWAP(NLEVELS(I),LINDEX(1,I),RAOB_QCR(1,I,J,FNUM),
     1              SUBRTMP)
               CALL M_CSWAP(NLEVELS(I),LINDEX(1,I),
     1              RAOB_QCDD(1,I,J,FNUM),SUBCTMP)
               CALL M_RSWAP(NLEVELS(I),LINDEX(1,I),
     1              RAOB_QCDEP(1,I,J,FNUM),SUBRTMP)

 44         CONTINUE

         ENDIF

 22      RAOB_NLEVELS(I,FNUM) = NLEVELS(I)

 2    CONTINUE

C     ------------------------------------------------------------------
C     RETURN.
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**---------------------------------------------------------------------
