C$$$  MAIN PROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C Test version with csv style output            
C                .      .    .                                       .
C MAIN PROGRAM:  SFCDUMP     Dump & tutorial program for MADIS surface
C   PRGMMR: M. BARTH         ORG: FSL        DATE: 01-07-31
C
C ABSTRACT: Dump MADIS surface station info, observations, and quality
C   control (QC) information for a single time, based on the user's 
C   selections specified in a text parameter file.  The program is also 
C   meant as a tutorial to demonstrate how a user can use the MADIS 
C   library calls to write his or her own programs.
C
C PROGRAM HISTORY LOG:
C   01-07-30  M. BARTH  Original version -- MADIS Version 2.0
C   02-02-01  M. BARTH  Ver. 2.01:  Fixed bug where PCPINT/PCPTYPE 
C                       should have been handled as 2-element values 
C                       (a la SKYCOVLB).
C   02-04-30  M. BARTH  V2.1:  Increased maximum number of station
C                       records from 10000 to 25000.
C   03-05-23  M. BARTH  V2.2:  Increased maximum number of station
C                       records from 25000 to 50000.
C   03-07-02  M. BARTH  V2.3 - Changed comment re available datasets 
C   03-10-02  M. BARTH  V2.4 - Changed comment re available datasets 
C   04-03-24  M. BARTH  V2.5 - Added COOP dataset and its max/min 
C                       temperature time variables.  Don't output 
C                       records for character variables that are all 
C                       blank (missing).  Added subprovider variable.
C                       - Changed comment re available datasets
C                       - Added "Output Options" section to the
C                         parameter file.
C                       - Added MMADISCLOSE call.
C   05-06-15  L. BENJAM V2.7 - Changed comment re available datasets 
C                       - Added XML output format 
C                       - Increased maximum number of station records 
C                         from 50000 to 100000.
C   05-10-27  L. BENJAMIN V2.9 - Changed comment re available datasets 
C   05-11-18  L. BENJAMIN V3.0 - Changed comment re available datasets 
C   06-01-30  M. BARTH    V3.1 - Changed maximum number of surface
C                                records from 100000 to 200000.
C   06-09-20  L. BENJAMIN V3.2 - Added URBANET dataset to sfc data and
C                                changed COOP variables.
C   07-05-15  L. BENJAMIN V3.3 - Add CSV ouptut option.  Allowed two
C                              values for missing data: -99999 and 
C                              blank.  
C   07-06-15  L. BENJAMIN V3.4 - Fixed CSV format bug for variables
C                         with all missing data.
C   07-07-16  L. BENJAMIN V3.5 - Set subpvdr CSV field length to 11 
C                          characters.  Fixed SKYCOVER XML format
C                          bug.  Added additional backward 
C                          compatibility check.
C   07-07-20  L. BENJAMIN V3.5 - In the XML format removed number from 
C                         end of T24MAXT, T24MINT, FOT15M, and LOT15M 
C                         variable names.  Removed the starting 
C                         blank space from each xml line.
C   07-11-16  L. BENJAMIN V3.6 - Changed the QC 99 option criteria for
C                         chosing the highest level of qc.  The RSAS
C                         domain sites are the same as before, while 
C                         the non-RSAS domain sites need only match
C                         the 2-screened criteria.
C   08-06-25  M. BARTH    Added high frequency METAR dataset.
C   08-06-26  L. BENJAMIN Fix bug in CSV. The bug was CSV format 
C                         returned no data unless mesonet or COOP data 
C                         was in the selection criteria.
C   08-07-25  L. BENJAMIN V3.7 - Changed comment re available datasets 
C   08-08-01  L. BENJAMIN Restricted the size of csv string by
C                         length instead of by number of variables.
C                         Changed the max length fo the string to 560
C                         characters.  This should increase the number
C                         of variables that a user can display, unless
C                         they are requesting the large footprint
C                         variables like AUTORMK, OPERRMK, STALOC, 
C                         SKYCOV, SKYCVLB, PCPINT, and PCPTYPE'
C   08-08-08  L. BENJAMIN Fixed 2nd part of CSV output bug for 
C                         non-mesonet. 
C   09-07-14  M. BARTH    Fixed CSV output bug where NSTA=0 on the
C                         last variable read caused no output.  We now
C                         keep the biggest NSTA
C   09-09-05  L. BENJAMIN V3.8 Added CRN, NEPP, and HCN providers.
C                         Increase the station and obs field in the 
C                         text output to 6 spaces. Increased the
C                         maximum number of stations to 300000.
C   10-10-20  L. BENJAMIN Change csv length to 800 for special run.
C   11-06-23  L. BENJAMIN Added undocument missing value check, 
C                         values are larger than format size.
C   12-08-22  L. BENJAMIN Fixed filled values for missing data for
C                         csv output for SKYCVLB, PCPINT, and PCPTYPE
C   12-09-10  L. BENJAMIN Added minimum elevation of -500m check
C   13-04-21  L. BENJAMIN Added itextxml format 5 and 6. Add data header line
C   13-10-21  L. BENJAMIN V4.2 Added itextxml format 7 and 8  For MADIS web 
C                         services.  Add limit check for max/min numer size
C   14-01-03  L. BENJAMIN V4.2 Windows version csv line only 800 characters
C                          
C                         
C USAGE:
C   INPUT FILES: (for the entire program)
C
C     sfcdump.par      Parameter file (in current directory) with
C                      user's selections.
C
C     MADIS initialization files in MADIS_STATIC directory   
C
C     MADIS observation files under MADIS_DATA directories
C
C   OUTPUT FILES:
C
C     sfcdump.txt      Text output of station info, obs & QC
C
C     standard output  Log of what was done, errors
C
C SUBPROGRAMS CALLED:
C     LIBRARY: - MADISLIB:  MINIT, MSETWIN, MSETSFCPVDR, MSETDOM,
C                           MSETQC, MTRNTIM, MSFCSTA, MGETIJ, MGETVCN,
C                           MGETSFC, MGETSFCC, M_LSTCHR, M_MKFNAM,
C                           MMADISCLOSE, M_FRTCHR, M_LSTCHR
C
C REMARKS:
C
C   1) This program can be used to exercise all options included in the
C      MADIS library for surface data.  It is also meant to be used as
C      a tutorial to demonstrate how a user can write his or her own
C      programs.  
C
C   2) See the INSTALL.* files in the MADIS doc directory for 
C      instructions on how to install and build the MADIS library and 
C      programs (INSTALL.unix for Unix/Linux, INSTALL.windows for
C      Windows).
C
C   3) See the sfcdump_usage.txt file in the MADIS doc directory for
C      instructions on how to set up a parameter file and run the
C      program.
C    
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 77 + EXTENSIONS
C   MACHINE: UNIX
C
C$$$
C-----------------------------------------------------------------------
C     Declarations notes:
C
C     1) Key constants:
C
C       - 0              successful status return
C       - 999999.0       missing data flag
C       - 200000         maximum number of surface stations
C
C     2) Arrays should be dimensioned to 200000, for the maximum number 
C        of surface station records

      implicit none

      integer success_p
      real miss_p
      parameter (success_p = 0)
      parameter (miss_p = 999999.0)

      real csvmissing
      parameter (csvmissing = -99999.0)


      integer maxcsvsz
      parameter (maxcsvsz = 750)
      integer maxcsvvar,tmpsz,cursz
      

      character*24 mstr
      integer mstrlen

      integer nstatot,ivcode,idx,ic

      integer istatus,i,j,k,line,j2
      integer nsta,nobs,m_lstchr
      character*10 stanam(600000)
      character*5 hmstr
      character*10 dstr
      character*9 atime
      character*6 db
      logical stnhasdata(600000)
      character*(maxcsvsz) csvstr(600000)
      integer csvstrendlen(600000)
      character*(maxcsvsz) csvstrheader
      integer csvstrendlenheader
      character*9 timeob(600000)
      integer wmoid(600000)
      character*10 provdr(600000)
      integer source_n(600000)
      real rdata(600000),lat(600000),lon(600000),elev(600000)
      character*1 qcd(600000)
      integer qca(600000),qcr(600000)
      real skycovlb(6,600000),pcpvar(2,600000)
      character*1 qcdsky(6,600000),qcdpcp(2,600000)
      integer qcasky(6,600000),qcrsky(6,600000),qcapcp(2,600000)
      integer qcrpcp(2,600000)
      character*7 vcode
      character*7 vcodes(300)
      character*13 hdvcode
      integer numvcodes
      character*40 header,tmpline
      integer minbck,minfwd,recwin,qctyp,ipvd,idmtyp,vcn,tform,ctime
      real dummy,ri(600000),rj(600000)
      integer idummy,time,ising,ilatlon
      real rpar(7),ftest
      integer ipar(2)
      character*1 vtype
      character*13 tstr,tstr1,tstr2
      character*16 xmltstr
      character*10 pvdrnam,singsta
      character*63 twstr(0:4)
      integer twstrlen(0:4)
      integer qcas,qcae,qcrs,qcre,itextxml,vce,imissval,itextxml_ext
      integer ee,es,lte,lts,lne,lns,pe,ps,se,ss,dve,dvs,M_FRTCHR
      real minelev
      character*14 celev, clat, clon, cdv, cqca, cqcr

      character*10 hdmstr
      integer hdmstrlen
      integer access(600000)

      character*16 qcstr(0:3)
      character*25 preswea(600000)
      character*6 c6(600000)
      character*51 staloc(600000)
      character*8 skycover(6,600000)
      character*51 cdata(600000)
      character*256 rawmtr(600000)
      character*9 c9(600000)
      character*11 subpvdr(600000)
      character*80 remark(600000)
      character*1 cvsheadercnt(9)
      equivalence(rawmtr,preswea,c6,staloc,skycover,cdata,c9,subpvdr,
     1     remark)
      equivalence(skycovlb,pcpvar,rdata)
      equivalence(qcdsky,qcdpcp,qcd)
      equivalence(qcasky,qcapcp,qca)
      equivalence(qcrsky,qcrpcp,qcr)

      data twstr/
     1 'Return all records within the file containing nominal time',  
     2 'Return one record per fixed station, closest to nominal time',
     3'Return one record per fixed station, closest to start of window',
     4 'Return one record per fixed station, closest to end of window',
     5 'Return all records in window'/
      data twstrlen/58,60,63,61,28/
      data qcstr/'No Filter','Coarse','Screened','Verified'/
      data minelev  /-500./

C-----------------------------------------------------------------------
C PROGRAM SETUP
C -------------
C
C     Open an output file for this program.

      open(unit=1,file='sfcdump.txt',status='UNKNOWN')

C     Open the parameter file that will specify the user's selections.

      open(unit=2,file='sfcdump.par',status='OLD')

      cvsheadercnt(1)='1'
      cvsheadercnt(2)='2'
      cvsheadercnt(3)='3'
      cvsheadercnt(4)='4'
      cvsheadercnt(5)='5'
      cvsheadercnt(6)='6'
      cvsheadercnt(7)='7'
      cvsheadercnt(8)='8'
      cvsheadercnt(9)='9'
      
C-----------------------------------------------------------------------
C MANDATORY MADIS INITIALIZATION
C -----------------------------
C
C     Mandatory initialization which must be done before
C     any other MADIS library calls.
C
C     Initialize the MADIS surface subsystem
C     -------------------------------------
C
C     The user selects the "subsystem" to be initialized by
C     specifying the following arguments to the MINIT call:
C
C     1) Name of the subsystem:
C
C        'SFC'        Surface                 (used here)
C        'RAOB'       Radiosonde
C        'NPN'        NOAA Profiler Network
C        'ACARS'      Aircraft data (ACARS, AMDARS, etc.)
C        'ACARSP'     Aircraft data profiles at airports
C        'MAP'        Multi-Agency Profilers
C        'HYDRO'      Hydro
C        'RDMTR'      Radiometer
C        'SATWND'     Satellite wind
C        'SATSND'     Satellite soundings
C        'SATRAD'     Satellite radiance
C        'SNOW'       Snow
C        'WISDOM'     Wisdom balloon wind
C
C     2) Name of the database:
C
C        'FSL'        Data obtained from FSL
C        'AWIPS'      Data obtained from AWIPS
C
C        Note that the list of variables with QC found in the MADIS
C        documentation applies to the FSL database.  For the AWIPS
C        database, the only QC is on sfc mesonet data.  Otherwise, the
C        QC information returned by API calls will indicate that no
C        QC has been applied.
C
C     3) Error handling (.true./.false.):
C
C        If ".true.", then error messages will be written to standard
C        output.  If ".false.", no error messages will be output (but
C        ISTATUS will still contain an error code).  The error codes
C        can be found in errors.txt in the doc directory.

C     PAR FILE INPUT:  Database ('FSL' or 'AWIPS')

C     The necessary inputs are found in the parameter file, along with
C     a number of lines of explanation, section delimiters, etc. meant
C     to aid readability.  Throughout this program, we'll be skipping
C     non-input lines, reading necessary inputs, and checking for I/O
C     errors.  Otherwise, the validity of most of user's choices will
C     be tested by the affected MADIS library routines.  Invalid choices
C     will be reported to standard output, and in most cases, the
C     program will then stop.

      line = 0
      do i = 1, 3
         line = line + 1
         read(2,*,err=825,end=850)
      enddo
      line = line + 1
      read(2,145,err=825,end=850)db
 145  format(a)

      write(*,500)'MADIS SFCDUMP Activity Log'
 500  format(1x,a)
      write(*,500)'--------------------------'

      write(*,501)'Database'
 501  format(/,1x,a)
      write(*,401)db
 401  format(3x,a)

      CALL MINIT('SFC',db,.true.,istatus)
      if(istatus.ne.success_p)stop

C-----------------------------------------------------------------------
C OPTIONAL MADIS SETUP CALLS
C -------------------------
C
C     Optional calls to limit which obs MADIS will return.
C     These can be selected at any time in the code,
C     and will then take effect upon the next call to
C     MSFCSTA (see below).  The default behavior (what
C     happens if you don't call the routine) is described
C     below.
C
C     Select time window
C     ------------------
C
C     The user selects the nominal time of the data to be returned
C     when using MADIS routines to read obs and station information.
C     Time "windowing" is used so that the MADIS routines will
C     know how close in time each station's observation time needs
C     to be to the nominal time in order to be included, and whether
C     or not duplicate records from the same station that are within
C     the time window should be included.  The time window is
C     specified with the MSETWIN subroutine, which allows the user
C     to select the number of minutes before and after the nominal
C     time to be used for the window, and how duplicates should
C     be handled.  For more details, see msetwin.txt in the doc 
C     directory.
C
C     If MSETWIN is not called, the default will be to return all
C     records (including multiple reports from the same station)
C     in the file containing the nominal time.  For non-mesonet
C     stations, this will return observation times between 15
C     minutes before the hour and 44 minutes after the hour.  For
C     mesonet stations, data will cover from the hour until 59
C     minutes after the hour.
C
C     Surface stations report observation times around the hour, and 
C     many stations report multiple times per hour, so different
C     time window specifications can produce very different sets
C     of data.
C
C     The following sample MSETWIN call will return only one record 
C     per station within the specified time window (-30 minutes -->
C     nominal time --> +30 minutes).  If a station has multiple reports
C     within the time window, only the latest one within the window
C     will be returned (RECWIN = 3).
C
C     Sample MSETWIN call:
C
C     minbck = -30
C     minfwd = 30
C     recwin = 3
C     CALL MSETWIN(minbck,minfwd,recwin,istatus)

C     PAR FILE INPUT:  Time window parameters (minbck, minfwd, recwin)
C                      [set all to 0 for default]
      do i = 1, 3
         line = line + 1
         read(2,*,err=825,end=850)
      enddo
      line = line + 1
      read(2,*,err=825,end=850)minbck
      line = line + 1
      read(2,*,err=825,end=850)minfwd
      line = line + 1
      read(2,*,err=825,end=850)recwin

      write(*,501)'Time Window'

      if(recwin.ge.0.and.recwin.le.4)then

         write(*,401)twstr(recwin)(1:twstrlen(recwin))

         if(minbck.ne.0.or.minfwd.ne.0.or.recwin.ne.0)then

            write(*,502)'Start minute relative to nominal time ',minbck
 502        format(3x,a,i4)
            write(*,502)'End minute relative to nominal time   ',minfwd

            CALL MSETWIN(minbck,minfwd,recwin,istatus)
            if(istatus.ne.success_p)stop

         endif

      else

         write(*,500)'SFCDUMP: INVALID WINDOW RECORD TYPE'
         stop

      endif

C     Select a subset of surface datasets
C     -----------------------------------
C
C     Surface datasets include many different networks run
C     by different "providers".  The MSETSFCPVDR subroutine
C     can be used to select only a subset of the total by
C     specifying which providers are to be included or
C     excluded.
C
C     If MSETSFCPVDR is not called, the default is to enable
C     data from all surface providers.
C
C     Here's the list of provider names recognized by MADIS:
C
C     'ALL-SFC'   All surface providers
C     'ALL-MESO'  All mesonet providers
C     'ALL-MTR'   All METAR reports
C     'ASOS'      ASOS METAR reports (NWS & FAA)
C     'OTHER-MTR' Non-ASOS METAR reports
C     'SAO'       SAO reports 
C     'MARITIME'  Buoys, ships, C-MAN stations
C     'COOP'      Modernized NWS Cooperative Observer stations
C     'UrbaNet'   Urban network
C     'ALL-HFMTR' All high frequency METAR reports
C     'ASOS-AFM'  ASOS high frequency METAR reports (NWS & FAA)
C     'OTHER-AFM' Non-ASOS high frequency METAR reports
C
C     For a list of the provider names for mesonets that are 
C     currently available from FSL, see:
C
C        http://madis.noaa.gov/mesonet_providers.html
C
C     For AWIPS users, the "Data provider" specified for each mesonet
C     in the /data/fxa/LDAD/data/*.desc files is what's used for
C     the MADIS provider name.
C
C     Here's an example of how to get only ASOS's.  First you
C     disable everything, then select the one(s) you want.
C
C     CALL MSETSFCPVDR('ALL-SFC',.false.,istatus)
C     CALL MSETSFCPVDR('ASOS',.true.,istatus)

C     PAR FILE INPUT:  Providers (0 - all providers, 
C                                 N - N lines of provider names follow)

      do i = 1, 7
         line = line + 1
         read(2,*,err=825,end=850)
      enddo
      line = line + 1
      read(2,*,err=825,end=850)ipvd
      line = line + 1
      read(2,*,err=825,end=850)

      write(*,501)'Providers'

      if(ipvd.gt.0)then

         CALL MSETSFCPVDR('ALL-SFC',.false.,istatus)
         
         do i = 1, ipvd

            line = line + 1
            read(2,145,err=825,end=850)pvdrnam
            CALL MSETSFCPVDR(pvdrnam,.true.,istatus)
            if(istatus.eq.success_p)write(*,401)pvdrnam

C     Note that we don't exit if bad status is returned by MSETSFCPVDR.
C     This is because you might have chosen a provider name from the
C     MADIS web site that hasn't yet been entered into the internal
C     table kept by MADIS on your system.  The internal table will
C     be automatically updated with new providers as they appear in
C     data files obtained from FSL.

         enddo

      else if(ipvd.eq.0)then

         write(*,401)'ALL-SFC'

      else

         write(*,500)'SFCDUMP: INVALID PROVIDER SELECTION'
         stop

      endif

C     Select a horizontal domain
C     --------------------------
C
C     The horizontal domain can be limited to match one of two map
C     projections (polar stereographic, Lambert conformal conic) or it
C     can be limited to a latitude/longitude rectangle.  Only stations
C     within the domain will be returned.  If one of the map projections
C     is selected, any winds (of any form) returned by subsequent
C     MGETSFC calls will be rotated to match the projection.  See
C     msetdom.txt in the doc directory for an explanation of the 
C     parameters needed to define the domains.
C
C     If MSETDOM is not called, all available stations will be
C     returned, regardless of their location.
C
C     The example given here is for the CONUS 212 Lambert conformal 
C     conic projection.  
C
C     CALL MSETDOM(3,40635.25,12.19,-133.459,-95.0,25.0,25.0,dummy,
C    1             185,129,istatus)

C     PAR FILE INPUT:  Domain Filter (0 - don't filter, 
C                                     1 - lat/lon corners,
C                                     2 - Polar Stereographic grid,
C                                     3 - Lambert Conformal Conic grid)

      do i = 1, 3
         line = line + 1
         read(2,*,err=825,end=850)
      enddo

      line = line + 1
      read(2,*,err=825,end=850)idmtyp

C     We'll read in the parameters appropriate for the selected
C     domain filter, and skip over all of the other lines in the
C     rest of this section of the parameter file.

      write(*,501)'Domain Filter'

      if(idmtyp.eq.1)then

         do i = 1, 6
            line = line + 1
            read(2,*,err=825,end=850)
         enddo
         do i = 1, 4
            line = line + 1
            read(2,*,err=825,end=850)rpar(i)
         enddo
         do i = 1, 23
            line = line + 1
            read(2,*,err=825,end=850)
         enddo

         write(*,401)'Latitude/Longitude Corners'
         write(*,402)'SW corner latitude (north)                 ',
     1               rpar(1)
 402     format(3x,a,f13.6)
         write(*,402)'SW corner longitude (east)                 ',
     1               rpar(2)
         write(*,402)'NE corner latitude (north)                 ',
     1               rpar(3)
         write(*,402)'NE corner longitude (east)                 ',
     1               rpar(4)

         CALL MSETDOM(idmtyp,rpar(1),rpar(2),rpar(3),rpar(4),dummy,
     1                dummy,dummy,idummy,idummy,istatus)

      else if(idmtyp.eq.2)then

         do i = 1, 13
            line = line + 1
            read(2,*,err=825,end=850)
         enddo
         do i = 1, 7
            line = line + 1
            read(2,*,err=825,end=850)rpar(i)
         enddo
         do i = 1, 2
            line = line + 1
            read(2,*,err=825,end=850)ipar(i)
         enddo
         do i = 1, 11
            line = line + 1
            read(2,*,err=825,end=850)
         enddo

         write(*,401)'Polar Stereographic Grid'
         write(*,402)'Grid box size (meters)                     ',
     1               rpar(1)
         write(*,402)'Latitude (north) of 1st grid point         ',
     1               rpar(2)
         write(*,402)'Longitude (east) of 1st grid point         ',
     1               rpar(3)
         write(*,402)'Orientation longitude (east)               ',
     1               rpar(4)
         write(*,402)'I-coordinate of pole                       ',
     1               rpar(5)
         write(*,402)'J-coordinate of pole                       ',
     1               rpar(6)
         write(*,402)'Latitude (north) at which X-Y scale is true',
     1               rpar(7)
         write(*,403)'Number of grid points (X)                  ',
     1               ipar(1)
         write(*,403)'Number of grid points (Y)                  ',
     1               ipar(2)
 403     format(3x,a,i6)   

         CALL MSETDOM(idmtyp,rpar(1),rpar(2),rpar(3),rpar(4),rpar(5),
     1                rpar(6),rpar(7),ipar(1),ipar(2),istatus)

      else if(idmtyp.eq.3)then

         do i = 1, 25
            line = line + 1
            read(2,*,err=825,end=850)
         enddo
         do i = 1, 6
            line = line + 1
            read(2,*,err=825,end=850)rpar(i)
         enddo
         do i = 1, 2
            line = line + 1
            read(2,*,err=825,end=850)ipar(i)
         enddo

         write(*,401)'Lambert Conformal Conic Grid'
         write(*,402)'Grid box size (meters)                     ',
     1               rpar(1)
         write(*,402)'Latitude (north) of 1st grid point         ',
     1               rpar(2)
         write(*,402)'Longitude (east) of 1st grid point         ',
     1               rpar(3)
         write(*,402)'Orientation longitude (east)               ',
     1               rpar(4)
         write(*,402)'Latitude (north) of 1st tangent            ',
     1               rpar(5)
         write(*,402)'Latitude (north) of 2nd tangent            ',
     1               rpar(6)
         write(*,403)'Number of grid points (X)                  ',
     1               ipar(1)
         write(*,403)'Number of grid points (Y)                  ',
     1               ipar(2)

         CALL MSETDOM(idmtyp,rpar(1),rpar(2),rpar(3),rpar(4),rpar(5),
     1                rpar(6),dummy,ipar(1),ipar(2),istatus)

      else if(idmtyp.eq.0)then

         write(*,401)'No Filter'

         do i = 1, 33
            line = line + 1
            read(2,*,err=825,end=850)
         enddo
         
      else

         write(*,500)'SFCDUMP: INVALID DOMAIN TYPE'
         stop

      endif
      if(istatus.ne.success_p)stop

C     Select QC level of data to be returned
C     --------------------------------------
C
C     The primary variables in all MADIS datasets have been screened
C     by automated quality control (QC) checks.  Different variables
C     have different levels of QC, or "stages", applied to them.
C     For example, temperature may have level 1 checks (validity),
C     level 2 checks (internal consistency, temporal consistency),
C     and level 3 checks (spatial consistency).  Note that each
C     level of QC incorporates the previous levels, i.e., an ob
C     that has passed level 3 has also passed any applicable level
C     1 and 2 checks.  See sfc_qc_variable_list.txt in the doc 
C     directory for more information.
C
C     Each call to MGETSFC will return obs and associated QC
C     information.  If the user doesn't want to interpret the QC info,
C     he or she can limit the returned obs to selectable levels of
C     quality.  In that case, obs that don't meet the selected QC level
C     will be replaced with missing data flags, and the QC information
C     itself doesn't need to be examined by the calling program.
C
C     If MSETQC is not called, all obs will be returned (along with QC
C     info).
C
C     There are three ways that the user can request and process the QC 
C     information:
C
C     1) Don't call MSETQC at all, and examine the QC info before
C        deciding whether or not to use each observation.  This
C        allows the calling program the maximum amount of control
C        over what's available.
C
C     2) If you know ahead of time that the same level of QC is
C        available for all variables you'll be using, call MSETQC
C        one time to select the desired QC level.  Note that the
C        level selected by MSETQC will stay in effect until the
C        next time MSETQC is called.
C
C     3) To require that all variables pass the highest level
C        of QC that are specified for them, call MSETQC one time
C        and select QC level 99.
C
C     User's of MADIS data who want the data filtered by QC results,
C     but don't want to interpret the QC information themselves, should 
C     call MSETQC one time and select QC level 99.

C     PAR FILE INPUT:  QC level (0-none, 1-coarse, 2-screened, 
C                                3-verified, 99-highest possible)
      do i = 1, 3
         line = line + 1
         read(2,*,err=825,end=850)
      enddo
      line = line + 1
      read(2,*,err=825,end=850)qctyp

      write(*,501)'QC Filter'
      if(qctyp.ge.0.and.qctyp.le.3)then
         write(*,401)qcstr(qctyp)
      else if(qctyp.eq.99)then
         write(*,401)'Highest Possible'
      else
         write(*,500)'SFCDUMP: INVALID QC TYPE'
         stop
      endif
      if(db(1:5).eq.'AWIPS'.and.qctyp.ne.0)
     1   write(*,401)'AWIPS database - QC will only be available on '//
     2               'mesonet data'

C     Select the QC level to be returned.

      CALL MSETQC(qctyp,istatus)
      if(istatus.ne.success_p)stop

C-----------------------------------------------------------------------
C SELECT NOMINAL TIME OF DATA TO BE RETURNED 
C ------------------------------------------
C
C     The MADIS library's native time zone and format is Universal 
C     Coordinated Time, using a Julian date, in the form of "YYJJJHHMM", 
C     where:
C
C     YY  = 2-digit year (good from 1980 - 2179)
C     JJJ = Julian date of the year (001-366)
C     HH  = Hour (00-23)
C     MM  = Minute (00-59)
C
C     MADIS also provides support for a "Month/Day" date format, using
C     "YYYYMMDD_HHMM", where:
C
C     YYYY = 4-digit year (still only good from 1980 - 2179)
C     MMDD = Month/Day 
C     HHMM = Hour/Minute 
C
C     The MADIS library includes a basic set of routines that the caller
C     can use to:
C
C     - Add & subtract time in the native format.  (MCHGTIM)
C     - Translate the native format to integers representing year, 
C       month, day, hour, and minute.  (MINTTIM)
C     - Translate integers representing year, month, day, hour and
C       minute into the native format.  (MCHRTIM)
C     - Translate between Julian and Month/Day formats (MTRNTIM)
C
C     See time_routines.txt in the doc directory for details on how 
C     to use these calls.
C
C     Also note that nominal times can be specified at any minute, not
C     just at the top of the hour (minute 00).

C     PAR FILE INPUT:  Time format to use (0 - Julian, 1 - Month/Day)
      
      write(*,501)'Nominal Time'

      do i = 1, 7
         line = line + 1
         read(2,*,err=825,end=850)
      enddo
      line = line + 1
      read(2,*,err=825,end=850)tform
      if(tform.ne.0.and.tform.ne.1)then
         write(*,500)'SFCDUMP: INVALID TIME TRANSLATION FORMAT'
         stop
      endif

C     PAR FILE INPUT:  Nominal time (0 - specified in par file,
C                                    1 - use current time)

      line = line + 1
      read(2,*,err=825,end=850)
      line = line + 1
      read(2,*,err=825,end=850)ctime
      line = line + 1
      read(2,*,err=825,end=850)

C     PAR FILE INPUT:  Nominal time (in selected format)

      line = line + 1
      read(2,144,err=825,end=850)tstr
 144  format(a)

C     If the user wants to use the current time, get it and translate 
C     that into the chosen format (via our internal formats).  
C     Otherwise we have the chosen format in TSTR right now.

      if(ctime.eq.1)then
         i = TIME()
         i = i - 1325376000
         CALL M_MKFNAM(i,atime,istatus)
         if(tform.eq.1)then
            CALL MTRNTIM(atime,2,tstr,istatus)
         else
            tstr = atime
         endif
      endif

      if(tform.eq.1)then
         CALL MTRNTIM(tstr,1,atime,istatus)
         if(istatus.ne.success_p)stop
      else
         atime = tstr
      endif

      write(*,401)tstr

C-----------------------------------------------------------------------
C ADDITIONAL DUMP PROGRAM OPTIONS
C -------------------------------
C
C     For most purposes, you'll want to read data for all stations
C     that meet the criteria already specified above.  For dump program
C     purposes, however, we offer the option to only get one station.

      write(*,501)'Station Selection'

C     PAR FILE INPUT:  Station Selection (0 - all stations, 1 - single)

      do i = 1, 3
         line = line + 1
         read(2,*,err=825,end=850)
      enddo

      line = line + 1
      read(2,*,err=825,end=850)ising
      line = line + 1
      read(2,*,err=825,end=850)
      line = line + 1
      read(2,144,err=825,end=850)singsta
      
      if(ising.eq.1)then
         write(*,401)singsta
      else
         write(*,401)'All stations'
      endif

C     To allow backward compatibility for the sfcdump.par files that
C     users may have developed before the Output Options section of
C     the parameter file was available, we'll determine which section
C     we encounter next in the parameter file, then proceed accordingly.

      line = line + 1
      read(2,*,err=825,end=850)

      line = line + 1
      read(2,144,err=825,end=850)header
      if(index(header,'Output Options').ne.0)then

C     The latitude and longitude can either be output using two digits
C     after the decimal point (the original setting prior to adding 
C     this option) or the full 7-digits of possible precision can be 
C     selected.  This means latitude will have 5 digits after the
C     decimal point and longitude 4 digits.
C     
C     PAR FILE INPUT:  Latitude/longitude format

         line = line + 1
         read(2,*,err=825,end=850)

         line = line + 1
         read(2,*,err=825,end=850)ilatlon
         if(ilatlon.eq.0)then
            write(*,501)'Lat/lon with 2 digits after decimal place'
         else if(ilatlon.eq.1)then
            write(*,501)'Lat with 5 digits after decimal place, lon',
     1                ' with 4 digits'
         else
            write(*,500)'SFCDUMP: INVALID LAT/LON OUTPUT TYPE'
            stop
         endif

         do i = 1, 1
            line = line + 1
            read(2,145,err=825,end=850)tmpline
         enddo

C 1 - CHECK OUTPUT OPTIONS SET BEFORE CHECKING TEXT/XML FORMAT
C 2 - CHECK FOR BLANK LINE BEFORE GOING ON

C     To allow backward compatibility for the sfcdump.par files that
C     users may have developed before the Output Options section of
C     the parameter file was available, we'll determine which section
C     we encounter next in the parameter file, then proceed accordingly.
C     Decide output format of text or XML.

         line = line + 1
         read(2,145,err=825,end=850)tmpline
         j = M_LSTCHR(tmpline,LEN(tmpline))
         if(j.GT.0)then
            itextxml = 0
            do i = 1, 2
               line = line + 1
               read(2,*,err=825,end=850)
            enddo
            write(*,501)'No text output format, set to text format.'
         else
            line = line + 1
            itextxml_ext = 0
            read(2,*,err=825,end=850)itextxml
            if(itextxml.eq.0)then
               write(*,501)'Text output format (original format)'
            else if(itextxml.eq.1)then
               write(*,501)'XML output format'
            else if(itextxml.eq.2)then
               write(*,501)'Comma-separated-variable (CSV) '//
     1              'text output without QC info'
            else if(itextxml.eq.3)then
               write(*,501)'CSV text output with QC data descriptors'
            else if(itextxml.eq.4)then
               write(*,501)'CSV text output with full QC information'
            else if(itextxml.eq.5)then
               write(*,501)'CSV text output with headers and '//
     1              'QC data descriptors'
               itextxml_ext = 5
               itextxml = 3
            else if(itextxml.eq.6)then
               write(*,501)'CSV text output with headers and '//
     1              'full QC information'
               itextxml_ext = 6
               itextxml = 4
            else if(itextxml.eq.7)then
               write(*,501)'CSV text output with headers and '//
     1              'QC data descriptors'
               itextxml_ext = 7
               itextxml = 3
            else if(itextxml.eq.8)then
               write(*,501)'CSV text output with headers and '//
     1              'full QC information'
               itextxml_ext = 8
               itextxml = 4
            else
               write(*,500)'SFCDUMP: INVALID TEXT/XML OUTPUT FORMAT'
               stop
            endif

C Skip xml output format info line

            line = line + 1
            read(2,*,err=825,end=850)


C 1 - CHECK FOR CSV INFO LINES, FORMAT CHANGE
C     To allow backward compatibility for the sfcdump.par files that
C     users may have developed before the Output Options section of
C     the parameter file was enlarged, we'll determine if their are CSV 
C     info lines, then proceed accordingly.

            line = line + 1
            read(2,145,err=825,end=850)tmpline
            j = index(tmpline,'---------')

C First CSV format check, normal par file

            if(j.EQ.0)then
               line = line + 1
               read(2,*,err=825,end=850)
               line = line + 1
               read(2,*,err=825,end=850)

               line = line + 1
               read(2,145,err=825,end=850)tmpline
C Check for Extended CSV version
               j2 = index(tmpline,'5 - Extended')
               if(j2.gt.0)then
                  line = line + 1
                  read(2,*,err=825,end=850)
                  line = line + 1
                  read(2,*,err=825,end=850)
                  line = line + 1
                  read(2,*,err=825,end=850)
                  line = line + 1
                  read(2,145,err=825,end=850)tmpline
               endif
               j = M_LSTCHR(tmpline,LEN(tmpline))
C Variable showed up where we should have a blank line, must 
C be an old format

               if(j.EQ.0)then

                  line = line + 1
               
                  read(2,*,err=825,end=850)imissval
                  if(itextxml.ge.2.and.itextxml.le.4.)then
                     if(imissval.eq.0)then
                        write(*,501)'Using -99999.000000 for missing '//
     1                       'fields'
                     else if(imissval.eq.1)then
                        write(*,501)'Using blanks for missing fields'
                     else
                        write(*,500)'SFCDUMP: INVALID CSV MISSING '//
     1                       'FIELD VALUE'
                        stop
                     endif
                  endif
                  do i = 1, 4
                     line = line + 1
                     read(2,*,err=825,end=850)
                  enddo
               else

C We read a variable line, so reset for next section

                  backspace(2)
               endif
            else
               do i = 1, 2
                  line = line + 1
                  read(2,*,err=825,end=850)
               enddo

            endif

         endif

      else

         ilatlon = 0

         line = line + 1
         read(2,*,err=825,end=850)

      endif




C-----------------------------------------------------------------------
C LOAD IN STATION INFO FOR SELECTED DATA
C --------------------------------------
C
C     Load in the stations for all selected datasets, covering
C     the selected domain.  The MSFCSTA call needs to be done
C     as the first call when getting data for a new time, or
C     whenever any of the optional setup calls are used.  Thereafter, 
C     MGETSFC and MGETSFCC can be called as many times as desired in 
C     order to read variables.

      CALL MSFCSTA(atime,nsta,stanam,wmoid,lat,lon,elev,timeob,
     1             provdr,istatus,source_n)

      if(istatus.ne.success_p)stop

C     If one of the map projections has been selected for the horizontal
C     domain, the station latitude and longitude can be converted to a 
C     floating point grid index into the 2-dimensional grid (RI,RJ).  
C     Note that this works for grids laid out this way:
C
C                        NE (I=NX,J=NY)
C
C     SW (I=1,J=1)
C
C     If we're to convert LAT/LON to RI,RJ for the user's grid, do
C     so.  Otherwise, fill in 0's so there'll be something in the
C     output line that isn't too messy.

      if(idmtyp.eq.2.or.idmtyp.eq.3)then

         do i = 1, nsta
            CALL MGETIJ(lat(i),lon(i),ri(i),rj(i),istatus)
         enddo
         
      else

         do i = 1, nsta
            ri(i) = 0
            rj(i) = 0
         enddo

      endif

C-----------------------------------------------------------------------
C LOOP THROUGH DESIRED VARIABLES:
C -------------------------------
C
C     Variables are specified by code names.  The list of code names
C     can be found in the first column of sfc_variable_list.txt in the
C     doc directory.
C
C     This program will read in one variable code per line in the
C     parameter file, read it, output it, then move on to the next
C     variable until the end of the parameter file is reached.

      write(*,501)'Variables'

C     Header for XML file
      if(itextxml.eq.1)then
         write(1,8005)
 8005    format('<?xml version="1.0" ?><mesonet>')
      endif

C
C     CSV output
C
      if(itextxml.gt.1)goto 34000

C
C    TEXTXML Option 0 (text) and 1 (xml)
C

C     PAR FILE INPUT:  Variable code 

 100  read(2,145,err=825,end=900)vcode
      if(vcode.eq.'       ')go to 100

C     The internal MGETVCN routine is used to determine the type
C     (numeric or character) of the variable.  In general, a user's
C     MADIS program shouldn't have to make this determination
C     (as you would know what variables you're reading).

      CALL MGETVCN(vcode,vcn,vtype,istatus)
      if(istatus.ne.success_p)go to 900

      write(*,505)vcode
 505  format(3x,'Processing',5x,a)


      vce = M_LSTCHR(vcode,LEN(vcode))



C     Read the desired variable and QC info.  The returned arrays
C     will match the records in the station info arrays returned
C     from MSFCSTA.  If a QC level has been selected, the obs will
C     only be returned if they meet or exceed the selected QC
C     level.

      if(vtype.eq.'N')then

C     The MGETSFC routine is used to read all numeric variables.
C     All variables are returned as Fortran REAL type (RDATA), the
C     QC data descriptors are always CHARACTER*1 (QCD), and the
C     bit maps showing the QC checks that were applied (QCA) and
C     their results (QCR) are always INTEGER.

         CALL MGETSFC(atime,vcode,nsta,nobs,rdata,qcd,qca,qcr,istatus)

         if(itextxml.eq.1)then
            if(istatus.ne.success_p.or.nobs.eq.0)go to 100
         else

            write(1,146)'var ',vcode,' total stns ',nsta,
     1           ' # non-missing obs ',nobs
 146        format(/,1x,a,a,a,i6,a,i6)
            if(istatus.ne.success_p.or.nobs.eq.0)go to 100

C     Output the station info, the variable and its QC.


            write(1,*)
            if(ilatlon.ne.1)then
               write(1,6001)vcode
 6001          format(11x,'Station     Elev(m) Lat(N)  Lon(E)  Grid I',
     1              '   Grid J    ObTime     Provider       ',a,
     2              ' QCD QCA QCR',/)
            else
               write(1,6003)vcode
 6003          format(11x,'Station     Elev(m) Lat(N)     Lon(E)    ',
     1              'Grid I   Grid J    ObTime     Provider       ',a,
     2              ' QCD QCA QCR',/)
            endif
         endif

         do 200 i = 1, nsta

C     If we're getting only one station, make sure this is it.

            if(ising.eq.1.and.singsta.ne.stanam(i))go to 200
C Check for bogus elevation
            if(elev(i) .le. minelev)go to 200
C     XML formats
            if(itextxml.eq.1)then

               CALL MTRNTIM(timeob(i),2,tstr2,istatus)
C     XML time format is YYY-MM-DDTHH:MM  -- 2004-06-04T16:01  
               xmltstr = tstr2(1:4)//'-'//tstr2(5:6)//'-'//
     1              tstr2(7:8)//'T'//tstr2(10:11)//':'//
     2              tstr2(12:13)
               
 147           format(i3)
 148           format(f6.1)
 149           format(f6.2)
 150           format(f7.2)
 151           format(f9.4)
 152           format(f9.5)
 153           format(f7.0)
 154           format(f13.6)
               
C     Elevation
               write(celev,150)elev(i)
               es = M_FRTCHR(celev,LEN(celev))
               ee = M_LSTCHR(celev,LEN(celev))
C     Provider
               pe = M_LSTCHR(provdr(i),LEN(provdr(i)))
C     Station
               se = M_LSTCHR(stanam(i),LEN(stanam(i)))

               if(ilatlon.ne.1)then
C     Latitude
                  write(clat,149)lat(i)
                  lts = M_FRTCHR(clat,LEN(clat))
                  lte = M_LSTCHR(clat,LEN(clat))
C     Longitude
                  write(clon,150)lon(i)
                  lns = M_FRTCHR(clon,LEN(clon))
                  lne = M_LSTCHR(clon,LEN(clon))
               else
C     Latitude
                  write(clat,152)lat(i)
                  lts = M_FRTCHR(clat,LEN(clat))
                  lte = M_LSTCHR(clat,LEN(clat))
C     Longitude
                  write(clon,151)lon(i)
                  lns = M_FRTCHR(clon,LEN(clon))
                  lne = M_LSTCHR(clon,LEN(clon))
               endif

            else
               if(tform.eq.0)then

                  tstr = '  '//timeob(i)

               else if(tform.eq.1)then

                  CALL MTRNTIM(timeob(i),2,tstr,istatus)

               endif
            endif



C     Only output records for non-missing obs.


            if(rdata(i).ne.miss_p.and.vcode.ne.'SKYCVLB'.and.
     1         vcode.ne.'PCPINT'.and.vcode.ne.'PCPTYPE'
     2           .and. rdata(i).le. 999999.9
     2           .and. rdata(i).ge. -99999.9)then

               if(itextxml.eq.1)then
C     Data value
                  write(cdv,154)rdata(i)
                  dvs = M_FRTCHR(cdv,LEN(cdv))
                  dve = M_LSTCHR(cdv,LEN(cdv))

C     QCA
                  write(cqca,147)qca(i)
                  qcas = M_FRTCHR(cqca,LEN(cqca))
                  qcae = M_LSTCHR(cqca,LEN(cqca))

C     QCR
                  write(cqcr,147)qcr(i)
                  qcrs = M_FRTCHR(cqcr,LEN(cqcr))
                  qcre = M_LSTCHR(cqcr,LEN(cqcr))

                  write(1,8002)vcode(1:vce),stanam(i)(1:se),
     1                 celev(es:ee),clat(lts:lte),clon(lns:lne),
     2                 xmltstr,provdr(i)(1:pe),
     3                 cdv(dvs:dve),qcd(i),cqca(qcas:qcae),
     4                 cqcr(qcrs:qcre)
 8002             format('<record var="V-',a,'" shef_id="',a,
     1                 '" elev="',a,'" lat="',a,'" lon="',
     2                 a,'" ObTime="',a,'" provider="',a,
     3                 '" data_value="',a,'" QCD="',a,'" QCA="',
     4                 a,'" QCR="',a,'" />')
               else
                  if(ilatlon.ne.1)then
                     write(1,7001)vcode,stanam(i),elev(i),lat(i),lon(i),
     1                    ri(i),rj(i),tstr,provdr(i),rdata(i),
     2                    qcd(i),qca(i),qcr(i)
 7001                format(1x,'V-',a,1x,a,1x,f7.2,1x,f6.2,1x,f7.2,1x,
     1                    2(f8.3,1x),a,1x,a,1x,f13.6,1x,a1,1x,i3,1x,i3)
                  else
                     write(1,7011)vcode,stanam(i),elev(i),lat(i),lon(i),
     1                    ri(i),rj(i),tstr,provdr(i),rdata(i),
     2                    qcd(i),qca(i),qcr(i)
 7011                format(1x,'V-',a,1x,a,1x,f7.2,1x,f9.5,1x,f9.4,1x,
     1                    2(f8.3,1x),a,1x,a,1x,f13.6,1x,a1,1x,i3,1x,i3)
                  endif
               endif

C XML OUTPUT SPECIAL CASES SKY... 

            else if(vcode.eq.'SKYCVLB')then

               do k = 1, 6
                  if(skycovlb(k,i).ne.miss_p
     2                 .and. skycovlb(k,i).lt. 999999.
     2                 .and. skycovlb(k,i).ge.0.0)then

                     if(itextxml.eq.1)then
                        do j=1, 6
                            if(skycovlb(j,i).lt.999999.)then
C     Data value
                               write(cdv,153)skycovlb(j,i)
                               dvs = M_FRTCHR(cdv,LEN(cdv))
                               dve = M_LSTCHR(cdv,LEN(cdv))
                           
C     QCA
                               write(cqca,147)qcasky(j,i)
                               qcas = M_FRTCHR(cqca,LEN(cqca))
                               qcae = M_LSTCHR(cqca,LEN(cqca))
                           
C     QCR
                               write(cqcr,147)qcrsky(j,i)
                               qcrs = M_FRTCHR(cqcr,LEN(cqcr))
                               qcre = M_LSTCHR(cqcr,LEN(cqcr))
                               
                               write(1,8002)vcode(1:vce)//char(j+48),
     1                              stanam(i)(1:se),celev(es:ee),
     2                              clat(lts:lte),clon(lns:lne),xmltstr,
     3                              provdr(i)(1:pe),cdv(dvs:dve),
     4                              qcdsky(j,i),cqca(qcas:qcae),
     5                              cqcr(qcrs:qcre)
                            endif
                         enddo
                      else
                        if(ilatlon.ne.1)then
                           write(1,7003)vcode,stanam(i),elev(i),lat(i),
     1                          lon(i),ri(i),rj(i),tstr,provdr(i),
     2                          (skycovlb(j,i),qcdsky(j,i),
     3                          qcasky(j,i),qcrsky(j,i),j=1,6)
 7003                      format(1x,'V-',a,1x,a,1x,f7.2,1x,f6.2,1x,
     1                          f7.2,1x,2(f8.3,1x),a,1x,a,6(1x,f7.0,1x,
     2                          a1,1x,i3,1x,i3))
                        else
                           write(1,7013)vcode,stanam(i),elev(i),lat(i),
     1                          lon(i),ri(i),rj(i),tstr,provdr(i),
     2                          (skycovlb(j,i),qcdsky(j,i),
     3                          qcasky(j,i),qcrsky(j,i),j=1,6)
 7013                      format(1x,'V-',a,1x,a,1x,f7.2,1x,f9.5,1x,
     1                          f9.4,1x,2(f8.3,1x),a,1x,a,6(1x,f7.0,1x,
     2                          a1,1x,i3,1x,i3))
                        endif
                     endif
                     go to 200
                  endif
               enddo

            else if(vcode.eq.'PCPINT'.or.vcode.eq.'PCPTYPE')then

               do k = 1, 2
                  if(pcpvar(k,i).ne.miss_p)then
                     if(itextxml.eq.1)then

                        do j=1, 2

C     Data value
                           write(cdv,153)pcpvar(j,i)
                           dvs = M_FRTCHR(cdv,LEN(cdv))
                           dve = M_LSTCHR(cdv,LEN(cdv))
                           
C     QCA
                           write(cqca,147)qcapcp(j,i)
                           qcas = M_FRTCHR(cqca,LEN(cqca))
                           qcae = M_LSTCHR(cqca,LEN(cqca))
                           
C     QCR
                           write(cqcr,147)qcrpcp(j,i)
                           qcrs = M_FRTCHR(cqcr,LEN(cqcr))
                           qcre = M_LSTCHR(cqcr,LEN(cqcr))
                           
                           write(1,8002)vcode(1:vce)//char(j+48),
     1                          stanam(i)(1:se),celev(es:ee),
     2                          clat(lts:lte),clon(lns:lne),xmltstr,
     3                          provdr(i)(1:pe),cdv(dvs:dve),
     4                          qcdpcp(j,i),cqca(qcas:qcae),
     5                          cqcr(qcrs:qcre)
                        enddo

                     else
                        if(ilatlon.ne.1)then
                           write(1,7004)vcode,stanam(i),elev(i),lat(i),
     1                          lon(i),ri(i),rj(i),tstr,provdr(i),
     2                          (pcpvar(j,i),qcdpcp(j,i),
     3                          qcapcp(j,i),qcrpcp(j,i),j=1,2)
 7004                      format(1x,'V-',a,1x,a,1x,f7.2,1x,f6.2,1x,
     1                          f7.2,1x,2(f8.3,1x),a,1x,a,2(1x,f7.0,1x,
     2                          a1,1x,i3,1x,i3))
                        else
                           write(1,7014)vcode,stanam(i),elev(i),lat(i),
     1                          lon(i),ri(i),rj(i),tstr,provdr(i),
     2                          (pcpvar(j,i),qcdpcp(j,i),
     3                          qcapcp(j,i),qcrpcp(j,i),j=1,2)
 7014                      format(1x,'V-',a,1x,a,1x,f7.2,1x,f9.5,1x,
     1                          f9.4,1x,2(f8.3,1x),a,1x,a,2(1x,f7.0,1x,
     2                          a1,1x,i3,1x,i3))
                        endif
                     endif
                     go to 200
                  endif
               enddo

            endif

 200     continue

      else if(vtype.eq.'C')then

C     The MGETSFCC routine is used to read character variables.  No QC
C     is currently available for any of these variables.  Only two of
C     the character variables are actually observations (present weather
C     and sky cover).  The other character variables are metadata, e.g.,
C     METAR report types ("METAR", "SPECI", "TEST").  Note that there
C     are no missing data flags for character data, and therefore no
C     equivalent of the NOBS argument returned from MGETSFC; instead,
C     blanks are filled in where no genuine data exist.

         CALL MGETSFCC(atime,vcode,nsta,rawmtr,istatus)

         if(itextxml.ne.1)then
            write(1,146)'var ',vcode,' total stns ',nsta
            write(1,*)
         endif

         if(istatus.ne.success_p)go to 100

         if(itextxml.ne.1)then
            if(ilatlon.ne.1)then
               write(1,6002)vcode
 6002          format(11x,'Station     Elev(m) Lat(N)  Lon(E)  Grid I',
     1              '   Grid J    ObTime     Provider   ',a,/)
            else 
               write(1,6004)vcode
 6004          format(11x,'Station     Elev(m) Lat(N)     Lon(E)    ',
     1              'Grid I   Grid J    ObTime     Provider   ',a,/)
            endif
         endif

C     Output the station info and variable to the test output file.

         do 300 i = 1, nsta

C     If we're getting only one station, make sure this is it.

            if(ising.eq.1.and.singsta.ne.stanam(i))go to 300
C Check for bogus elevation
            if(elev(i) .le. minelev)go to 300


            if(itextxml.eq.1)then
C     XML formats

               CALL MTRNTIM(timeob(i),2,tstr2,istatus)
C     XML time format is YYY-MM-DDTHH:MM  -- 2004-06-04T16:01  
               xmltstr = tstr2(1:4)//'-'//tstr2(5:6)//'-'//
     1              tstr2(7:8)//'T'//tstr2(10:11)//':'//
     2              tstr2(12:13)
               
C     Elevation
               write(celev,150)elev(i)
               es = M_FRTCHR(celev,LEN(celev))
               ee = M_LSTCHR(celev,LEN(celev))
C     Provider
               pe = M_LSTCHR(provdr(i),LEN(provdr(i)))
C     Station
               se = M_LSTCHR(stanam(i),LEN(stanam(i)))

               if(ilatlon.ne.1)then
C     Latitude
                  write(clat,149)lat(i)
                  lts = M_FRTCHR(clat,LEN(clat))
                  lte = M_LSTCHR(clat,LEN(clat))
C     Longitude
                  write(clon,150)lon(i)
                  lns = M_FRTCHR(clon,LEN(clon))
                  lne = M_LSTCHR(clon,LEN(clon))
               else
C     Latitude
                  write(clat,152)lat(i)
                  lts = M_FRTCHR(clat,LEN(clat))
                  lte = M_LSTCHR(clat,LEN(clat))
C     Longitude
                  write(clon,151)lon(i)
                  lns = M_FRTCHR(clon,LEN(clon))
                  lne = M_LSTCHR(clon,LEN(clon))
               endif
            else
C     Use the time output format desired by the user.

               if(tform.eq.0)then

                  tstr = '  '//timeob(i)

               else if(tform.eq.1)then

                  CALL MTRNTIM(timeob(i),2,tstr,istatus)

               endif
            endif
C     Only output records where the string isn't all blank (missing).

            if(vcode.eq.'AUTOTYP'.or.vcode.eq.'REPTYPE')then

               if(M_LSTCHR(c6(i),6).ne.0)then

                  if(itextxml.eq.1)then

C     Data value
                     dvs = M_FRTCHR(c6(i),LEN(c6(i)))
                     dve = M_LSTCHR(c6(i),LEN(c6(i)))
                               
                     write(1,8003)vcode(1:vce),
     1                    stanam(i)(1:se),celev(es:ee),
     2                    clat(lts:lte),clon(lns:lne),xmltstr,
     3                    provdr(i)(1:pe),c6(i)(dvs:dve)
 8003                format('<record var="V-',a,'" shef_id="',a,
     1                 '" elev="',a,'" lat="',a,'" lon="',
     2                 a,'" ObTime="',a,'" provider="',a,
     3                 '" data_value="',a,'" />')
                  else
                     if(ilatlon.ne.1)then
                        write(1,7002)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),c6(i)
 7002                   format(1x,'V-',a,1x,a,1x,f7.2,1x,f6.2,1x,f7.2,
     1                       1x,2(f8.3,1x),a,1x,a,6(1x,a))
                     else
                        write(1,7012)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),c6(i)
 7012                   format(1x,'V-',a,1x,a,1x,f7.2,1x,f9.5,1x,f9.4,
     1                       1x,2(f8.3,1x),a,1x,a,6(1x,a))
                     endif
                  endif

               endif

            else if(vcode.eq.'PRESWEA')then

               dve = M_LSTCHR(preswea(i),LEN(preswea(i)))
               if(dve.ne.0)then

                  if(itextxml.eq.1)then
C     Data value
                     dvs = M_FRTCHR(preswea(i),LEN(preswea(i)))
                               
                     if(preswea(i)(dvs:dve) .ne. '-')
     1                    write(1,8003)vcode(1:vce),
     2                    stanam(i)(1:se),celev(es:ee),
     3                    clat(lts:lte),clon(lns:lne),xmltstr,
     4                    provdr(i)(1:pe),preswea(i)(dvs:dve)
                  else
                     if(ilatlon.ne.1)then
                        write(1,7002)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),
     2                       preswea(i)
                     else
                        write(1,7012)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),
     2                       preswea(i)
                     endif
                  endif

               endif

            else if(vcode.eq.'AUTORMK'.or.vcode.eq.'OPERRMK')then

               dve = M_LSTCHR(remark(i),LEN(remark(i)))
               if(dve.ne.0)then

                  if(itextxml.eq.1)then
C     Data value
                     dvs = M_FRTCHR(remark(i),LEN(remark(i)))
                               
                     write(1,8003)vcode(1:vce),
     1                    stanam(i)(1:se),celev(es:ee),
     2                    clat(lts:lte),clon(lns:lne),xmltstr,
     3                    provdr(i)(1:pe),remark(i)(dvs:dve)
                  else
                     if(ilatlon.ne.1)then
                        write(1,7002)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),
     2                       remark(i)
                     else
                        write(1,7012)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),
     2                       remark(i)
                     endif
                  endif

               endif

            else if(vcode.eq.'STALOC')then

               if(M_LSTCHR(staloc(i),51).ne.0)then

                  if(itextxml.eq.1)then
C     Data value
                     dvs = M_FRTCHR(staloc(i),LEN(staloc(i)))
                     dve = M_LSTCHR(staloc(i),LEN(staloc(i)))
                               
                     write(1,8003)vcode(1:vce),
     1                    stanam(i)(1:se),celev(es:ee),
     2                    clat(lts:lte),clon(lns:lne),xmltstr,
     3                    provdr(i)(1:pe),staloc(i)(dvs:dve)
                  else
                     if(ilatlon.ne.1)then
                        write(1,7002)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),staloc(i)
                     else
                        write(1,7012)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),staloc(i)
                     endif
                  endif

               endif

            else if(vcode.eq.'RAWMTR')then

               if(M_LSTCHR(rawmtr(i),256).ne.0)then

                  if(itextxml.eq.1)then
C     Data value
                     dvs = M_FRTCHR(rawmtr(i),LEN(rawmtr(i)))
                     dve = M_LSTCHR(rawmtr(i),LEN(rawmtr(i)))
                               
                     write(1,8003)vcode(1:vce),
     1                    stanam(i)(1:se),celev(es:ee),
     2                    clat(lts:lte),clon(lns:lne),xmltstr,
     3                    provdr(i)(1:pe),rawmtr(i)(dvs:dve)
                  else
                     if(ilatlon.ne.1)then
                        write(1,7002)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),rawmtr(i)
                     else
                        write(1,7012)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),rawmtr(i)
                     endif
                  endif

               endif

            else if(vcode.eq.'SUBPVDR')then

               if(M_LSTCHR(subpvdr(i),11).ne.0)then

                  if(itextxml.eq.1)then
C     Data value
                     dvs = M_FRTCHR(subpvdr(i),LEN(subpvdr(i)))
                     dve = M_LSTCHR(subpvdr(i),LEN(subpvdr(i)))
                               
                     write(1,8003)vcode(1:vce),
     1                    stanam(i)(1:se),celev(es:ee),
     2                    clat(lts:lte),clon(lns:lne),xmltstr,
     3                    provdr(i)(1:pe),subpvdr(i)(dvs:dve)
                  else
                     if(ilatlon.ne.1)then
                        write(1,7002)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),
     2                       subpvdr(i)
                     else
                        write(1,7012)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),
     2                       subpvdr(i)
                     endif
                  endif

               endif

            else if(vcode.eq.'SKYCOV ')then

               if(M_LSTCHR(skycover(1,i),48).ne.0)then

                  if(itextxml.eq.1)then
                     do j=1, 6
C     Data value
                        cdv = skycover(j,i)
                        dvs = M_FRTCHR(cdv,LEN(cdv))
                        dve = M_LSTCHR(cdv,LEN(cdv))
                           if(dve.ge.dvs)then
                              write(1,8003)vcode(1:vce)//char(j+48),
     1                             stanam(i)(1:se),celev(es:ee),
     2                             clat(lts:lte),clon(lns:lne),xmltstr,
     3                             provdr(i)(1:pe),cdv(dvs:dve)
                           endif
                     enddo
                  else
                     if(ilatlon.ne.1)then
                        write(1,7002)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),
     2                       (skycover(j,i),j=1,6)
                     else
                        write(1,7012)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),
     2                       (skycover(j,i),j=1,6)
                     endif
                  endif

               endif

            else if(vcode.eq.'T24MAXT'.or.vcode.eq.'T24MINT')then

C     Use the time output format desired by the user.

               if(tform.eq.0)then
 
                 tstr1 = '  '//c9(i)

               else if(tform.eq.1)then

                  CALL MTRNTIM(c9(i),2,tstr1,istatus)

               endif

               if(tstr1.ne.'             ')then

                  if(itextxml.eq.1)then
C     Data value
                     dvs = M_FRTCHR(tstr1,LEN(tstr1))
                     dve = M_LSTCHR(tstr1,LEN(tstr1))
                           
                     write(1,8003)vcode(1:vce),
     1                    stanam(i)(1:se),celev(es:ee),clat(lts:lte),
     2                    clon(lns:lne),xmltstr,provdr(i)(1:pe),
     3                    tstr1(dvs:dve)

                  else
                     if(ilatlon.ne.1)then
                        write(1,7002)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),tstr1
                     else
                        write(1,7012)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),tstr1
                     endif
                  endif

               endif

            else if(vcode.eq.'FOT15M'.or.vcode.eq.'LOT15M')then

C     Use the time output format desired by the user.

               if(tform.eq.0)then

                  tstr1 = '  '//c9(i)

               else if(tform.eq.1)then

                  CALL MTRNTIM(c9(i),2,tstr1,istatus)

               endif

               if(tstr1.ne.'             ')then

                  if(itextxml.eq.1)then
C     Data value
                     dvs = M_FRTCHR(tstr1,LEN(tstr1))
                     dve = M_LSTCHR(tstr1,LEN(tstr1))
                           
                     write(1,8003)vcode(1:vce),
     1                    stanam(i)(1:se),celev(es:ee),clat(lts:lte),
     2                    clon(lns:lne),xmltstr,provdr(i)(1:pe),
     3                    tstr1(dvs:dve)

                  else
                     if(ilatlon.ne.1)then
                        write(1,7002)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),tstr1
                     else
                        write(1,7012)vcode,stanam(i),elev(i),lat(i),
     1                       lon(i),ri(i),rj(i),tstr,provdr(i),tstr1
                     endif
                  endif

               endif

            endif

 300     continue

      endif

C     Process the next variable.

      go to 100

C
C     CSV output formats
C          options 3,4,5,6 for csv format with qc options

34000 continue

C
C     Save sub-provider for common description segment
C     "nstatot" totals should not be used, they are only for
C     data selections that include a mesonet site.
C  
      CALL MGETSFCC(atime,'SUBPVDR',nstatot,cdata,istatus)
      if(istatus.ne.success_p)then
         do i = 1,nsta
            subpvdr(i) = '           '
         enddo
      endif

 8011 format(',',f13.6)
 8012 format(',',f13.6,',',a1)
 8014 format(',',f13.6,',',a1,',',i3,',',i3)
 9010 format(a,',',a,',',a,',',a,',',a)
 9011 format(a,',',a,',',a,',',a,',',a,',',i3,',',i3)
 9051 format(',',a)
 9052 format(6(',',a))
 9053 format(2(',',a))

      numvcodes = 0
 701  read(2,145,err=955,end=950)vcode
      if(vcode.eq.'       ')go to 701
      numvcodes = numvcodes + 1
      vcodes(numvcodes) = vcode
      go to 701
 955  continue
      write(*,*)'Error reading vcode number: ',numvcodes+1
      goto 825
 950  continue
      if(numvcodes.eq.0)then
         write(*,*)'Error - No vcodes found. '
         goto 825
      endif


C The size of the string limits the number of vcodes
C Init size for name/data
      tmpsz = 50
      do ivcode = 1, numvcodes
         vcode = vcodes(ivcode)
         cursz = 0
            
         if(vcode.eq.'SKYCVLB')then
            if(itextxml.eq.2)then
               cursz = 14*6
            else if(itextxml.eq.3)then
               cursz = (14+2)*6
            else if(itextxml.eq.4)then
               cursz = (14+10)*6
            endif
         else if(vcode.eq.'PCPINT'.or.vcode.eq.'PCPTYPE')then
            if(itextxml.eq.2)then
               cursz = 14*2
            else if(itextxml.eq.3)then
               cursz = (14+2)*2
            else if(itextxml.eq.4)then
               cursz = (14+10)*2
            endif
         else if(vcode.eq.'AUTOTYP'.or.vcode.eq.'REPTYPE')then
            cursz = 7
         else if(vcode.eq.'PRESWEA')then
            cursz = 26
         else if(vcode.eq.'AUTORMK'.or.vcode.eq.'OPERRMK')then
            cursz = 81
         else if(vcode.eq.'STALOC')then
            cursz = 52
         else if(vcode.eq.'SUBPVDR')then
            cursz = 12
         else if(vcode.eq.'SKYCOV')then
            cursz = 52
         else if(vcode.eq.'T24MAXT'.or.vcode.eq.'T24MINT')then
            cursz = 14
         else if(vcode.eq.'FOT15M'.or.vcode.eq.'LOT15M')then
            cursz = 14
         else if(vcode.eq.'RAWMTR')then
            cursz = 256
C Only number are left
         else 
            if(itextxml.eq.2)then
               cursz = 14
            else if(itextxml.eq.3)then
               cursz = 14+2
            else if(itextxml.eq.4)then
               cursz = 14+10
            endif
         endif
         if(tmpsz+cursz.le.maxcsvsz)then
            maxcsvvar = ivcode
            tmpsz = tmpsz+cursz
         else
C     We are out of room to add any more variables
            go to 801
         endif
      enddo
 801  continue
      if(numvcodes.gt.maxcsvvar)then
         write(*,*)'Warn - CSV Variables limited to a line length of ',
     1        maxcsvsz,' This limits the variables to the first',
     1        maxcsvvar
         write(*,*)'Note -- Full QC information takes more space '//
     1        'than just QC data descriptors alone.  Also some '//
     2        ' variables need extra room like like AUTORMK, OPERRMK, '
     3        //'STALOC, SKYCOV, SKYCVLB, PCPINT, and PCPTYPE'

         numvcodes = maxcsvvar
      endif


C Missing string length
      if(imissval.eq.1)then
         mstr = ',             '
         mstrlen = 14
         if(itextxml.eq.3)then
            mstr = ',             ,Z'
            mstrlen = 16
            hdmstr = ',D'
            hdmstrlen = 2
         else if(itextxml.eq.4)then
            mstr = ',             ,Z,  0,  0'
            mstrlen = 24
            hdmstr = ',D,QCA,QCR'
            hdmstrlen = 10
         endif
      else
         mstr = ',-99999.000000'
         mstrlen = 14
         if(itextxml.eq.3)then
            mstr = ',-99999.000000,Z'
            mstrlen = 16
            hdmstr = ',D'
            hdmstrlen = 2
         else if(itextxml.eq.4)then
            mstr = ',-99999.000000,Z,  0,  0'
            mstrlen = 24
            hdmstr = ',D,QCA,QCR'
            hdmstrlen = 10
         endif
      endif


      csvstrheader = ''
      csvstrendlenheader = 0
      do 601 i = 1,nsta
         csvstrendlen(i) = 0
         access(i) = -1            
C     If we're getting only one station, make sure this is it.
            
         if(ising.eq.1.and.singsta.ne.stanam(i))go to 601
C Check for bogus elevation
            if(elev(i) .le. minelev)go to 601
C     Write station default info
         CALL MTRNTIM(timeob(i),2,tstr2,istatus)
C     XML time format is YYY-MM-DDTHH:MM  -- 2004-06-04T16:01  
         dstr = tstr2(5:6)//'/'//tstr2(7:8)//'/'//tstr2(1:4)
         hmstr = tstr2(10:11)//':'//tstr2(12:13)
         write(csvstr(i),9010)stanam(i),dstr,hmstr,provdr(i),
     1        subpvdr(i)
         stnhasdata(i) = .false.
         
         csvstrendlen(i) = 50
         if(itextxml_ext.gt.0)then
            if(i.eq.1)then
               if(itextxml_ext.eq.5.or.itextxml_ext.eq.6)then
                  csvstrendlenheader = 50
                  csvstrheader = 'STAID     ,OBDATE    ,OBTIME,'//
     1                 'PVDR     ,SUBPVDR    '
               else
                  csvstrendlenheader = 58
                  csvstrheader = 'STAID     ,OBDATE    ,OBTIME,'//
     1                 'PVDR     ,SUBPVDR    ,DS ,RES'
               endif
            endif
C 1234LAB -- NEED TO ADD WRITING SOURCE AND ACCESS NEXT
            if(itextxml_ext.gt.6)then
               write(csvstr(i),9011)stanam(i),dstr,hmstr,provdr(i),
     1              subpvdr(i),source_n(i),access(i)
               csvstrendlen(i) = 58
            endif
         endif
 601  continue
         
         
C     loop vcodes
      do 101 ivcode = 1, numvcodes
         vcode = vcodes(ivcode)
            
         write(*,505)vcode
            
C     The internal MGETVCN routine is used to determine the type
C     (numeric or character) of the variable.  In general, a user's
C     MADIS program shouldn't have to make this determination
C     (as you would know what variables you're reading).
      
         CALL MGETVCN(vcode,vcn,vtype,istatus)
         if(istatus.ne.success_p)go to 900
      

C     Read the desired variable and QC info.  The returned arrays
C     will match the records in the station info arrays returned
C     from MSFCSTA.  If a QC level has been selected, the obs will
C     only be returned if they meet or exceed the selected QC
C     level.

         if(vtype.eq.'N')then


C     The MGETSFC routine is used to read all numeric variables.
C     All variables are returned as Fortran REAL type (RDATA), the
C     QC data descriptors are always CHARACTER*1 (QCD), and the
C     bit maps showing the QC checks that were applied (QCA) and
C     their results (QCR) are always INTEGER.
C
C     Note that we use nstatot, not nsta, since if the last variable
C     has no obs, MGETSFC will set the nsta argument to 0, which
C     we don't want.  We want to use the nsta returned by
C     MSFCSTA instead.

            CALL MGETSFC(atime,vcode,nstatot,nobs,rdata,qcd,qca,qcr,
     1           istatus)

            hdvcode = vcode
C Header
            if(vcode.ne.'SKYCVLB'.and.
     1           vcode.ne.'PCPINT'.and.vcode.ne.'PCPTYPE')then
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx) = ','
               csvstrendlenheader = csvstrendlenheader+1
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx+12) = hdvcode
               csvstrendlenheader = csvstrendlenheader+13
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx+hdmstrlen-1) = hdmstr(1:hdmstrlen)
               csvstrendlenheader=csvstrendlenheader+hdmstrlen
            else if(vcode.eq.'SKYCVLB')then
               do j=1,6
                  idx = csvstrendlenheader+1
                  csvstrheader(idx:idx) = ','
                  csvstrendlenheader = csvstrendlenheader+1
                  idx = csvstrendlenheader+1
                  hdvcode = 'SKYCVLB_'//cvsheadercnt(j)
                  csvstrheader(idx:idx+12) = hdvcode
                  csvstrendlenheader = csvstrendlenheader+13
                  idx = csvstrendlenheader+1
                  csvstrheader(idx:idx+hdmstrlen-1) = 
     1                 hdmstr(1:hdmstrlen)
                  csvstrendlenheader = 
     1                 csvstrendlenheader+hdmstrlen
               enddo
            else if(vcode.eq.'PCPINT')then
               do j=1,2
                  idx = csvstrendlenheader+1
                  csvstrheader(idx:idx) = ','
                  csvstrendlenheader = csvstrendlenheader+1
                  idx = csvstrendlenheader+1
                  hdvcode = 'PCPINT_'//cvsheadercnt(j)
                  csvstrheader(idx:idx+12) = hdvcode
                  csvstrendlenheader = csvstrendlenheader+13
                  idx = csvstrendlenheader+1
                  csvstrheader(idx:idx+hdmstrlen-1) = 
     1                 hdmstr(1:hdmstrlen)
                  csvstrendlenheader = 
     1                 csvstrendlenheader+hdmstrlen
               enddo
            else if(vcode.eq.'PCPTYPE')then
               do j=1,2
                  idx = csvstrendlenheader+1
                  csvstrheader(idx:idx) = ','
                  csvstrendlenheader = csvstrendlenheader+1
                  idx = csvstrendlenheader+1
                  hdvcode = 'PCPTYPE_'//cvsheadercnt(j)
                  csvstrheader(idx:idx+12) = hdvcode
                  csvstrendlenheader = csvstrendlenheader+13
                  idx = csvstrendlenheader+1
                  csvstrheader(idx:idx+hdmstrlen-1) = 
     1                 hdmstr(1:hdmstrlen)
                  csvstrendlenheader = 
     1                 csvstrendlenheader+hdmstrlen
               enddo
            endif

CCCCCCCCCCCCCCCCCCCCCCC
         
C No Data issue
            if(istatus.ne.success_p.or.nobs.eq.0)then
               do 1002 i = 1,nsta
                  if(ising.eq.1.and.singsta.ne.stanam(i))go to 1002
C Check for bogus elevation
                  if(elev(i) .le. minelev)go to 1002
                  if(vcode.ne.'SKYCVLB'.and.
     1                 vcode.ne.'PCPINT'.and.vcode.ne.'PCPTYPE')then
                     idx = csvstrendlen(i)+1
                     csvstr(i)(idx:idx+mstrlen-1) = mstr(1:mstrlen)
                     csvstrendlen(i) = csvstrendlen(i) + mstrlen
                  else if(vcode.eq.'SKYCVLB')then
                     do j=1,6
                        idx = csvstrendlen(i)+1
                        csvstr(i)(idx:idx+mstrlen-1) = 
     1                       mstr(1:mstrlen)
                        csvstrendlen(i) = csvstrendlen(i) + mstrlen
                     enddo
                  else if(vcode.eq.'PCPINT'.or.vcode.eq.'PCPTYPE')then
                     
                     do j=1,2
                        idx = csvstrendlen(i)+1
                        csvstr(i)(idx:idx+mstrlen-1) = 
     1                       mstr(1:mstrlen)
                        csvstrendlen(i) = csvstrendlen(i) + 
     1                       mstrlen
                     enddo
                  endif
 1002          continue
               go to 101         
            endif
            
            do 201 i = 1,nsta
            
C     If we're getting only one station, make sure this is it.

               if(ising.eq.1.and.singsta.ne.stanam(i))go to 201
C Check for bogus elevation
               if(elev(i) .le. minelev)go to 201

C     Output records
               idx = csvstrendlen(i)+1

               if(vcode.ne.'SKYCVLB'.and.
     1              vcode.ne.'PCPINT'.and.vcode.ne.'PCPTYPE')then


                  if(rdata(i).eq.miss_p .or. 
     2                 rdata(i).gt. 999999.9
     2                 .or. rdata(i).lt. -99999.9)then

                     csvstr(i)(idx:idx+mstrlen-1) = mstr(1:mstrlen)
                     csvstrendlen(i) = csvstrendlen(i) + mstrlen
                  else
                     stnhasdata(i) = .true.

                     if(itextxml.eq.2)then
                        write(csvstr(i)(idx:idx+13),8011)
     1                       rdata(i)
                        csvstrendlen(i) = csvstrendlen(i) + 14
                     else if(itextxml.eq.3)then
                        write(csvstr(i)(idx:idx+15),8012)
     2                       rdata(i),qcd(i)
                        csvstrendlen(i) = csvstrendlen(i) + 14+2
                     else if(itextxml.eq.4)then
                        write(csvstr(i)(idx:idx+23),8014)
     2                       rdata(i),qcd(i),qca(i),
     3                       qcr(i)
                        csvstrendlen(i) = csvstrendlen(i) + 14+10
                     endif
                  endif
                     
C XML OUTPUT SPECIAL CASES SKY... 

               else if(vcode.eq.'SKYCVLB')then
                  do j=1,6
                     idx = csvstrendlen(i)+1
                     if(skycovlb(j,i).gt.999999.9 .or. 
     3                    skycovlb(j,i).lt.0.0)then
                        csvstr(i)(idx:idx+mstrlen-1) = 
     1                       mstr(1:mstrlen)
                        csvstrendlen(i) = csvstrendlen(i) + mstrlen
                     else
                        if(itextxml.eq.2)then
                           write(csvstr(i)(idx:idx+13),8011)
     1                          skycovlb(j,i)
                           csvstrendlen(i) = csvstrendlen(i) + 14
                        else if(itextxml.eq.3)then
                           write(csvstr(i)(idx:idx+15),8012)
     2                          skycovlb(j,i),qcdsky(j,i)
                           csvstrendlen(i) = csvstrendlen(i) + (14+2)
                        else if(itextxml.eq.4)then
                           write(csvstr(i)(idx:idx+23),8014)
     2                          skycovlb(j,i),qcdsky(j,i),
     3                          qcapcp(j,i),qcrpcp(j,i)
                           csvstrendlen(i) = csvstrendlen(i) + (14+10)
                        endif
                        stnhasdata(i) = .true.
                     endif
                  enddo

               else if(vcode.eq.'PCPINT'.or.vcode.eq.'PCPTYPE')then
                  
                  do j=1,2
                     idx = csvstrendlen(i)+1
                     if(pcpvar(j,i).eq.miss_p .or. 
     2                    rdata(i).gt. 999999.9
     2                    .or. rdata(i).lt. -99999.9)then
                        csvstr(i)(idx:idx+mstrlen-1) = 
     1                       mstr(1:mstrlen)
                        csvstrendlen(i) = csvstrendlen(i) + 
     1                       mstrlen
                     else
                        if(itextxml.eq.2)then
                           write(csvstr(i)(idx:idx+13),8011)
     2                          pcpvar(j,i)
                           csvstrendlen(i) = csvstrendlen(i) + 14
                        else if(itextxml.eq.3)then
                           write(csvstr(i)(idx:idx+15),8012)
     2                          pcpvar(j,i),qcdpcp(j,i)
                           csvstrendlen(i) = csvstrendlen(i) + (14+2)
                        else if(itextxml.eq.4)then
                           write(csvstr(i)(idx:idx+23),8014)
     2                          pcpvar(j,i),qcdpcp(j,i),
     3                          qcapcp(j,i),qcrpcp(j,i)
                           csvstrendlen(i) = csvstrendlen(i) + (14+10)
                        endif
                        stnhasdata(i) = .true.
                     endif
                  enddo
               endif

 201        continue
         else if(vtype.eq.'C')then

C     The MGETSFCC routine is used to read character variables.  No QC
C     is currently available for any of these variables.  Only two of
C     the character variables are actually observations (present weather
C     and sky cover).  The other character variables are metadata, e.g.,
C     METAR report types ("METAR", "SPECI", "TEST").  Note that there
C     are no missing data flags for character data, and therefore no
C     equivalent of the NOBS argument returned from MGETSFC; instead,
C     blanks are filled in where no genuine data exist.

            CALL MGETSFCC(atime,vcode,nstatot,rawmtr,istatus)

            hdvcode = vcode
            if(vcode.eq.'AUTOTYP'.or.vcode.eq.'REPTYPE')then
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx) = ','
               csvstrendlenheader = csvstrendlenheader+1
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx+5) = vcode(1:6)
               csvstrendlenheader = csvstrendlenheader+6
            else if(vcode.eq.'PRESWEA')then
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx) = ','
               csvstrendlenheader = csvstrendlenheader+1
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx+24) = vcode
               csvstrendlenheader = csvstrendlenheader+24
            else if(vcode.eq.'AUTORMK'.or.vcode.eq.'OPERRMK')then
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx) = ','
               csvstrendlenheader = csvstrendlenheader+1
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx+79) = vcode
               csvstrendlenheader = csvstrendlenheader + 80
            else if(vcode.eq.'STALOC')then
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx) = ','
               csvstrendlenheader = csvstrendlenheader+1
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx+49) = vcode
               csvstrendlenheader = csvstrendlenheader + 50
            else if(vcode.eq.'SUBPVDR')then
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx) = ','
               csvstrendlenheader = csvstrendlenheader+1
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx+10) = vcode
               csvstrendlenheader = csvstrendlenheader + 51
            else if(vcode.eq.'RAWMTR')then
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx) = ','
               csvstrendlenheader = csvstrendlenheader+1
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx+255) = vcode
               csvstrendlenheader = csvstrendlenheader + 256
            else if(vcode.eq.'SKYCOV')then
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx) = ','
               csvstrendlenheader = csvstrendlenheader+1
               idx = csvstrendlenheader+1
c$$$               csvstrheader(idx:idx+53) = vcode
               csvstrheader(idx:idx+53) = 
     1          'SKYCOV_1,SKYCOV_2,SKYCOV_3,SKYCOV_4,SKYCOV_5,SKYCOV_6'
               csvstrendlenheader = csvstrendlenheader + 54
            else if(vcode.eq.'T24MAXT'.or.vcode.eq.'T24MINT')then
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx) = ','
               csvstrendlenheader = csvstrendlenheader+1
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx+13) = vcode
               csvstrendlenheader = csvstrendlenheader + 14
            else if(vcode.eq.'FOT15M'.or.vcode.eq.'LOT15M')then
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx) = ','
               csvstrendlenheader = csvstrendlenheader+1
               idx = csvstrendlenheader+1
               csvstrheader(idx:idx+13) = vcode
               csvstrendlenheader = csvstrendlenheader + 14
            endif


C 1234LAB
CCCCCCCCCCCCCCC
C     Output the station info and variable to the test output file.

            do 301 i = 1,nsta

C     If we're getting only one station, make sure this is it.

               if(ising.eq.1.and.singsta.ne.stanam(i))go to 301
C Check for bogus elevation
               if(elev(i) .le. minelev)go to 301

               idx = csvstrendlen(i)+1

C     Only output records where the string isn't all blank (missing).

               if(vcode.eq.'AUTOTYP'.or.vcode.eq.'REPTYPE')then

                  if(istatus.eq.success_p.and.
     1                 M_LSTCHR(c6(i),6).ne.0)then
                     write(csvstr(i)(idx:idx+6),9051)
     2                    c6(i)
                     stnhasdata(i) = .true.
                  else
                     csvstr(i)(idx:idx+6) = 
     2                    ',      '
                  endif
                  csvstrendlen(i) = csvstrendlen(i) + 7
               else if(vcode.eq.'PRESWEA')then
                  if(istatus.eq.success_p)then
                     dve = M_LSTCHR(preswea(i),LEN(preswea(i)))
                     if(dve.ne.0)then
                        write(csvstr(i)(idx:idx+25),9051)
     2                       preswea(i)
                        stnhasdata(i) = .true.
                     else
                        csvstr(i)(idx:idx+25) = 
     2                       ',                         '
                     endif
                  else
                     csvstr(i)(idx:idx+25) = 
     2                    ',                         '
                  endif
                  csvstrendlen(i) = csvstrendlen(i) + 26
                  
               else if(vcode.eq.'AUTORMK'.or.vcode.eq.'OPERRMK')then
                  if(istatus.eq.success_p)then
                     dve = M_LSTCHR(remark(i),LEN(remark(i)))
                     if(dve.ne.0)then
                        write(csvstr(i)(idx:idx+80),9051)
     2                       remark(i)
                        stnhasdata(i) = .true.
                     else
                        csvstr(i)(idx:idx+80) = ', '
                     endif
                  else
                     csvstr(i)(idx:idx+80) = ', '
                  endif
                  csvstrendlen(i) = csvstrendlen(i) + 81
                  
               else if(vcode.eq.'STALOC')then
C
C Check for "," and replace with " "
C
                  if(istatus.ne.success_p)then
                        csvstr(i)(idx:idx+51) = 
     2     ',                                                   '
                  else
 191                 if(index(staloc(i),',').ne.0)then
                        ic = index(staloc(i),',')
                        staloc(i)(ic:ic) = ' '
                        go to 191
                     endif
                     
                     if(M_LSTCHR(staloc(i),51).ne.0)then

                        write(csvstr(i)(idx:idx+51),9051)
     2                       staloc(i)
                        stnhasdata(i) = .true.
                     else
                        csvstr(i)(idx:idx+51) = 
     2     ',                                                   '
                     endif
                  endif
                     csvstrendlen(i) = csvstrendlen(i) + 52
                  
               else if(vcode.eq.'SUBPVDR')then
                     
                  if(istatus.eq.success_p.and.
     1                 M_LSTCHR(subpvdr(i),11).ne.0)then
                     write(csvstr(i)(idx:idx+11),9051)
     2                    subpvdr(i)
                     stnhasdata(i) = .true.
                  else
                     csvstr(i)(idx:idx+11) = 
     2                    ',           '
                  endif
                  csvstrendlen(i) = csvstrendlen(i) + 12
                     
               else if(vcode.eq.'RAWMTR')then
                  if(istatus.eq.success_p.and.
     1                 M_LSTCHR(rawmtr(i),256).ne.0)then
                     write(csvstr(i)(idx:idx+256),9051)
     2                    rawmtr(i)
                     stnhasdata(i) = .true.
                  else
                     csvstr(i)(idx:idx+256) = 
     2                    ',           '
                  endif
                  csvstrendlen(i) = csvstrendlen(i) + 257
                     
               else if(vcode.eq.'SKYCOV')then
c$$$                  csvstr(i)(idx:idx)=','
c$$$                  idx = idx + 1
                  if(istatus.eq.success_p.and.
     1                    M_LSTCHR(skycover(1,i),48).ne.0)then
                        
                     write(csvstr(i)(idx:idx+53),9052)
     2                    (skycover(j,i),j=1,6)
                     stnhasdata(i) = .true.
                  else
                     write(csvstr(i)(idx:idx+53),9052)
     2                    ('        ',j=1,6)
                  endif
                  csvstrendlen(i) = csvstrendlen(i) + 55
               else if(vcode.eq.'T24MAXT'.or.vcode.eq.'T24MINT')then
                  csvstr(i)(idx:idx)=','
                  idx = idx + 1
                     
C     Use the time output format desired by the user.
                     
                  if(istatus.ne.success_p)then
                     tstr1 = '             '
                  else
                     if(tform.eq.0)then
                        
                        tstr1 = '  '//c9(i)
                        
                     else if(tform.eq.1)then
                        
                        CALL MTRNTIM(c9(i),2,tstr1,istatus)
                        
                     endif
                  endif

                  if(tstr1.ne.'             ')stnhasdata(i) = .true.

                  write(csvstr(i)(idx:idx+13),9051)
     2                 tstr1
                  csvstrendlen(i) = csvstrendlen(i) + 15
                     
               else if(vcode.eq.'FOT15M'.or.vcode.eq.'LOT15M')then
                     
                  csvstr(i)(idx:idx)=','
                  idx = idx + 1
C     Use the time output format desired by the user.
                     
                  if(istatus.ne.success_p)then
                     tstr1 = '             '
                  else
                     if(tform.eq.0)then
                        
                        tstr1 = '  '//c9(i)
                        
                     else if(tform.eq.1)then
                        
                        CALL MTRNTIM(c9(i),2,tstr1,istatus)
                        
                     endif
                  endif
                  if(tstr1.ne.'             ')stnhasdata(i) = .true.
                     
                  write(csvstr(i)(idx:idx+13),9051)
     2                 tstr1
                  csvstrendlen(i) = csvstrendlen(i) + 15
                     
               endif
                  
 301        continue

         endif

C     Process the next variable.
 101  continue
 168  format(a,',')
C     1234LAB
      if(itextxml_ext.gt.0)then
         write(1,168)csvstrheader(1:csvstrendlenheader)
      endif

      do i = 1,nsta
         if(stnhasdata(i))
     1        write(1,168)csvstr(i)(1:csvstrendlen(i))
      enddo
      goto 900


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

C-----------------------------------------------------------------------
C PROGRAM EXIT
C ------------
C
C     The call to MMADISCLOSE is only needed for use on the MADIS web 
C     server.  Users who write their own programs don't need to do this.

C     Error exits.

 825  write(*,503)'SFCDUMP: READ ERROR IN PARAMETER FILE AT LINE ',line
 503  format(1x,a,i4)
      CALL MMADISCLOSE
      stop

 850  write(*,500)'SFCDUMP: PREMATURE END OF PARAMETER FILE'

C     Normal exit.

 900  continue
C     Footer for XML file
      if(itextxml.eq.1)then
         write(1,8004)
 8004    format('</mesonet>')
      endif
      CALL MMADISCLOSE
      stop
      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**---------------------------------------------------------------------
