C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    MSFCSRAD    GET SURFACE SOLAR RADIATION OBS
C   PRGMMR: M. BARTH         ORG: FSL        DATE: 01-06-28
C
C ABSTRACT: GET THE SURFACE SOLAR RADIATION OBS.
C
C PROGRAM HISTORY LOG:
C   01-06-27  M. BARTH    ORIGINAL VERSION
C   01-07-24  M. BARTH    SPLIT PROVIDER INFO INTO SFC & HYDRO
C   02-05-29  M. BARTH    RESTRUCTURED TEMPORARY MEMORY ARRAY USAGE
C   03-09-12  M. BARTH    ADDED ADDITIONAL SOLAR RADIATION TYPES:
C                         - 5 MIN AND INSTANTANEOUS DURATION FOR ALL 
C                           TYPES
C                         - GLOBAL TYPE FOR ALL DURATIONS
C   04-10-16  L. BENJAMIN ADDED NO SUCH VARIABLE CHECK FOR QCA CHECKS
C   05-06-14  M. BARTH    ADDED UNKNOWN SOLAR RADIATION TYPE
C   05-09-26  L. BENJAMIN HARD CODED CODE DS TO 5 MIN GLOBAL SOLAR 
C                         RADIATION
C   07-05-16  L. BENJAMIN ADDED PHOTOSYNTHETICALLY ACTIVE RADIATION
C
C USAGE:    CALL MSFCSRAD (VCN,DSN,FNUM,OB,QCDESC,QCAPP,QCRES,STATUS)
C
C   INPUT ARGUMENT LIST:
C     VCN      - I       VARIABLE CODE NUMBER FOR TYPE OF SOLAR
C                        RADIATION THAT'S DESIRED.
C     DSN      - I       DATASET CODE NUMBER
C     FNUM     - I       FILE NUMBER (INDEX IN COMMON) OF NETCDF FILE
C
C   OUTPUT ARGUMENT LIST:
C     OB       - RA      OBSERVATIONS IN M/K/S UNITS
C     QCDESC   - CA      QC DATA DESCRIPTORS
C     QCAPP    - RA      QC APPLIED WORD (SHOWS CHECKS APPLIED)
C     QCRES    - RA      QC RESULTS WORD (GOOD/BAD FOR EACH CHECK)
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:    MGTNUM, MGTCHR, M_LSTCHR
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   - ONLY MESONETS HAVE THIS VARIABLE.
C   - THE REASON A SPECIAL SUBROUTINE IS NEEDED IS BECAUSE THERE ARE
C     MULTIPLE TYPES OF SOLAR RADIATION, BUT ONLY ONE VARIABLE IN
C     THE NETCDF FILE.  THEREFORE, THE PROVIDER/SUBPROVIDER CODES
C     SPECIFIED IN SUBSRCIN.TXT ARE USED TO TELL WHAT TO RETURN
C     TO THE CALLER.
C
C     SOLAR RADIATION TYPES INCLUDE:
C
C      0        UNKNOWN
C      1        DIFFUSE  15 MIN
C      2        DIFFUSE   1 HOUR
C      3        DIFFUSE  24 HOUR
C      4        DIRECT   15 MIN
C      5        DIRECT    1 HOUR
C      6        DIRECT   24 HOUR
C      7        GLOBAL   15 MIN
C      8        GLOBAL    1 HOUR
C      9        GLOBAL   24 HOUR
C      10       DIFFUSE   5 MIN
C      11       DIRECT    5 MIN
C      12       GLOBAL    5 MIN
C      13       DIFFUSE   INSTANTANEOUS
C      14       DIRECT    INSTANTANEOUS
C      15       GLOBAL    INSTANTANEOUS
C      16       PHOTOSYN  INSTANTANEOUS
C
C     THIS CAN BE SPECIFIED ON A PROVIDER OR SUBPROVIDER LEVEL.  IF
C     THE SUB_CODE FOR THE PROVIDER INDICATES THAT THE SUBPROVIDER
C     CODES SHOULD BE USED, THESE WILL BE USED INSTEAD OF WHATEVER'S
C     IN THE PROVIDER CODE.
C
C   - THE MADISCOM PROVIDER ARRAYS (NPVD, PVDNAME, ETC.) HAVE SFC
C     PROVIDERS IN ROW 1, HYDRO PROVIDERS IN ROW 2.
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 MSFCSRAD (VCN,DSN,FNUM,OB,QCDESC,QCAPP,QCRES,STATUS)

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

C     ------------------------------------------------------------------
C     ARGUMENTS
C     ------------------------------------------------------------------
      INTEGER VCN,DSN,FNUM,STATUS
      REAL OB(*),QCAPP(*),QCRES(*)
      CHARACTER*1 QCDESC(*)

C     ------------------------------------------------------------------
C     LOCAL
C     ------------------------------------------------------------------
      REAL OBTMP(MXSFC_P)
      INTEGER I,J,K,L,M,LEN1REC,M_LSTCHR,SRAD_CODE,DESIRED_CODE
      REAL QCATMP(MXSFC_P),QCRTMP(MXSFC_P)
      CHARACTER*1 QCDTMP(MXSFC_P)
      CHARACTER*11 DPTMP(MXSFC_P)
      CHARACTER*51 LNTMP(MXSFC_P)

C     ------------------------------------------------------------------
C     TEMPORARY STORAGE DEFINITIONS
C     ------------------------------------------------------------------
      EQUIVALENCE(OBTMP,TMP_L2_N1)
      EQUIVALENCE(QCATMP,TMP_L2_N2)
      EQUIVALENCE(QCRTMP,TMP_L2_N3)
      EQUIVALENCE(QCDTMP,TMP_L2_C1)
      EQUIVALENCE(DPTMP,TMP_L2_C1(MXSFC_P+1))
      EQUIVALENCE(LNTMP,TMP_L2_C1(MXSFC_P*12+1))

C     ------------------------------------------------------------------
C     READ THE DATA AND ANY ASSOCIATED QC INFO FOR THE ONE-AND-ONLY
C     SRAD VARIABLE.  THEN GET THE PROVIDER AND SUBPROVIDER NAMES SO WE
C     CAN TELL IF ANY OF THEM HAVE THE DESIRED VARIABLE, AND WE'LL
C     RETURN THOSE TO THE CALLER (ALL ELSE WILL BE MISSING).  (ALSO NOTE
C     THAT THE SUBPROVIDER NAMES ARE IN CHARACTERS 40:50 OF THE LONG
C     STATION NAMES.)
C     ------------------------------------------------------------------
      CALL MGTNUM(VNAME(VCN,DSN)(1:VLEN(VCN,DSN)),SFC_NCID(FNUM),
     1            SFC_RECDIM(FNUM),1,SFC_NRECS(FNUM),MISS_P,OBTMP,
     2            STATUS)
      IF(STATUS.NE.SUCCESS_P)RETURN

C     ASSUME QC OK, SET FOR DIFFERNET CONDITIONS
      QCSTATUS = EQCOK_P

      IF(VQC(VCN,DSN).EQ.'Q')THEN

         CALL MGTNUM(VNAME(VCN,DSN)(1:VLEN(VCN,DSN))//'QCA',
     1               SFC_NCID(FNUM),SFC_RECDIM(FNUM),1,SFC_NRECS(FNUM),
     2               MISS_P,QCATMP,STATUS)
         IF(STATUS.EQ.VAR_NOTINDB_P)THEN
            QCSTATUS = EQCFAILED_P
            STATUS = SUCCESS_P
            DO I = 1, SFC_NRECS(FNUM)
               QCATMP(I) = 0
               QCRTMP(I) = 0
               QCDTMP(I) = 'Z'
            ENDDO
         ELSE IF(STATUS.NE.SUCCESS_P)THEN
            RETURN
         ELSE
            CALL MGTNUM(VNAME(VCN,DSN)(1:VLEN(VCN,DSN))//'QCR',
     1               SFC_NCID(FNUM),SFC_RECDIM(FNUM),1,SFC_NRECS(FNUM),
     2               MISS_P,QCRTMP,STATUS)
            IF(STATUS.NE.SUCCESS_P)RETURN

            CALL MGTCHR(VNAME(VCN,DSN)(1:VLEN(VCN,DSN))//'DD',
     1               SFC_NCID(FNUM),SFC_RECDIM(FNUM),1,SFC_NRECS(FNUM),
     2               QCDTMP,LEN1REC,STATUS)
            IF(STATUS.NE.SUCCESS_P)RETURN
         ENDIF
      ELSE
         QCSTATUS = EQCFAILED_P

         DO 21 I = 1, SFC_NRECS(FNUM)
            QCATMP(I) = 0
            QCRTMP(I) = 0
            QCDTMP(I) = 'Z'
 21      CONTINUE

      ENDIF

      CALL MGTCHR('dataProvider',SFC_NCID(FNUM),SFC_RECDIM(FNUM),
     1            1,SFC_NRECS(FNUM),DPTMP,LEN1REC,STATUS)
      IF(STATUS.NE.SUCCESS_P)RETURN

      CALL MGTCHR('stationName',SFC_NCID(FNUM),SFC_RECDIM(FNUM),
     1            1,SFC_NRECS(FNUM),LNTMP,LEN1REC,STATUS)
      IF(STATUS.NE.SUCCESS_P)RETURN

C     ------------------------------------------------------------------
C     WIPE OUT OBS FOR ANY PROVIDERS/SUBPROVIDERS THAT DON'T HAVE
C     THE CALLER'S DESIRED VARIABLE.  OTHERWISE, RETURN THE ONES THAT
C     DO HAVE THE RIGHT VARIABLE.
C     ------------------------------------------------------------------
      IF(VCN.EQ.SRAD0_VN_P)THEN
         DESIRED_CODE = 0
      ELSE IF(VCN.EQ.SRAD1_VN_P)THEN
         DESIRED_CODE = 1
      ELSE IF(VCN.EQ.SRAD2_VN_P)THEN
         DESIRED_CODE = 2
      ELSE IF(VCN.EQ.SRAD3_VN_P)THEN
         DESIRED_CODE = 3
      ELSE IF(VCN.EQ.SRAD4_VN_P)THEN
         DESIRED_CODE = 4
      ELSE IF(VCN.EQ.SRAD5_VN_P)THEN
         DESIRED_CODE = 5
      ELSE IF(VCN.EQ.SRAD6_VN_P)THEN
         DESIRED_CODE = 6
      ELSE IF(VCN.EQ.SRAD7_VN_P)THEN
         DESIRED_CODE = 7
      ELSE IF(VCN.EQ.SRAD8_VN_P)THEN
         DESIRED_CODE = 8
      ELSE IF(VCN.EQ.SRAD9_VN_P)THEN
         DESIRED_CODE = 9
      ELSE IF(VCN.EQ.SRAD10_VN_P)THEN
         DESIRED_CODE = 10
      ELSE IF(VCN.EQ.SRAD11_VN_P)THEN
         DESIRED_CODE = 11
      ELSE IF(VCN.EQ.SRAD12_VN_P)THEN
         DESIRED_CODE = 12
      ELSE IF(VCN.EQ.SRAD13_VN_P)THEN
         DESIRED_CODE = 13
      ELSE IF(VCN.EQ.SRAD14_VN_P)THEN
         DESIRED_CODE = 14
      ELSE IF(VCN.EQ.SRAD15_VN_P)THEN
         DESIRED_CODE = 15
      ELSE IF(VCN.EQ.SRAD16_VN_P)THEN
         DESIRED_CODE = 16
      ENDIF

      DO 23 I = 1, SFC_NRECS(FNUM)

C     ------------------------------------------------------------------
C     HARD CODE COOP DS TO 5 MIN GLOBAL SOLAR RADIATION
C     ------------------------------------------------------------------
         IF(COOP_DS_P.EQ.DSN)THEN
            SRAD_CODE = 12
         ELSE
            K = M_LSTCHR(DPTMP(I),10)
            SRAD_CODE = -1


            DO 24 J = 1, NPVD(1)
               
               IF(K.EQ.PVDLEN(J,1).AND.DPTMP(I)(1:K).EQ.
     1              PVDNAME(J,1)(1:K))THEN

                  IF(SUB_CODE(J,1).EQ.0)THEN

                     SRAD_CODE = SRAD_P_CODE(J,1)
                     GO TO 25

                  ELSE

                     L = M_LSTCHR(LNTMP(I)(40:50),11)
                     IF(L.EQ.0)GO TO 25
                     
                     DO 26 M = 1, NSUB(1)

                        IF(L.EQ.SUBLEN(M,1).AND.LNTMP(I)(40:40+L-1).EQ.
     1                       SUBNAME(M,1)(1:L))THEN
                           
                           SRAD_CODE = SRAD_S_CODE(M,1)
                           GO TO 25
                           
                        ENDIF
                        
 26                  CONTINUE
                     
                  ENDIF

               ENDIF

 24         CONTINUE
         ENDIF

 25      IF(SRAD_CODE.NE.DESIRED_CODE)OBTMP(I) = MISS_P

         IF(OBTMP(I).NE.MISS_P)THEN

            OB(I) = OBTMP(I)
            QCAPP(I) = QCATMP(I)
            QCRES(I) = QCRTMP(I)
            QCDESC(I) = QCDTMP(I)

         ELSE

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

         ENDIF

 23   CONTINUE

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