      PROGRAM SNDKC
C
C Program for converting Kansas City format soundings to GEMPAK format
C
C     D. Blanchard        1987  Original version - for PRESTORM format
C     K. Howard       Dec 1987  Converted to KC format
C     D. Blanchard    Dec 1987  Numerous cosmetic and functional changes
C                 13  Sep 1988  Changed NT=75 to NT=100
C                 28  Jun 1989  Converted to GEMPAK V4.1
C                 27  Mar 1990  Added PROFS routine to retrieve missing
C                               3-letter station id.  Fixed missing data check.
C                 15  Feb 1991  Changed print statements about wind types
C                 15  Mar 1991  Changed number of times to 50 and number of
C                               stations to 250.  Required reworking some of
C                               the time/station calls.
C                 27  Aug 1993  Revised station id read because the archive
C                               program changed.  Increased NT=150.  Converted
C                               from a VAX to a portable program.  Removed all
C                               PROFS-specific calls.
C                 20  Sep 1993  Increased NSTN=350
C                 14  Oct 1993  Removed wind options.  Raob archive winds are
C                               always in knots.
C
C     NT:      maximum number of thermodynamic levels 
C     NPARM:   number of GEMPAK parameters
C     PRESS:   thermodynamic pressure levels
C     TEMP:    temperature
C     DWPT:    dewpoint
C     SPD:     wind speed 
C     DIR:     wind direction
C     HGT:     height of pressure level
C     SNDATA:  packed array of sounding data
C     FNAME:   40-character name for data input file
C
      PARAMETER (NT=150,NPARM=6)
      DIMENSION PRESS(NT),TEMP(NT),DWPT(NT),SPD(NT),DIR(NT)
      DIMENSION HGT(NT),SNDATA(NPARM,NT)

      CHARACTER FNAME*40,FILNAM*40
C      CHARACTER STID*4,PARM(NPARM)*4
      CHARACTER STID*8,PARM(NPARM)*4
      CHARACTER DATTIM*13,DATTIM_OLD*13,IMO*3,MONTHS(12)*3
      LOGICAL FIRST,PKFLG,STMFLG
                   
      DATA DATTIM_OLD /'FFFFFFFFFFFFF'/
      DATA FIRST,PKFLG,STMFLG /.TRUE.,.FALSE.,.FALSE./
      DATA PARM /'PRES', 'TEMP', 'DWPT', 'DRCT', 'SPED', 'HGHT'/
      DATA NLEV,IVERT,IFLSRC,MAXTIM,ICOORD,NSTN /0, 1, 4, 50, 0, 350/
C
      DATA MONTHS /'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN',
     +             'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'/
      
      DATA NUMSTN /0/
C***********************************************************************
C Read in file name and open the data file
C
      WRITE(6,20)
20    FORMAT(' Enter file from which to read data: ',$)
      READ(5,40) FNAME
40    FORMAT(A)
      IF(FNAME(1:3) .EQ. '   ') CALL EXIT(0)
      OPEN(20,NAME=FNAME,STATUS='OLD',ERR=320)

C***********************************************************************
C     Ask user if winds are in m/s or 1/10's m/s
C
C60    WRITE(6,80)
C80    FORMAT(' Enter a "1" if winds are in m/sec',/,
C     1       '         "2" if winds are in 1/10''s m/s',/,
C     2       '         "3" if winds are in knots: ',$)
C      READ (5,*) IWFLAG
C      IF(IWFLAG .LT. 1 .OR. IWFLAG .GT. 3) GO TO 60
      IWFLAG = 3
C***********************************************************************
C Initialize arrays and counter
C      
100   DO 120 I=1,NT
        HGT(I)=0.
        PRESS(I)=0.
        TEMP(I)=0.
        DWPT(I)=0.
        SPD(I)=0.
        DIR(I)=0.
120   CONTINUE
      NLVLS = 0
C
C***********************************************************************
C  Read in headers containing date, number of levels, location, etc.
C
140   READ(20,160,END=360)IFR,ITIME,IDY,IMO,IYR
160   FORMAT(I7,5X,I2,5X,I2,6X,A3,6X,I2)
      IF(IFR .NE. 254) GO TO 140

      READ(20,180,END=360)IFR1,ISTAT,ID2,SLAT,SLON,IELEV,IFLG
180   FORMAT(3I7,2F7.2,2I7)

      READ(20,200,END=360)IFR2,IHY,IMW,IDUM2,NUMLEV,IR,IC
200   FORMAT(7I7)

      READ(20,220,END=360)IFR3,STID
220   FORMAT(I7,10X,A4)
C
C Negate longitude; store integer elevation in real elevation
C
      SLON = -SLON
      ELEV = IELEV
C***********************************************************************
C Using information from data header, open a GEMPAK sounding file and 
C write header information.  
C
      IF(FIRST) THEN
        WRITE(FILNAM,240) IYR,IMO,IDY,ITIME
240     FORMAT(I2, A3, 2I2.2, 'P.SND')
        CALL IN_BDTA(IRET)	!Initialize GEMPAK block data
        IF(IRET .NE. 0) THEN
          CALL ER_WMSG('IN',IRET,' ',IERR)
          STOP
        END IF
C
        CALL SN_CREF(FILNAM,IFLSRC,NPARM,PARM,NSTN,MAXTIM,PKFLG,ISCALE,
     1	             IOFSET,IBITS,STMFLG,IFLNO,IRET)
        IF(IRET .NE. 0) THEN
          CALL ER_WMSG('SN',IRET,FILNAM,IERR)
          STOP
        END IF

      FIRST = .FALSE.
      END IF
C
C***********************************************************************
C Write the time to the GEMPAK sounding file.
C
      DO I=1,12
         IF(IMO(1:3) .EQ. MONTHS(I)(1:3)) THEN
            NMON = I
            GOTO 270
         END IF
      END DO
C
270   WRITE(DATTIM,280) IYR,NMON,IDY,ITIME
280   FORMAT(3I2.2,'/',I2.2,'00  ')

      IF(DATTIM .NE. DATTIM_OLD) THEN
        CALL SN_ATIM(IFLNO,DATTIM,IRET)	!Add a time to the file
        IF (IRET .NE. 0) THEN
          CALL ER_WMSG('SN',IRET,FILNAM,IERR)
          CALL EXIT(0)
        END IF
      WRITE(6,290) DATTIM
290   FORMAT(' Adding time:  ',A)      
      DATTIM_OLD = DATTIM
      END IF
C
C***********************************************************************
C Read in height, pressure, temperature, dewpoint, wind speed and
C direction, and interpolation flag from the Kansas City data file
C
      DO 300 I=1,NUMLEV-4
      READ(20,200)INTERP,IPRESS0,IHGT0,ITEMP0,IDWPT0,IDIR0,ISPD0
C
C Check height...if missing, then dump the line
C
        IF(IHGT0 .EQ. 32767) GO TO 300
C
C Store the data in the arrays and unpack values as necessary
C
        NLVLS=NLVLS+1
        HGT(NLVLS)=IHGT0
        PRESS(NLVLS)=IPRESS0
        DIR(NLVLS)=IDIR0

        IF(ISPD0 .EQ. 32767) THEN       !missing data flag
          SPD(NLVLS) = ISPD0
        ELSE IF(IWFLAG .EQ. 1) THEN     !meters/sec to meters/sec
          SPD(NLVLS)=ISPD0
        ELSE IF(IWFLAG .EQ. 2) THEN     !1/10's meters/sec to meter/sec
          SPD(NLVLS)=FLOAT(ISPD0)/10.
        ELSE IF(IWFLAG .EQ. 3) THEN     !knots to meters/sec
          SPD(NLVLS)=FLOAT(ISPD0)/1.94
        END IF

        IF(ITEMP0 .EQ. 32767) THEN	!Missing data flag
          TEMP(NLVLS)=ITEMP0
        ELSE
          TEMP(NLVLS)=FLOAT(ITEMP0)/10.	!Good data...divide by 10
        END IF

        IF(IDWPT0 .EQ. 32767) THEN	!Missing data flag
          DWPT(NLVLS)=IDWPT0
        ELSE
          DWPT(NLVLS)=FLOAT(IDWPT0)/10.	!Good data...divide by 10
        END IF
C
C Check for KC data flags and convert to GEMPAK flags
C
      IF(HGT(NLVLS)  .EQ. 32767.) HGT(NLVLS)  = -9999.
      IF(TEMP(NLVLS) .EQ. 32767.) TEMP(NLVLS) = -9999.
      IF(DWPT(NLVLS) .EQ. 32767.) DWPT(NLVLS) = -9999.
      IF(SPD(NLVLS)  .EQ. 32767. .OR. SPD(NLVLS) .EQ. 0.)SPD(NLVLS)=-9999.
      IF(DIR(NLVLS)  .EQ. 32767. .OR. DIR(NLVLS) .EQ. 0.)DIR(NLVLS)=-9999.
C
300   CONTINUE
C
C  Check latitude, longitude, and elevation
C
      IF(SLAT .EQ. 32767.) SLAT = -9999.
      IF(SLON .EQ. 32767.) SLON = -9999.
      IF(ELEV .EQ. 32767.) ELEV = -9999.
C
C***********************************************************************
C Finished reading and checking the KC data...now write it out to the
C GEMPAK file.
C        
C Check if stid needs to be shifted left
C
      IF(STID(1:1) .EQ. ' ') THEN
        STID(1:3) = STID(2:4)	!Shift string left-justify, pad blank
        STID(4:4) = ' '
      END IF
C
C Pack the data into a single array
C
      CALL PACK(PRESS,TEMP,DWPT,DIR,SPD,HGT,SNDATA,NLVLS,NPARM)
C
C  Select the previously added time
C
      CALL SN_STIM(IFLNO,DATTIM,IRET)	
      IF(IRET .NE. 0) THEN
        CALL ER_WMSG('SN',IRET,DATTIM,IRET)
        STOP
      END IF      
C
C Select a station.  If IRET = -11, the station header is not in the 
C file.  Add it to the file, then loop back and try again to select
C the station.  If the station id is either blank or 999, give it a bogus
C value.
C
305   CALL SN_SSTN(IFLNO,STID,STID,IDUM,RDUM1,RDUM2,RDUM3,IRET)
      IF(IRET .eq. -11) THEN
        ISTN = 1
        IF(STID(1:3) .EQ. '999' .OR. STID(1:3) .EQ. '   ') THEN
           NUMSTN=NUMSTN+1
           CALL BOGUS(NUMSTN,STID)
	ENDIF
        CALL SN_ASTN(IFLNO,ISTN,STID,ID2,SLAT,SLON,ELEV,'  ','  ',
     1               NADD,IRET)
        IF(IRET .NE. 0) THEN
          CALL ER_WMSG('SN',IRET,STID,IERR)
          STOP
        END IF
      GO TO 305
      END IF
C
C Write the data
C
      CALL SN_WDAT(IFLNO,IHHMM,NLVLS,SNDATA,IRET)
      IF(IRET .NE. 0) THEN
        CALL ER_WMSG('SN',IRET,FILNAM,IERR)
        STOP
      END IF
C
C***********************************************************************
C Go read the next sounding (if there is another one) -- when all
C data is read and pointer is at EOI, branch to EOI processing below.
C
      GO TO 100
C*********************************************************************
C
C Error and EOI processing takes place here
C
320   CONTINUE
      WRITE(6,340) FNAME
340   FORMAT(' Error Opening Input File: ',A40)
      STOP
C
360   CONTINUE
      CALL SN_CLOS(IFLNO,IRET)
      WRITE(6,400) FILNAM
400   FORMAT(' File ',A14, ' created')
      END

      SUBROUTINE PACK(P,T,TD,DIR,SPD,HT,SNDATA,NL,NPARMS)
      REAL P (NL),T (NL),TD (NL),HT (NL),DIR (NL),SPD (NL)	!INPUT
      REAL SNDATA(NPARMS,NL)
C
C PACK 1-D ARRAYS INTO A SINGLE 2-D ARRAY
C
      DO J = 1,NL
        SNDATA(1,J) = P(J)
        SNDATA(2,J) = T(J)
        SNDATA(3,J) = TD(J)
        SNDATA(4,J) = DIR(J)
        SNDATA(5,J) = SPD(J)
        SNDATA(6,J) = HT(J)
      ENDDO

      RETURN
      END
C
      SUBROUTINE BOGUS(NUMSTN,STID)
C
C This routine generates bogus 3-letter station id's for stations that do not
C have id's.  These stations currently use the value "999" or "   "
C
      CHARACTER ID(50)*3,STID*4
C
      DATA  ID
     1 /'?01','?02','?03','?04','?05','?06','?07','?08','?09','?10',
     2  '?11','?12','?13','?14','?15','?16','?17','?18','?19','?20',
     3  '?21','?22','?23','?24','?25','?26','?27','?28','?29','?30',
     4  '?31','?32','?33','?34','?35','?36','?37','?38','?39','?40',
     5  '?41','?42','?43','?44','?45','?46','?47','?48','?49','?50'/
C
      STID = ID(NUMSTN)//' '
      RETURN
      END      
