C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    M_UPDSRCIN  UPDATE SUBSRCS FROM TABLE IN NETCDF FILE
C   PRGMMR: M. BARTH         ORG: FSL        DATE: 02-06-03
C
C ABSTRACT: READ (IF AVAILABLE) TABLE OF SUBSRC INFO FROM AN OPEN
C   NETCDF FILE.
C
C PROGRAM HISTORY LOG:
C   02-06-03  M. BARTH         ORIGINAL VERSION
C   03-05-27  M. BARTH         REMOVED UPDATE OF THE SUBSRCIN FILE
C                              ON DISK, AND ADDED LOGIC TO HONOR
C                              THE ENABLE/DISABLE PROVIDER SETTINGS
C                              SET BY THE USER WHEN NEW PROVIDERS
C                              ARE IDENTIFIED.
C   03-07-02  M. BARTH         ADDED RDMTR DATASET.
C   04-09-21  L.BENJAMIN       READ RAWPRECIP CODE IN CODE4PST.
C
C USAGE:    CALL M_UPDSRCIN(NCID,RECDIM,STATUS)
C
C   INPUT ARGUMENT LIST:
C     NCID     - I       ID OF THE OPEN NETCDF FILE
C     RECDIM   - I       DIMENSION ID OF THE FILE'S RECORD DIMENSION
C
C SUBPROGRAMS CALLED:
C   MRDCHR
C   MRDNUM
C   M_LSTCHR
C   
C ATTRIBUTES:
C   LANGUAGE: FORTRAN-77 + EXTENSIONS
C   MACHINE:  UNIX
C$$$


      SUBROUTINE M_UPDSRCIN (NCID,RECDIM,STATUS)




C     *****************************************************************
C     ******************* MODULE   DECLARATIONS ***********************
C     *****************************************************************
      INCLUDE 'IMPLICIT'
      INCLUDE 'MADISCON'
      INCLUDE 'MADISCOM'

C     -----------------------------------------------------------------
C     ARGUMENTS
C     -----------------------------------------------------------------
      INTEGER NCID,RECDIM,STATUS

C     -----------------------------------------------------------------
C     LOCAL VARIABLES
C     -----------------------------------------------------------------
      INTEGER RCODE,I,J,K,M_LSTCHR
      REAL NPS
      CHARACTER*11 NAME(MAX_SUBSRC_P+MAX_SUBPVDR_P)
      CHARACTER*1 PSTYP(MAX_SUBSRC_P+MAX_SUBPVDR_P)
      REAL CODE(MAX_SUBSRC_P+MAX_SUBPVDR_P,5)
      LOGICAL SAVE_VERBOSE,ANY_CHANGE

C     *****************************************************************
C     ******************* BEGIN OF MODULE M_UPDSRCIN ******************
C     *****************************************************************

C     ---------------------------------------------------------------
C     READ THE RELEVANT VARIABLES OUT OF THE NETCDF FILE.  NOTE THAT
C     IT'S POSSIBLE THAT THESE AREN'T IN THERE.  IN THAT CASE, WE
C     RETURN WITHOUT DOING ANYTHING.  (THIS IS ALSO WHY WE TURN OFF
C     VERBOSE ERROR-HANDLING WHILE READING THE VARIABLES.)
C     ---------------------------------------------------------------
      SAVE_VERBOSE = VERBOSE
      VERBOSE = .FALSE.
      STATUS = SUCCESS_P


      CALL MRDNUM('numPST',NCID,RECDIM,0,0,MISS_P,NPS,RCODE)
      IF(RCODE.NE.SUCCESS_P)GO TO 900
      CALL MRDNUM('code1PST',NCID,RECDIM,0,0,MISS_P,CODE(1,1),RCODE)
      IF(RCODE.NE.SUCCESS_P)GO TO 900
      CALL MRDNUM('code2PST',NCID,RECDIM,0,0,MISS_P,CODE(1,2),RCODE)
      IF(RCODE.NE.SUCCESS_P)GO TO 900
      CALL MRDNUM('code3PST',NCID,RECDIM,0,0,MISS_P,CODE(1,3),RCODE)
      IF(RCODE.NE.SUCCESS_P)GO TO 900
      CALL MRDNUM('code4PST',NCID,RECDIM,0,0,MISS_P,CODE(1,4),RCODE)
      IF(RCODE.NE.SUCCESS_P)THEN
         DO I = 1,MAX_SUBSRC_P+MAX_SUBPVDR_P
            CODE(I,4) = 0
         ENDDO
      ENDIF
      CALL MRDCHR('typePST',NCID,RECDIM,0,0,PSTYP,I,RCODE)
      IF(RCODE.NE.SUCCESS_P)GO TO 900
      CALL MRDCHR('namePST',NCID,RECDIM,0,0,NAME,I,RCODE)
      IF(RCODE.NE.SUCCESS_P)GO TO 900

      VERBOSE = SAVE_VERBOSE

C     ---------------------------------------------------------------
C     SET THE INDEX INTO THE DATA STRUCTURES TO 1 FOR SFC, 2 FOR
C     HYDRO, 3 FOR MAP, 4 FOR RDMTR.
C     ---------------------------------------------------------------
      IF(CDTYPE.EQ.SFC_DS_P)THEN
         K = 1
      ELSE IF(CDTYPE.EQ.HYD_DS_P)THEN
         K = 2
      ELSE IF(CDTYPE.EQ.MAP_DS_P)THEN
         K = 3
      ELSE IF(CDTYPE.EQ.RDMTR_DS_P)THEN
         K = 4
      ENDIF

C     ---------------------------------------------------------------
C     UPDATE CODES FOR PROVIDERS/SUBPROVIDERS WE ALREADY KNOW ABOUT.  
C     ADD NEW PROVIDERS/SUBPROVIDERS AS THEY APPEAR.
C     ---------------------------------------------------------------
      ANY_CHANGE = .FALSE.

      DO 100 I = 1, INT(NPS)

         IF(PSTYP(I).EQ.'P')THEN

            DO 200 J = 1, OLD_NPVD(K)

               IF(NAME(I)(1:10).EQ.PVDNAME(J,K))THEN

                  IF(PACCUM_P_CODE(J,K).NE.CODE(I,1).OR.
     1               SRAD_P_CODE(J,K).NE.CODE(I,2).OR.
     2               SUB_CODE(J,K).NE.CODE(I,3).OR.
     3               RAWP_CODE(J,K).NE.CODE(I,4))THEN

                     ANY_CHANGE = .TRUE.
                     PACCUM_P_CODE(J,K) = CODE(I,1)
                     SRAD_P_CODE(J,K) = CODE(I,2)
                     SUB_CODE(J,K) = CODE(I,3)
                     RAWP_CODE(J,K) = CODE(I,4)
                  ENDIF

                  GO TO 100

               ENDIF

 200        CONTINUE

C        ---------------------------------------------------------------
C        - CREATE A NEW PROVIDER ENTRY UNTIL THE LAST ONE IS REACHED. 
C          WHEN WE RUN OUT, JUST LET NEW ONES FALL ON THE FLOOR.
C        - TO DETERMINE IF THE NEW PROVIDER SHOULD BE DISABLED OR
C          ENABLED, WE FIRST CHECK FOR IT IN THE LIST OF NEW PROVIDERS
C          THAT HAVE BEEN SPECIFIED IN AN MSET*PVDR CALL, AND IF IT'S
C          NOT IN THAT LIST, USE THE DEFAULT SETTING FOR THAT DATASET
C          (AS POSSIBLY MODIFIED BY MSET*PVDR AS WELL).
C        ---------------------------------------------------------------
            IF(NPVD(K).LT.MAX_SUBSRC_P)THEN

               ANY_CHANGE = .TRUE.
               NPVD(K) = NPVD(K) + 1
               PVDNAME(NPVD(K),K) = NAME(I)(1:10)
               PVDLEN(NPVD(K),K) = M_LSTCHR(PVDNAME(NPVD(K),K),10)
               PACCUM_P_CODE(NPVD(K),K) = CODE(I,1)
               SRAD_P_CODE(NPVD(K),K) = CODE(I,2)
               SUB_CODE(NPVD(K),K) = CODE(I,3)
               RAWP_CODE(NPVD(K),K) = CODE(I,4)
               DO J = 1, NNEWPVD(K)
                  IF(NAME(I)(1:10).EQ.NEWPVDNAME(J,K))THEN
                     PROVDR_ENBL(NPVD(K),K) = NEW_ENBL(j,K)
                     GO TO 100
                  ENDIF
               ENDDO
               PROVDR_ENBL(NPVD(K),K) = ALL_ENBL(K)

            ENDIF
            
            GO TO 100

         ELSE IF(PSTYP(I).EQ.'S')THEN

            DO 300 J = 1, OLD_NSUB(K)

               IF(NAME(I).EQ.SUBNAME(J,K))THEN

                  IF(PACCUM_S_CODE(J,K).NE.CODE(I,1).OR.
     1               SRAD_S_CODE(J,K).NE.CODE(I,2))THEN

                     ANY_CHANGE = .TRUE.
                     PACCUM_S_CODE(J,K) = CODE(I,1)
                     SRAD_S_CODE(J,K) = CODE(I,2)

                  ENDIF

                  GO TO 100

               ENDIF

 300        CONTINUE

C        ---------------------------------------------------------------
C        CREATE A NEW SUBPROVIDER ENTRY UNTIL THE LAST ONE IS REACHED. 
C        WHEN WE RUN OUT, JUST LET NEW ONES FALL ON THE FLOOR.
C        ---------------------------------------------------------------
            IF(NSUB(K).LT.MAX_SUBPVDR_P)THEN

               ANY_CHANGE = .TRUE.
               NSUB(K) = NSUB(K) + 1
               SUBNAME(NSUB(K),K) = NAME(I)
               SUBLEN(NSUB(K),K) = M_LSTCHR(SUBNAME(NSUB(K),K),11)
               PACCUM_S_CODE(NSUB(K),K) = CODE(I,1)
               SRAD_S_CODE(NSUB(K),K) = CODE(I,2)

            ENDIF

         ENDIF

 100  CONTINUE

C     ---------------------------------------------------------------
C     IF ANYTHING CHANGED, UPDATE THE OLD_N* COUNTS TO INDICATE
C     WE'RE NOW UP TO DATE.
C     ---------------------------------------------------------------
      IF(ANY_CHANGE)THEN

         OLD_NPVD(K) = NPVD(K)
         OLD_NSUB(K) = NSUB(K)

      ENDIF


      


 900  VERBOSE = SAVE_VERBOSE
      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**---------------------------------------------------------------------
