C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    MNPNEXT     EXTRACT DESIRED LEVELS FOR NPN PROFILES
C   PRGMMR: M. BARTH         ORG: FSL        DATE: 00-03-31
C
C ABSTRACT: EXTRACT THE DESIRED LEVEL TYPES FOR NPN PROFILES
C
C PROGRAM HISTORY LOG:
C   00-03-31  M. BARTH    ORIGINAL VERSION
C   01-07-11  M. BARTH    CHANGES FOR AWIPS DATABASE
C
C USAGE:    CALL MNPNEXT (VCN,SPT,NRECS,NLEVS,OB,QCDESC,QCAPP,QCRES,
C                         NLEVELS)
C
C   INPUT ARGUMENT LIST:
C     VCN      - I       VARIABLE CODE NUMBER
C     SPT      - I       PROFILE TYPE CODE NUMBER
C     NRECS    - I       NUMBER OF RECORDS (STATIONS)
C     NLEVS    - I       NUMBER OF LEVELS IN DESIRED PROFILE TYPE
C
C   INPUT/OUTPUT ARGUMENT LIST:
C     OB       - RA      OBS
C     QCDESC   - CA      QC DATA DESCRIPTORS
C     QCAPP    - RA      QC APPLIED WORD
C     QCRES    - RA      QC RESULTS WORD
C
C   OUTPUT ARGUMENT LIST:
C     NLEVELS  - IA      ACTUAL NUMBER OF LEVELS IN DESIRED PROFILE
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
C ATTRIBUTES:
C   LANGUAGE: FORTRAN-77 + EXTENSIONS
C   MACHINE:  UNIX
C$$$

      SUBROUTINE MNPNEXT (VCN,SPT,NRECS,NLEVS,OB,QCDESC,QCAPP,QCRES,
     1                    NLEVELS)

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

C     ------------------------------------------------------------------
C     ARGUMENTS
C     ------------------------------------------------------------------
      INTEGER VCN,SPT,NRECS,NLEVS
      REAL OB(*),QCAPP(*),QCRES(*)
      CHARACTER*1 QCDESC(*)
      INTEGER NLEVELS(*)

C     ------------------------------------------------------------------
C     LOCAL
C     ------------------------------------------------------------------
      INTEGER I,J,NIN,NOUT,BOT,TOP,MAXLEV

C     ------------------------------------------------------------------
C     WE HAVE TO DO THIS IN PLACE BY KEEPING ONLY THE DESIRED LEVELS,
C     AND CHANGE THE ACTUAL 2-D ARRAY FROM (MXLEV,NRECS) TO
C     (NLEVS,NRECS).
C     ------------------------------------------------------------------

C     ------------------------------------------------------------------
C     SET THE MAXLEV DIMENSION OF WHAT'S IN THE VARIABLE AS READ IN
C     BASED ON THE DATABASE IN USE.
C     ------------------------------------------------------------------
      IF(CDBTYPE.EQ.FSL_DB_P)THEN
         MAXLEV = MXNPNLEV_P
      ELSE IF(CDBTYPE.EQ.AWIPS_DB_P)THEN
         MAXLEV = MXANPNLEV_P
      ENDIF

C     ------------------------------------------------------------------
C     IF WE'RE RETURNING ONE WHOLE MODE, THIS IS RATHER SIMPLE.  JUST
C     SET THE BOTTOM AND TOP OF WHAT'S TO BE RETURNED (1-36 OR 37-72).
C     ------------------------------------------------------------------
      IF(NLEVS.EQ.36)THEN

         IF(SPT.EQ.-2)THEN

            BOT = 1
            TOP = 36

         ELSE

            BOT = 37
            TOP = 72

         ENDIF

      ENDIF

C     ------------------------------------------------------------------
C     THE AWIPS DATABASE INTEGRATED PROFILE IS JUST AS SIMPLE.  IT'S
C     ALREADY INTEGRATED IN THE DATABASE, SO WE JUST RETURN THE WHOLE
C     ENCHILADA WITHOUT ANY FUSS.
C     ------------------------------------------------------------------
      IF(NLEVS.EQ.MXANPNLEV_P)THEN
         BOT = 1
         TOP = 43
      ENDIF

      DO 1 J = 1, NRECS

         NLEVELS(J) = NLEVS

         NOUT = (J - 1) * NLEVS
         NIN = (J - 1) * MAXLEV

C     ------------------------------------------------------------------
C     JUST TO KEEP THINGS STRAIGHT FOR THE RECORD, NLEVS=36 MEANS THIS
C     IS EITHER THE FSL DATABASE LOW MODE OR HIGH MODE, OR THE AWIPS
C     DATABASE LOW MODE.
C     ------------------------------------------------------------------
         IF(NLEVS.EQ.36.OR.NLEVS.EQ.MXANPNLEV_P)THEN

            IF(BOT.EQ.37)NIN = NIN + 36

            DO 2 I = BOT, TOP

               NIN = NIN + 1
               NOUT = NOUT + 1

C     ------------------------------------------------------------------
C     IN THE AWIPS DATABASE, LEVELS 28-36 MAY BE LOW OR HIGH MODE (USING
C     THE SAME LOGIC WE USE BELOW FOR THE FSL NLEVS=64 CASE).  THEREFORE
C     IF WE'RE HERE TO GET THE LOW MODE WE'LL FILL IN MISSING FLAGS FOR
C     LOW MODE LEVELS IN THE OVERLAP REGION THAT ARE ACTUALLY TAKEN UP
C     BY HIGH MODE VALUES.
C     ------------------------------------------------------------------
               IF(NLEVS.EQ.MXANPNLEV_P.OR.
     1            (.NOT.(CDBTYPE.EQ.AWIPS_DB_P.AND.I.GE.28)).OR.
     1            (CDBTYPE.EQ.AWIPS_DB_P.AND.I.GE.28.AND.
     2             NPN_LT(I,J).EQ.1))THEN

                  OB(NOUT) = OB(NIN)
                  QCAPP(NOUT) = QCAPP(NIN)
                  QCRES(NOUT) = QCRES(NIN)
                  QCDESC(NOUT) = QCDESC(NIN)

               ELSE

                  OB(NOUT) = MISS_P
                  QCAPP(NOUT) = 0
                  QCRES(NOUT) = 0
                  QCDESC(NOUT) = 'Z'

               ENDIF

 2          CONTINUE

         ELSE IF(NLEVS.EQ.64)THEN

C     ------------------------------------------------------------------
C     THIS IS THE INTEGRATED PROFILE FOR THE FSL DATABASE.  IT'S
C     CREATED BY TRANSFERRING LEVELS 1-28 OF THE LOW MODE, THEN
C     SELECTING EITHER LOW OR HIGH MODE FOR THE OVERLAP REGION (LEVELS
C     29-36), THEN GETTING THE HIGHEST 28 LEVELS OF THE HIGH MODE.
C     ------------------------------------------------------------------
            DO 3 I = 1, 28

               NIN = NIN + 1
               NOUT = NOUT + 1
               OB(NOUT) = OB(NIN)
               QCAPP(NOUT) = QCAPP(NIN)
               QCRES(NOUT) = QCRES(NIN)
               QCDESC(NOUT) = QCDESC(NIN)

 3          CONTINUE

            DO 4 I = 1, 8

               NOUT = NOUT + 1

               IF(NPN_LT(I+28,J).EQ.1)THEN

                  OB(NOUT) = OB(NIN+I)
                  QCAPP(NOUT) = QCAPP(NIN+I)
                  QCRES(NOUT) = QCRES(NIN+I)
                  QCDESC(NOUT) = QCDESC(NIN+I)

               ELSE IF(NPN_LT(I+28,J).EQ.2)THEN

                  OB(NOUT) = OB(NIN+I+8)
                  QCAPP(NOUT) = QCAPP(NIN+I+8)
                  QCRES(NOUT) = QCRES(NIN+I+8)
                  QCDESC(NOUT) = QCDESC(NIN+I+8)

               ELSE

                  OB(NOUT) = MISS_P
                  QCAPP(NOUT) = 0
                  QCRES(NOUT) = 0
                  QCDESC(NOUT) = 'Z'

               ENDIF

 4          CONTINUE

            NIN = NIN + 16

            DO 5 I = 1, 28

               NIN = NIN + 1
               NOUT = NOUT + 1
               OB(NOUT) = OB(NIN)
               QCAPP(NOUT) = QCAPP(NIN)
               QCRES(NOUT) = QCRES(NIN)
               QCDESC(NOUT) = QCDESC(NIN)

 5          CONTINUE

         ELSE IF(NLEVS.EQ.15)THEN

C     ------------------------------------------------------------------
C     THIS IS THE HIGH MODE FOR THE AWIPS DATABASE.  CREATE THIS BY
C     FILLING IN THE FIRST 8 LEVELS WITH THE OVERLAP REGION, REPLACING
C     LOW MODE VALUES WITH MISSING FLAGS, THEN GETTING THE HIGHEST
C     7 LEVELS OF THE PROFILE THAT WAS READ IN FROM THE DATABASE.
C     ------------------------------------------------------------------
            DO 14 I = 29, 36

               NOUT = NOUT + 1

               IF(NPN_LT(I,J).EQ.2)THEN

                  OB(NOUT) = OB(NIN+I)
                  QCAPP(NOUT) = QCAPP(NIN+I)
                  QCRES(NOUT) = QCRES(NIN+I)
                  QCDESC(NOUT) = QCDESC(NIN+I)

               ELSE

                  OB(NOUT) = MISS_P
                  QCAPP(NOUT) = 0
                  QCRES(NOUT) = 0
                  QCDESC(NOUT) = 'Z'

               ENDIF

 14         CONTINUE

            NIN = NIN + 36

            DO 15 I = 1, 7

               NIN = NIN + 1
               NOUT = NOUT + 1
               OB(NOUT) = OB(NIN)
               QCAPP(NOUT) = QCAPP(NIN)
               QCRES(NOUT) = QCRES(NIN)
               QCDESC(NOUT) = QCDESC(NIN)

 15         CONTINUE

         ENDIF

 1    CONTINUE

C     ------------------------------------------------------------------
C     IF THE VARIABLE IS ONE OF THE AWIPS-DATABASE CONSENSUS NUMBERS,
C     WE HAVE TO UNSCRAMBLE IT.  WHAT'S STORED IN THE DATABASE IS A
C     NUMERIC VALUE, WITH UP TO 4 DIGITS, THAT CONTAINS THE EAST/NORTH
C     MINIMUM IN THE LEFTMOST 2 DIGITS, AND THE VERTICAL BEAM NUMBER
C     IN THE RIGHTMOST 2 DIGITS (WITH NO LEADING ZEROS ON THE LEFT
C     PAIR).  HERE ARE A COUPLE OF EXAMPLES TO SHOW THE PATTERN:
C
C     902       EN = 9   V = 2
C     1010      EN = 10  V = 10
C     ------------------------------------------------------------------
      IF(VCN.EQ.NPNCNUM_AV_VN_P)THEN

         DO 25 I = 1, NRECS * NLEVS

            IF(OB(I).NE.MISS_P)OB(I) = OB(I) - (INT(OB(I))/100 * 100)

 25      CONTINUE

      ELSE IF(VCN.EQ.NPNCNUM_AEN_VN_P)THEN

         DO 35 I = 1, NRECS * NLEVS

            IF(OB(I).NE.MISS_P)OB(I) = INT(OB(I))/100

 35      CONTINUE

      ENDIF

      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**---------------------------------------------------------------------
