C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    M_IDSUBSRC  IDENTIFY SUBSRCS IN LOCAL MESONET DATA
C   PRGMMR: M. BARTH         ORG: FSL        DATE: 97-10-03
C
C ABSTRACT: LABEL CURRENT DATA WITH SUBSRC NUMBERS, AND UPDATE
C   INTERNAL TABLE IN MEMORY WITH NEW SUBSRC'S.
C
C PROGRAM HISTORY LOG:
C   97-10-03  M. BARTH         ORIGINAL VERSION
C   98-07-24  M. BARTH         BLANK PROVIDER NAMES ARE NOW ALLOWED.
C                              SUBSRC 0 WILL BE ASSIGNED, AND THE
C                              SFCHQCIN FILE WILL NOT BE MODIFIED.
C   99-09-14  M. BARTH         COPIED FROM MSAS AND MODIFIED FOR MADIS.
C   01-02-12  M. BARTH         ADDED A PRECIP ACCUM DURATION FIELD
C                              (INITIALIZED WITH A 0) TO NEW LINES
C                              OUTPUT TO SUBSRCIN.
C   01-04-24  M. BARTH         FIXED BUG WHERE WE HOSED EXISTING
C                              PRECIP ACCUM DURATION CODES WHEN
C                              UPDATING SUBSRCIN.
C   01-06-27  M. BARTH         RESTRUCTURED SUBSRCIN TO COVER THESE
C                              NEW CAPABILITIES:
C                              - SUBPROVIDERS
C                              - SOLAR RADIATION TYPE CODE
C                              - CODE TO INDICATE WHETHER PROVIDER OR
C                                SUBPROVIDER PRECIP ACCUM & SOLAR RAD
C                                CODES SHOULD BE HONORED
C   01-07-24  M. BARTH         DATA STRUCTURES SPLIT INTO SFC & HYDRO
C   02-05-06  M. BARTH         ADDED MAP AS THIRD SET OF STRUCTURES
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   03-09-25  M. BARTH         ADDED SATWND DATASET.
C   04-10-14  L. BENJAMIN      ADDED SATSND DATASET.
C   05-10-27  L. BENJAMIN      ADDED SATRAD DATASET.
C   05-11-18  L. BENJAMIN      ADDED SNOW DATASET.
C   08-07-12  L. BENJAMIN      ADDED WISDOM DATASET.
C
C USAGE:    CALL M_IDSUBSRC(NSTA, DPNAME, ISRC, STATUS)
C   INPUT ARGUMENT LIST:
C     NSTA     - INTEGER                     NUMBER OF STATIONS
C     DPNAME  - CHARACTER*10 ARRAY DPNAME(NSTA) PROVIDER NAMES
C
C   OUTPUT ARGUMENT LIST:
C     ISRC     - INTEGER ARRAY ISRC(NSTA)    SUBSRC NUMBERS
C     STATUS   - INTEGER                     RETURN STATUS
C
C SUBPROGRAMS CALLED:
C   M_LSTCHR
C
C REMARKS:
C   FOR THE MESONET DATASET, THE DETECTION OF NEW PROVIDERS WILL
C   ACTUALLY BE DONE IN M_UPDSRCIN.  CURRENTLY (5/27/03) ALL
C   OTHER DATASETS THAT HAVE PROVIDERS GET NEW ONES IDENTIFIED
C   VIA THIS ROUTINE.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN-77 + EXTENSIONS
C   MACHINE:  UNIX
C$$$


      SUBROUTINE M_IDSUBSRC (NSTA, DPNAME, ISRC, STATUS)




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

C     -----------------------------------------------------------------
C     ARGUMENTS
C     -----------------------------------------------------------------
      INTEGER NSTA
      INTEGER ISRC(*)
      INTEGER STATUS
      CHARACTER*10 DPNAME(*)




C     -----------------------------------------------------------------
C     LOCAL VARIABLES
C     -----------------------------------------------------------------
      INTEGER I
      INTEGER J
      INTEGER K
      INTEGER M_LSTCHR

C     *****************************************************************
C     ******************* BEGIN OF MODULE M_IDSUBSRC ******************
C     *****************************************************************

C     ---------------------------------------------------------------
C     SET THE INDEX INTO THE DATA STRUCTURES TO 1 FOR SFC, 2 FOR
C     HYDRO, 3 FOR MAP, 4 FOR RDMTR, 5 FOR SATWND, 6 FOR SATSND, 
C     7 FOR SATRAD.
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
      ELSE IF(CDTYPE.EQ.SATW_DS_P)THEN
         K = 5
      ELSE IF(CDTYPE.EQ.SATS_DS_P)THEN
         K = 6
      ELSE IF(CDTYPE.EQ.SATR_DS_P)THEN
         K = 7
      ELSE IF(CDTYPE.EQ.SNOW_DS_P)THEN
         K = 8
      ELSE IF(CDTYPE.EQ.WISDOM_DS_P)THEN
         K = 9
      ENDIF

C     ---------------------------------------------------------------
C     ASSIGN SUBSRC NUMBERS AND KEEP TRACK OF NEW PROVIDERS
C     ---------------------------------------------------------------

      DO 100 I = 1, NSTA

         DO 200 J = 1, NPVD(K)
            IF (DPNAME(I) .EQ. PVDNAME(J,K)) THEN
               ISRC(I) = J
               GO TO 100
            ELSE IF (DPNAME(I) .EQ. '          ') THEN
               ISRC(I) = 0
               GO TO 100
            ENDIF
 200     CONTINUE

C        ---------------------------------------------------------------
C        CREATE A NEW SUBSRC NUMBER UNTIL THE LAST ONE IS REACHED.  WHEN
C        THAT HAPPENS, THE LAST NUMBER WILL BE USED TO TRIGGER THE
C        "ALL ELSE" STRATIFICATION BY ASSIGNING ANY NEW PROVIDERS WITH
C        THE SAME SUBSRC NUMBER, AND BY *NOT* PUTTING THAT NUMBER INTO
C        ANY OF THE STRATIFICATIONS.
C
C        NOTES:
C
C        - WE DON'T HANDLE SUBPROVIDERS.  THESE ARE MAINTAINED VIA
C          THE NETCDF FILES FOR THOSE DATASETS THAT HAVE THEM.
C        - DITTO FOR THE CODES USED TO DETERMINE 
C          PROVIDER/SUBPROVIDER-SPECIFIC DATA HANDLING.
C        - THE IDENTIFY-NEW-PROVIDERS LOGIC IS ONLY USED FOR DATASETS
C          THAT DON'T IDENTIFY THEM IN STRUCTURES IN THE NETCDF FILES.
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) .EQ. MAX_SUBSRC_P) THEN
            ISRC(I) = 999
         ELSE
            NPVD(K) = NPVD(K) + 1
            IF (NPVD(K) .LT. MAX_SUBSRC_P) THEN
               PVDNAME(NPVD(K),K) = DPNAME(I)
               PVDLEN(NPVD(K),K) = M_LSTCHR(PVDNAME(NPVD(K),K),10)
               PACCUM_P_CODE(NPVD(K),K) = 0
               SRAD_P_CODE(NPVD(K),K) = 0
               SUB_CODE(NPVD(K),K) = 0
               ISRC(I) = NPVD(K)
               DO J = 1, NNEWPVD(K)
                  IF(DPNAME(I).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)
            ELSE
               PVDNAME(NPVD(K),K) = 'ALL ELSE  '
               PVDLEN(NPVD(K),K) = 8
               ISRC(I) = 999
            ENDIF
         ENDIF

 100  CONTINUE

      OLD_NPVD(K) = NPVD(K)
      STATUS = SUCCESS_P

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