      PROGRAM SND_CLASS
C
C Program for converting CLASS format soundings to GEMPAK format
C f77 snd_class.f $GEMLIB/gemlib.a
C 
C When using g77 under Linux, you must include the compiler option
C -fno-second-underscore  (see FOPT in $CONFIGDIR/Makeinc.linux)
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.
C                 20  Sep 1993  Increased NSTN=350
C                 30  Dec 1993  Removed inquiry about wind type
C                 22  Feb 1995  Converted to CLASS soundings. STID changed from
C                               CHAR*4 to CHAR*8 to comply with GEMPAK 5.2
C                 18  Mar 1997  Minor restructuring of some if-then-else blocks
C                               Added STR_LOCASE from library
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     UWND:    u-wind
C     VWND:    v-wind
C     DRCT:    wind direction
C     SPED:    wind speed in m/s
C     SNDATA:  packed array of sounding data
C     FNAME:   40-character name for data input file
C
      PARAMETER (NT=1000,NPARM=6)
      DIMENSION PRESS(NT),TEMP(NT),DWPT(NT),UWND(NT),VWND(NT),HGHT(NT)
      DIMENSION DRCT(NT),SPED(NT)
      DIMENSION SNDATA(NPARM,NT)

      CHARACTER FNAME*40,FILNAM*40,DASH*5
      CHARACTER STID*8,PARM(NPARM)*4
      CHARACTER DATTIM*13,DATTIM_OLD*13
      LOGICAL FIRST,PKFLG,STMFLG
      LOGICAL WRTFLG,EOF,MRGDAT
      LOGICAL BADWND(NT)

      DATA DATTIM_OLD /'FFFFFFFFFFFFF'/
      DATA FIRST,PKFLG,STMFLG /.TRUE.,.FALSE.,.TRUE./
      DATA WRTFLG,MRGDAT /.TRUE., .FALSE./
      DATA PARM /'PRES', 'TEMP', 'DWPT', 'DRCT', 'SPED', 'HGHT'/
      DATA NLEV,IVERT,IFLSRC,MAXTIM,ICOORD,NSTN /0, 1, 4, 6, 0, 5/
      DATA NUMSTN /0/
      DATA QFLG /1.0/
      DATA NNN / 0 /
C
C***********************************************************************
C Read in file name
C
 10   WRITE(6,20)
 20   FORMAT(' CLASS> Enter CLASS input file: ',$)
      READ(5,40) FNAME
 40   FORMAT(A)
C
C If name is blank, either exit immediately if no data has been read,
C or exit gracefully if we reached the EOF previously.
C
      IF(FNAME(1:3) .EQ. '   ' ) THEN
         IF(EOF .EQ. .TRUE.) THEN
            CALL SN_CLOS(IFLNO,IRET)
            WRITE(6,50) FILNAM
 50         FORMAT(' CLASS> Closing sounding file:  ',A)
         ENDIF
         CALL EXIT(0)
      ENDIF
C
C Open the file
C        
      OPEN(20,NAME=FNAME,STATUS='OLD',IOSTAT=IOS,ERR=60)
 60   IF(IOS .NE. 0) THEN
         WRITE(6,80) FNAME
 80      FORMAT(' CLASS> Error Opening Input File: ',A40)
         GOTO 10
      ENDIF
      EOF = .FALSE.
C
C***********************************************************************
C Initialize arrays, counters, and flags
C
 100  DO 120 I=1,NT
         PRESS(I) = 0.
         TEMP(I)  = 0.
         DWPT(I)  = 0.
         UWND(I)  = 0.
         VWND(I)  = 0.
         HGHT(I)  = 0.
 120  CONTINUE
      NLVLS = 0
      DASH  = 'FFFFF'
C
C***********************************************************************
C  Read in headers containing date, location, etc., and scan for last
C  line of headers.
C
 140  READ(20,160) STID
 160  FORMAT(//,35X,A4)
C
      READ(20,180) RLON,RLAT,ELEV
 180  FORMAT(59X,F11.5, 1X,F9.5, 1X,F7.1)
C
      READ(20,200)IYEAR,IMON,IDAY,IHOUR,IMIN,ISEC
 200  FORMAT(35X,I4, 2X,I2, 2X,I2, 2X,I2, 1X,I2, 1X,I2, 1X,I2,14X)
C
      DO WHILE (DASH(1:5) .NE. '-----')
         READ(20,220) DASH
 220     FORMAT(A)
      ENDDO
C
C Check if stid needs to be shifted left and padded
C
      IF(STID(1:1) .EQ. ' ') THEN
        STID(1:3) = STID(2:4)	!Shift string left-justify, pad blank
        STID(4:8) = '     '
      END IF
C
C***********************************************************************
C Using information from data header and filename, open a GEMPAK sounding
C file and write header information.  The assumption is that the filename
C has the form "lbb_950603_0130.class" for the date 950603/0130.
C
      IF(FIRST) THEN
         READ(FNAME,230) JYR,JMO,JDY,JHH,JMM
 230     FORMAT(4X,I2,I2,I2,1X,I2,I2)
C
         WRITE(FILNAM,240) JYR,JMO,JDY
 240     FORMAT('UA_',3I2.2, '.GEM')
         CALL STR_LOCASE(FILNAM,FILNAM)
C
         CALL IN_BDTA(IRET)	!Initialize GEMPAK block data
         IF(IRET .NE. 0) THEN
            CALL ER_WMSG('IN',IRET,' ',IERR)
            STOP
         END IF
C
C Try to open an existing GEMPAK file.  If it fails, create a new file
C
         CALL SN_OPNF(FILNAM,WRTFLG,IFLNO,IFLSRC,NPARM,PARM,IVERT,
     1        MRGDAT,IRET)
         IF(IRET .NE. 0) THEN
            CALL SN_CREF(FILNAM,IFLSRC,NPARM,PARM,NSTN,MAXTIM,PKFLG,
     1           ISCALE,IOFSET,IBITS,STMFLG,IFLNO,IRET)
            IF(IRET .NE. 0) THEN
               CALL ER_WMSG('SN',IRET,FILNAM,IERR)
               CALL EXIT(0)
            END IF
            PRINT *,' CLASS> Creating GEMPAK file:  ',filnam
            
            FIRST = .FALSE.
         ENDIF
      END IF
C
C***********************************************************************
C Write the time to the GEMPAK sounding file.
C
 270  WRITE(DATTIM,280) JYR,JMO,JDY,JHH,JMM
 280  FORMAT(3I2.2,'/',2I2.2)
      IHHMM = IHOUR*100 + IMIN

      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(' CLASS> Adding time:  ',A)
         DATTIM_OLD = DATTIM
      END IF
C
C***********************************************************************
C Read in pressure, temperature, dewpoint, wind speed and
C direction from the CLASS data file.
C
      DO WHILE (.NOT. EOF)
         NNN = NNN+1
         READ(20,*,IOSTAT=IOS) RTIM,PRES0,TEMP0,DWPT0,RELH0,UWND0,VWND0,
     1        SPD0,DIR0,VVEL,RLON,RLAT,RNG,ANG,ALT0,QP,QT,QH,QU,QV,QUV
C
         IF(IOS .EQ. -1 ) THEN   ! End_Of_File
            EOF = .TRUE.
            GOTO 300
         ELSE
C
C If pressure is bad, dump the report
C
            IF(QP .NE. 99.) THEN
               NLVLS = NLVLS+1
C
C Store the data in the arrays
C
               PRESS(NLVLS) = PRES0
               TEMP(NLVLS)  = TEMP0
               DWPT(NLVLS)  = DWPT0
               UWND(NLVLS)  = UWND0
               VWND(NLVLS)  = VWND0
               DRCT(NLVLS)  = DIR0
               SPED(NLVLS)  = SPD0
               HGHT(NLVLS)  = ALT0
C     
C Check for CLASS QC flags and convert to GEMPAK flags.
C We don't want to reject surface data so we start with level 2.
C If the flag=4, it is an estimated value and we can keep it.
C
               IF(NNN .GT. 1) THEN
                  IF(QT  .GT. QFLG .AND. QT .NE. 4.) TEMP(NLVLS)=-9999.
                  IF(QH  .GT. QFLG .AND. QH .NE. 4.) DWPT(NLVLS)=-9999.
                  IF(QU  .GT. QFLG .AND. QU .NE. 4.) UWND(NLVLS)=-9999.
                  IF(QV  .GT. QFLG .AND. QV .NE. 4.) VWND(NLVLS)=-9999.
                  IF((QU .GT. QFLG .AND. QU .NE. 4.) .AND.
     1               (QV .GT. QFLG .AND. QV .NE. 4.)) THEN
                     SPED(NLVLS)=-9999.
                     DRCT(NLVLS)=-9999.
                  ENDIF
               ENDIF
C     
            ENDIF
         ENDIF
      ENDDO
C     
C***********************************************************************
C
 300  CONTINUE

C Finished reading and checking the CLASS QC flags.
C We now check to be sure that the pressure decreases (i.e., no falling 
C sondes with data still reporting).
C
      NUM_FALL = 0
      DO I=2,NLVLS
         IF(PRESS(I) .GT. PRESS(I-1)) NUM_FALL = NUM_FALL+1
      ENDDO
      NLVLS = NLVLS-NUM_FALL
C
C Since GEMPAK can only accept 500 sounding levels, set NLVLS appropriately.
C
      IF (NLVLS .GT. 500) NLVLS=500
C
C Check to be sure that there are no "gate-to-gate" winds that exceed the
C shear threshold.
C      
c      DO I=2,NLVLS
c         J = I-1
c         IF(HGHT(I) .NE. -9999. .AND. HGHT(J) .NE. -9999. .AND.
c     1      UWND(I) .NE. -9999. .AND. UWND(J) .NE. -9999. .AND.
c     2      VWND(I) .NE. -9999. .AND. VWND(J) .NE. -9999.) THEN
c            DZ = HGHT(I) - HGHT(J)
c            DU = SQRT((UWND(I)-UWND(J))**2 + (VWND(I)-VWND(J))**2)
c            IF ((DU/DZ) .GT. 0.10) THEN
c               BADWND(I) = .TRUE.
c            ENDIF
c         ENDIF
c      ENDDO
C
      DO I=1,NLVLS
         IF(BADWND(I)) THEN
            UWND(I) = -9999.
            VWND(I) = -9999.
            DRCT(I) = -9999.
            SPED(I) = -9999.
         ENDIF
      ENDDO
C
C Pack the data into a single array.  We can use either UWND/VWND or
C DRCT/SPED for wind data.
C
      DO J = 1,NLVLS
        SNDATA(1,J) = PRESS(J)
        SNDATA(2,J) = TEMP(J)
        SNDATA(3,J) = DWPT(J)
CC        SNDATA(4,J) = UWND(J)
CC        SNDATA(5,J) = VWND(J)
        SNDATA(4,J) = DRCT(J)
        SNDATA(5,J) = SPED(J)
        SNDATA(6,J) = HGHT(J)
      ENDDO
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.
C
 305  CALL SN_SSTN(IFLNO,STID,STID,IDUM,RDUM1,RDUM2,RDUM3,IRET)
      IF(IRET .EQ. -11) THEN
         ISTN = 1
         ID2 = 99999
         CALL SN_ASTN(IFLNO,ISTN,STID,ID2,RLAT,RLON,ELEV,
     1        '  ','  ',NADD,IRET)
         IF(IRET .NE. 0) THEN
            CALL ER_WMSG('SN',IRET,STID,IERR)
            CALL EXIT(0)
         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)
         CALL EXIT(0)
      END IF
C
C Go back and check for another file name from stdio
C
      GOTO 10
C
      END
C***********************************************************************
      SUBROUTINE STR_LOCASE(STRING_IN,STRING_OUT)

c This subroutine will convert all upper case letters (ASCII 65-90)
c in string to lower case (ASCII 97 - 122)

      IMPLICIT NONE
      CHARACTER STRING_IN*(*), STRING_OUT*(*)
      INTEGER*4 LENGTH, II, IASC

      LENGTH = LEN(STRING_IN)
      DO II = 1,LENGTH
          IASC = ICHAR(STRING_IN(II:II))
          IF ((IASC .GE. 65) .AND. (IASC .LE. 90))
     >        STRING_OUT(II:II) = CHAR(IASC+32) ! CONVERT TO LC
      END DO
      RETURN
      END !     subroutine Casefold ends
