!  2011 Copyleft by Patrick Corbitt Kerr
!  University of Notre Dame - CHL

!  Created as part of SURA-IOOS Project

program Toolkit

      implicit none
      integer                      :: iopt
      character(10)                :: os="unix"
      character(120)               :: filestationu=''
      character(120)               :: fort61u=''
      character(120)               :: fort63u=''
      character(120)               :: fort14u=''     
      character(120)               :: RunID=''
      character(120)               :: dfolder='' 
      integer                      :: cntrl=0,dtype=1
      integer                      :: dateu(5)

      dateu = (/ 0, 0, 0, 0, 0 /)      
      do
998   write(6,*)
      write(6,*)    '*************************************************'
      write(6,*)    '         NotreDame-CHL Toolkit by PCK  v.23      '    
      write(6,*)    '*************************************************'
      write(6,*)
      write(6,*)    '  1. Create Station List from IMEDS file '
      write(6,*)    '  2. Create IMEDS hwm from IMEDS watlev '
      write(6,*)    '  3. Convert a fort.61 to IMEDS format'
      write(6,*)    '  4. Filter/Remove Stations from an IMEDS file'
      write(6,*)    '  5. Number IMEDS Stations'
      write(6,*)    '  6. Merge IMEDS files'
      write(6,*)    '  7. Adjust Time or Elevation in an IMEDS file'
      write(6,*)    '  8. Clean an IMEDS file'      
      write(6,*)    '  ------------------------------------------------'
      write(6,*)    '  10. Create a fort.61 from a fort.63'
      write(6,*)    '  11. Create a wet.14 file'
      write(6,*)    '  12. Find Min-Max'
      write(6,*)    '  13. Create Maximum Envelope of Water (MEOW)'
      write(6,*)    '  14. Generate a max file from a TimeSeries File'
!      write(6,*)    '  15. Project a file onto a different grid'
      write(6,*)    '  16. Generate a Difference File'
      write(6,*)    '  17. Populate a Stations file with Nodes'      
      write(6,*)    '  ------------------------------------------------'
      write(6,*)    '  21. Convert CRMS raw data to IMEDS format'
      write(6,*)    '  22. Convert NOAA raw data to IMEDS format'
      write(6,*)    '  23. Convert TCOON raw data to IMEDS format'
      write(6,*)    '  24. Convert USACE raw data to IMEDS format'
      write(6,*)    '  25. Convert USGS-DEPL raw data to IMEDS format'
      write(6,*)    '  26. Convert USGS-PERM raw data to IMEDS format'
      write(6,*)    '  27. Convert USACE-CHL raw data to IMEDS format'
      write(6,*)    '  28. Convert SLOSH raw data to IMEDS format'      
      write(6,*)    '  ------------------------------------------------'
      write(6,*)    '  31. Create 61.IMEDS with IMEDS.ctrl'
      write(6,*)    '  ------------------------------------------------'      
      write(6,*)    '  98. Change Operating System'
      write(6,*)    '  99. Terminate Program'

997     write(6,'(A)',ADVANCE="NO")    ' Select Option: '
        read(5,'(i10)',ERR=997) iopt
        write(6,*)
        select case(iopt)
          case(1)
            Call IMEDSlist(os)
          case(2)
            Call wl2hwm(os)
          case(3)
            Call IMEDS61(os, cntrl, dateu, filestationu, fort61u, dtype,dfolder)
          case(4)
            CALL IMEDSfilter(os)
          case(5)
            CALL IMEDSrename(os)
          case(6)
            Call IMEDSmerge(os)
          case(7)
            Call IMEDSadjust(os)
          case(8)
            Call IMEDSclean(os)
          case(10)
            Call TSextract(os,cntrl,filestationu,fort14u,fort63u,RunID,dfolder)            
          case(11)
            Call wetdry(os)
          case(12)
            Call findminmax(os)
          case(13)
            Call meow(os)
          case(14)
            Call generatemax(os)
          case(15)
            Call projector(os)
          case(16)
            call generatediff(os)
          case(17)
            call listnodes(os)
          case(21)
            Call CRMS2IMEDS
          case(22)
            Call NOAA2IMEDS
          case(23)
            CALL TCOON2IMEDS
          case(24)
            CALL USACE2IMEDS
          case(25)
            Call USGSDEPL2IMEDS
          case(26)
            Call USGSPERM2IMEDS
          case(27)
            Call USACECHL
          case(28)
            Call SLOSH2IMEDS
          case(31)
            Call IMEDScntrl(os)
          case(98)
            if (trim(os).eq."unix") then
              write(6,*) "Operating System changed to DOS"
              os ="dos"
            else
              write(6,*) "Operating System changed to UNIX"
              os ="unix"
            endif
          case(99)
            goto 999
          case default
            write(6,'(A)') 'Option Unacceptable, Try Again'
            goto 998
        end select
        write(6,*) 
        write(6,*) "Yatta!"
        write(6,*)
      enddo
      write(6,*)
999   write(6,*) 'Program Terminated'
   end program
!----------------------------------------------------------------------
!     1
!----------------------------------------------------------------------
   subroutine IMEDSlist(os)

      implicit none
      character(120)                :: filest,junkC,junkC2,junkC3
      character(1000)               :: junkCC
      character(120)                :: filewl
      character(10), intent(in)     :: os
      integer                       :: extension=1
      integer                       :: iflag, i, n, X1
      write(6,*) "Enter the name of the input watlev file"
      call choosefile(filewl,extension,os)
      X1 = len_trim(filewl)
      if (filewl(X1-4:X1).eq.'IMEDS') then
        filest=filewl(1:X1-5)//'Stations'
      else
        filest=trim(filewl)//'.Stations'
      endif
      open(unit=10,file=filewl,status='old',action='read')
      open(unit=20,file='.tempfile',status='replace',action='write')
      read(10,'(a)') junkC
      read(10,'(a)') junkC
      read(10,'(a)') junkC
      read(10,'(a)') junkC
      write(20,*) trim(junkC)        !Write station 
      n= 1
      iflag = 1
      do while (iflag.eq.1)
        do while (iflag.eq.1)
          read(10,'(a)',END=999) junkC2
          JunkC3 = adjustL(junkC2)
          if (JunkC3(1:1).ne."2") goto 998  !bad programming
        enddo
998     write(20,*) trim(junkC2)  !Write Station
        n = n + 1
      enddo
999   close(10)
      close(20)
      open(unit=20,file='.tempfile',status='old',action='read')
      open(unit=10,file=filest,status='replace',action='write')
      write(10,*) n
      do i = 1,n
        read(20,'(A)') junkCC
        write(10,'(A)') trim(junkCC)
      enddo
      close(10)
      close(20)

   end subroutine IMEDSLIST
!----------------------------------------------------------------------
!     2
!----------------------------------------------------------------------
   subroutine wl2hwm(os)

      implicit none
      character(120)                :: filewl, filehwm, templine,templine2
      character(10), intent(inout)  :: os
      character(120)                :: templine3
      character(120),allocatable    :: ct(:), mt(:)
      integer                       :: iflag, i, n, Defval=-999
      double precision              :: wse, mxe

      write(6,*) "Enter the name of the input watlev file"
      read(5,*) filewl
      write(6,*) "Enter the name of the output hwm file"
      read(5,*) filehwm
      write(6,*)

      open(unit=10,file=filewl,status='old',action='read')
      open(unit=20,file=filehwm,status='replace',action='write')
      read(10,*)
      write(20,*) '% IMEDS generic format - Water Level'
      read(10,'(a)') templine
      if (templine(28:30).eq.'sec') then
        n = 6
        write(20,*) "% ", "year ","month ","day ","hour ","min ","sec ", "hwm (m)"
      elseif (templine(24:26).eq.'min') then
        n = 5
        write(20,*) "% ", "year ","month ","day ","hour ","min ", "hwm (m)"
      elseif (templine(19:22).eq.'hour') then
        n = 4
        write(20,*) "% ", "year ","month ","day ","hour ", "hwm (m)"
      else
        n = 3
        write(20,*) "% ", "year ","month ","day ", "hwm (m)"
      endif
      read(10,'(a)') templine
      write(20,*) trim(templine)        !Write Header Line 3
      read(10,'(a)') templine
      write(20,*) trim(templine)        !Write station 
      allocate(ct(1:n), mt(1:n))
      iflag = 1
      do while (iflag.eq.1)
        mxe = -999.0d0
        do while (iflag.eq.1)
          read(10,'(a)',END=999) templine2
          templine3 = adjustL(templine2)
          if (templine3(1:1).ne."2") goto 998  !bad programming
          read(templine2(1:len_trim(templine2)),*) (ct(i),i=1,n) , wse
          if (wse.gt.mxe) then
            do i=1,n
              mt(i) = ct(i)
            enddo
            mxe=wse
          endif
        enddo
998     write(20,*) (trim(mt(i))//"    ",i=1,n) , mxe
        write(20,*) trim(templine2)  !Write Station
      enddo
999   write(20,*) (trim(mt(i))//"    ",i=1,n) , mxe
      close(10)
      close(20)
   end subroutine wl2hwm
!----------------------------------------------------------------------
!     3
!----------------------------------------------------------------------
   subroutine IMEDS61(os, cntrl, dateu, filestationu, fort61u, dtype,dfolder)

      implicit none
      character(120)                :: filestation, fort61
      character(10), intent(inout)  :: os
      character(120), intent(inout) :: filestationu
      character(120), intent(inout) :: fort61u, dfolder      
      integer, intent(inout)        :: cntrl, dtype
      integer, intent(inout)        :: dateu(5)
      character(120), allocatable   :: stnid(:)
      character(22)                 :: junkc
      integer                       :: junki, Nsteps, Nsta, i, j, k
      integer                       :: yy, mo, dd, hh, mi, ss=0
      integer,allocatable           :: calen(:), dates(:,:), cd(:)
      double precision              :: junkd, day1, day2
      integer                       :: extension,iopt
      integer                       :: defval=-999
      double precision, allocatable :: lat(:), lon(:), time(:), val(:,:)
  

      if (cntrl.eq.0) then
        write(6,*) "What is the date of the simulation start? (YYYY, MO, DD, HH, MI )"
        read(5,*) yy, mo, dd, hh, mi
        write(6,*)
        write(6,*) "Enter the name of the Stations ID file"
        extension=2
        call choosefile(filestation,extension,os)
        write(6,*)
        write(6,*) "Enter the name of the fort.61 file"
        extension=3
        call choosefile(fort61,extension,os)
        write(6,*)
      else
        filestation = trim(filestationu)
        fort61 = trim(fort61u)
        yy = dateu(1)
        mo = dateu(2)
        dd = dateu(3)
        hh = dateu(4)
        mi = dateu(5)        
      endif
!
      open(unit=61,file=fort61,status='old',action='read')
      read(61,*)
      read(61,*) Nsteps, Nsta
      allocate(stnid(1:Nsta),lat(1:Nsta),lon(1:Nsta))
      allocate(val(1:Nsteps,1:Nsta), time(1:Nsteps), dates(1:5,1:Nsteps))
!! Collect data from ADICRC output file
      i = 0
      do
         i = i + 1
         write(6,*) "Collecting data for timesnap ", i, "."
         read(61,*,ERR=999,END=999) time(i)
         do j = 1,Nsta
           read(61,*,ERR=999,END=999) junkI, junkC
           if (junkC.eq."NaN") then
             val(i,j) = -99999.0d0
           else
             read(junkC,*) val(i,j)
           endif
         enddo
      enddo
999   Nsteps = i-1
      close(61)
      
!! Break time into component parts
      allocate(calen(1:12), cd(1:13))
      calen = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
      cd = (/ 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 /)
      if( mod(yy,4) == 0 ) then
        calen(2) = 29 !leap year
        cd = (/ 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366 /)
      endif
      day1 = cd(mo) + dd + hh/24.0d0 + mi/1440.0d0
      do i = 1,Nsteps
         day2 = time(i)/86400.0d0 + day1
         dates(1,i) = yy
         do j = 1,13
           if(cd(j).ge.day2) GoTo 500           
         enddo
  500    dates(2,i) = j-1
         dates(3,i) = floor(day2-cd(j-1))
         dates(4,i) = floor(24.0d0*((day2-cd(j-1))-dates(3,i)))
         dates(5,i) = floor(60.0d0*((24.0d0*((day2-cd(j-1))-dates(3,i))-dates(4,i))))
      enddo
      
!! Collect station information from station id file
      open(unit=11,file=trim(dfolder)//trim(filestation),status='old',action='read')
      read(11,*)
      do j = 1,Nsta
         read(11,*) stnid(j), lat(j), lon(j)
      enddo
      close(11)
      
!! Reformat data as IMEDS generic output
      open(unit=21,file=TRIM(fort61)//'.IMEDS',status='replace',action='write')
      if (cntrl.eq.0) then
        write(6,*) "IMEDS file types:"
        write(6,*) "  1. watlev - Water Level"
        write(6,*) "  2. hs     - Significant Wave Height"
        write(6,*) "  3. dir    - Mean Wave Direction"
        write(6,*) "  4. Tp     - Peak Period"
        write(6,*) "  5. Tm     - Mean Period"
        write(6,*) "Select Option: "
        read(5,*) iopt
      else
        iopt=dtype
      endif
      select case(iopt)
        case(1)
          write(21,*) "% IMEDS generic format - Water Level"
          write(21,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
        case(2)
          write(21,*) "% IMEDS generic format - wave-height"
         write(21,*) "% ", "year ","month ","day ","hour ","min ","sec ", "hs (m)"
        case(3)
          write(21,*) "% IMEDS generic format - mean wave-direction"
          write(21,*) "% ", "year ","month ","day ","hour ","min ","sec ", "dir (degrees)"
        case(4)
          write(21,*) "% IMEDS generic format - Peak Period"
          write(21,*) "% ", "year ","month ","day ","hour ","min ","sec ", "tp (s)"
        case(5)
          write(21,*) "% IMEDS generic format - Mean Period"
          write(21,*) "% ", "year ","month ","day ","hour ","min ","sec ", "tp (s)"
      end select
      write(21,*) "ADCIRC " , "UTC", " NAVD88"  !ADCIRC DEFAULT
      do j = 1,Nsta
         write(21,*) TRIM(stnid(j)), lat(j), lon(j)
         do i = 1,Nsteps
            if (val(i,j).eq.-99999.0d0) then
              write(21,201) (dates(k,i),k=1,5),ss, defval
            else
              write(21,200) (dates(k,i),k=1,5),ss, val(i,j)
            endif
         enddo
      enddo
200   Format(6i7,f14.4)
201   Format(6i7,i10)
      close(21)

   end subroutine IMEDS61
!----------------------------------------------------------------------
!     4
!----------------------------------------------------------------------
   subroutine IMEDSfilter(os)

      implicit none
      character(120)                :: fileIMEDS,filefilter,junkC
      character(120)                :: flagfile, tempC
      character(10), intent(inout)  :: os
      integer                       :: iflag, i, nsta
      integer                       :: extension, X1,ifilter
      integer, allocatable          :: filter(:)
      character(120),allocatable    :: StnID(:)
      real(8)                       :: junkR
      
      extension=1
      write(6,*) "Enter the name of the IMEDS file"
      call choosefile(fileIMEDS,extension,os)
      X1 = len_trim(fileIMEDS)-6
      filefilter = fileIMEDS(1:X1)//'.F.IMEDS'
      write(6,*) "Enter the name of the flag file"
      extension=4
      call choosefile(flagfile,extension,os)
      nsta=0
      open(10,file=trim(flagfile),status='old',action='read')
        do 
          read(10,*, END=997)
          nsta = nsta + 1
        enddo
997   close(10)
      nsta = nsta-4
      allocate(StnID(1:nsta),filter(1:nsta))
      open(10,file=trim(flagfile),status='old',action='read')
        read(10,*)
        read(10,*)
        read(10,*)
        read(10,*)
        do i = 1,nsta
          read(10,*) StnID(i), junkR, junkR, filter(i)
        enddo        
      close(10)
      open(10,file=trim(fileIMEDS),status='old',action='read')
      open(unit=20,file=trim(filefilter),status='replace',action='write')
      read(10,'(a)') junkC
      write(20,*) trim(junkC)
      read(10,'(a)') junkC
      write(20,*) trim(junkC)      
      read(10,'(a)') junkC
      write(20,*) trim(junkC)
      read(10,'(a)') junkC
      do
        read(junkC,*,ERR=999,END=999) tempC
        ifilter=1
        do i=1,nsta
          if (trim(tempC).eq.trim(StnID(i))) ifilter= filter(i)
        enddo     
        if (ifilter.eq.1) write(20,*) junkC
        do
          read(10,'(a)',END=999) junkC
          JunkC = adjustL(junkC)
          if (JunkC(1:1).ne."2") goto 998  !bad programming
          if (ifilter.eq.1) write(20,*) junkC
        enddo
998     continue
      enddo
999   close(10)
      close(20)

   end subroutine IMEDSfilter
!----------------------------------------------------------------------
!     5
!----------------------------------------------------------------------
   subroutine IMEDSrename(os)

      implicit none
      character(120)                :: fileIMEDS,filestations,junkC,Prefix,filenew
      character(10), intent(inout)  :: os
      integer                       :: iflag, i, nsta, X1
      integer, allocatable          :: filter(:)
      character(120)                :: StnID, NewID, junkC2,filenum
      integer                       :: extension=1
      double precision              :: Lat, Lon

      write(6,*) "Enter the name of the IMEDS file"
      call choosefile(fileIMEDS,extension,os)
      filestations = trim(fileIMEDS)//'.Stations'
      X1 = len_trim(fileIMEDS)      
      filenew = fileIMEDS(1:X1-6)//'.N.IMEDS'
      filenum = fileIMEDS(1:X1-6)//'.N'

      open(10,file=trim(fileIMEDS),status='old',action='read')
      open(unit=20,file=trim(filenew),status='replace',action='write')
      open(30,file=trim(filenum),status='replace',action='write')
      read(10,'(a)') junkC
      write(20,*) trim(junkC)
      read(10,'(a)') junkC
      write(20,*) trim(junkC)      
      read(10,'(a)') junkC
      write(20,*) trim(junkC)
      iflag = 1
      read(10,'(a)') junkC
      i = 10000
      do 
        i = i + 1
        read(junkC(1:len_trim(junkC)),*) StnID, Lat, Lon
        write(NewID,fmt='(I10)') i
        X1 = index(StnID,"_")
        Prefix = StnID(1:X1-1)
        write(20,*) trim(trim(Prefix)//adjustL(newID)), Lat, Lon
        write(30,*) trim(trim(Prefix)//adjustL(newID)), "   ", trim(StnID)
        do while (iflag.eq.1)
          read(10,'(a)',END=999) junkC
          JunkC = adjustL(junkC)
          if (JunkC(1:1).ne."2") goto 998  !bad programming
          write(20,*) trim(junkC)
        enddo
998     continue
      enddo
999   close(10)
      close(20)
      close(30)

   end subroutine IMEDSrename
!----------------------------------------------------------------------
!     6
!----------------------------------------------------------------------
   subroutine IMEDSmerge(os)

      implicit none
      character(120)                 :: junkC, Dsource, Dtz, Ddatum,fileIMEDS
      character(120)                 ::  Header1, Header2, imerge,filemerge
      integer                        :: i, iopt,extension
      character(10),intent(inout)      :: os
     
      write(6,*) "Note that this Merges files irrespective of Header Differences"
      write(6,*)
      write(6,*) "Select format option"
      write(6,*) " 1. watlev (m)"
      read(5,*)  iopt
      write(6,*)
      write(6,*) "Enter Source"
      read(5,*) Dsource
      write(6,*) "Enter Time Zone"
      Dtz="UTC"
!      read(5,*) Dtz
      write(6,*) "Enter Datum"
      Ddatum="NAVD88"
!      read(5,*) Ddatum
      write(6,*)
      write(6,*) "Enter the name of the mergefile"
      read(5,*) filemerge

      open(10,file=filemerge,status='replace',action='write')
      Select Case (iopt)
        case(1)
          write(10,'(A)') "% IMEDS generic format - Water Level"
          write(10,'(A)') "% year month day hour min sec watlev (m)"
      end select
      write(10,101) trim(Dsource),trim(Dtz), trim(Ddatum)
101   Format(3A10)
      
      extension=1
      do
        write(6,*) "Enter the name of the IMEDS file" 
        call choosefile(fileIMEDS,extension,os)
        open(20,file=trim(fileIMEDS),status='old',action='read')
        do i=1,3
          read(20,'(A)') junkC
        enddo
        do
          read(20,'(A)',END=993) junkC
          write(10,'(A)') trim(junkC)
        enddo
993     close(20)
        write(6,*) "Do you Wish to Merge Another File? (Y or N)?"
        read(5,*) imerge
        if ((imerge(1:1).eq."n").or.(imerge(1:1).eq."N")) goto 994
      enddo
994   close(10)

   end subroutine IMEDSmerge
!----------------------------------------------------------------------
!     7
!----------------------------------------------------------------------
   subroutine IMEDSadjust(os)

      implicit none
      character(120)                 :: fileIMEDSold, fileIMEDSnew
      character(120)                 :: Header1, Header2, Model
      character(120)                 :: TimeZone, Datum
      character(120)                 :: StnID, JunkC
      real(8)                        :: Lat, Lon
      integer                        :: i, iopt,extension=1, X1
      real(8)                        :: MultR, TZC, DatAdj, TempR
      character(10),intent(inout)    :: os
      integer                        :: yy, mo, dd, hh, mi, ss
     
      write(6,*) "This program will adjust the time and/or Elevation"
      write(6,*)
      write(6,*) "Enter the name of the IMEDS file" 
      call choosefile(fileIMEDSold,extension,os)
      fileIMEDSnew = fileIMEDSold//'.A.IMEDS'
      open(10,file=trim(fileIMEDSold),status='old',action='read')
      open(20,file=trim(fileIMEDSnew),status='replace',action='write')
      read(10,'(A)') Header1
      read(10,'(A)') Header2
      read(10,*) Model, TimeZone, Datum
      X1 = len_trim(Header2)
      if (Header2(X1-1:X1-1).eq.'m') then
        Header2 = "% year month day hour min sec watlev (m)"
      else
        Header2 = "% year month day hour min sec watlev (ft)"
      endif      
      write(6,*)      
      write(6,*) ' Select Adjustment Option'
      write(6,*) ' 1. Change Time Zone'
      write(6,*) ' 2. Change Datum and Vertically Adjust Values'
      write(6,*) ' 3. Change Units from feet to meters'
      write(6,*) ' 4. Change Units from meters to feet'
      read(5,*) iopt
      MultR= 1.0d0
      Select Case (iopt)
        case(1) 
          write(6,*) 'Enter Time Zone'
          read(5,*) TimeZone
          write(6,*) 'Enter Time Zone Adjustment in Hours'
          read(5,*) TZC
        case(2)
          write(6,*) 'Enter Datum'
          read(5,*) Datum
          write(6,*) 'Enter Vertical Adjustment'
          read(5,*) DatAdj
        case(3)
          Header2 = "% year month day hour min sec watlev (m)"
          MultR = 0.3048d0
        case(4)
          Header2 = "% year month day hour min sec watlev (ft)"
          MultR = 1.0d0/0.3048d0
      end select

      open(20,file=trim(fileIMEDSnew),status='replace',action='write')
      write(20,'(A)') trim(Header1)
      write(20,'(A)') trim(Header2)
      write(20,'(A)') Model, TimeZone, Datum
      read(10,'(A)') JunkC 
      do 
        read(junkC(1:len_trim(junkC)),*) StnID, Lat, Lon
        write(20,*) StnID, Lat, Lon
        do
          read(10,'(a)',END=999) junkC
          JunkC = adjustL(junkC)
          mi=0
          ss=0
          if (JunkC(1:1).ne."2") goto 998  !bad programming
          read(junkC,*,ERR=995,END=995) yy, mo, dd, hh, mi, ss, tempR
          goto 997
995       read(junkC,*,ERR=996,END=996) yy, mo, dd, hh, mi, tempR
          goto 997
996       read(junkC,*) yy, mo, dd, hh, tempR
997       call  TZconvert(yy,mo,dd,hh,TZC)
          TempR = TempR*MultR
          TempR = TempR + DatAdj
          write(20,201) yy, mo, dd, hh, mi, ss, tempR
        enddo
998     continue
      enddo
999   close(10)
      close(20)
201   Format(6i7,f14.4)
202   Format(6i7,i14)

   end subroutine IMEDSadjust   
!----------------------------------------------------------------------
!     8
!----------------------------------------------------------------------
   subroutine IMEDSclean(os)

      implicit none
      character(120)                 :: Header1, Header2, fileIMEDSold
      character(120)                 :: fileIMEDSnew, fileIMEDSclean
      character(120)                 :: Model, TimeZone, Datum
      integer                        :: extension,tempI=-999, iexist
      character(10),intent(inout)    :: os
      character(120)                 :: JunkC, JunkC2, StnID, StnID2
      real(8)                        :: Lat, Lon, tempR
      integer                        :: yy, mo, dd, hh, mi, ss, X1


     
      write(6,*) "This program will clean an IMEDSfile"
      write(6,*)
      write(6,*) "Enter the name of the IMEDS file to clean" 
      extension=1
      call choosefile(fileIMEDSold,extension,os)
      write(6,*) "Enter the name of the IMEDS flag file"
      extension=4
      call choosefile(fileIMEDSclean,extension,os)
      X1=len_trim(fileIMEDSold)-6
      fileIMEDSnew = fileIMEDSold(1:X1)//'.C.IMEDS'
      open(10,file=trim(fileIMEDSold),status='old',action='read')
      open(20,file=trim(fileIMEDSnew),status='replace',action='write')
      read(10,'(A)') Header1
      read(10,'(A)') Header2
      read(10,*) Model, TimeZone, Datum
      write(20,'(A)') trim(Header1)
      write(20,'(A)') trim(Header2)
      write(20,*) trim(Model), " ", trim(TimeZone), " ", trim(Datum)      

      read(10,'(A)') JunkC 
      do 
        read(junkC,*,ERR=999,END=999) StnID, Lat, Lon
        write(6,*) trim(StnID), Lat, Lon
        write(20,*) trim(StnID), Lat, Lon
        do
          read(10,'(a)',END=999) junkC
          mi=0
          ss=0
          junkC = adjustL(JunkC)
          if (JunkC(1:1).ne."2") goto 998  !bad programming
          read(junkC,*,ERR=998,END=999) yy, mo, dd, hh, mi, ss, tempR
          iexist = 0
          open(30,file=trim(fileIMEDSclean),status='old',action='read')      
            do
              read(30,*,END=900) StnID2
              if (StnID2.eq.StnID) then
                do
                  read(30,'(A)',END=900) junkC2
                  junkC2 = adjustL(junkC2)
                  if (JunkC2(1:40).eq.JunkC(1:40)) iexist=1
                  if (JunkC2(1:1).ne."2") goto 900
                enddo
              endif 
            enddo
900       close(30)
          if (iexist.eq.1) then
            write(20,202) yy, mo, dd, hh, mi, ss, tempI
          else
            write(20,201) yy, mo, dd, hh, mi, ss, tempR
          endif
        enddo
998     continue
      enddo
999   close(10)
      close(20)
201   Format(6i7,f14.4)
202   Format(6i7,i14)

   end subroutine IMEDSclean     
!----------------------------------------------------------------------
!     10
!----------------------------------------------------------------------
   subroutine TSextract(os,cntrl,filestationu,fort14u,fort63u,RunID,dfolder)

      IMPLICIT NONE

      INTRINSIC           :: ABS
      INTRINSIC           :: TRIM
      character(10), intent(inout)     :: os
      character(120),intent(inout)     :: filestationu
      character(120),intent(inout)     :: fort14u
      character(120),intent(inout)     :: fort63u
      character(120),intent(inout)     :: RunID      
      character(120),intent(inout)     :: dfolder
      integer,intent(inout)            :: cntrl
      integer             :: extension

      CHARACTER(LEN=1)    :: Ivector
      CHARACTER(LEN=1)    :: Isparse
      CHARACTER(LEN=100)  :: GridFile
      CHARACTER(LEN=100)  :: GlobalFile
      CHARACTER(LEN=1)    :: JunkC
      CHARACTER(LEN=500)  :: Line
      CHARACTER(LEN=100)  :: OutputFile
      CHARACTER(LEN=100)  :: StationsFile
      CHARACTER(LEN=50)   :: Comments
      CHARACTER(120)      :: JunkC2

      INTEGER,ALLOCATABLE :: Conn(:,:)
      INTEGER             :: E
      INTEGER             :: JunkI
      INTEGER             :: N
      INTEGER             :: Interval
      INTEGER             :: NumElems
      INTEGER             :: NumNodes
      INTEGER             :: NumNodesNonDefault
      INTEGER             :: NumSnaps
      INTEGER             :: NumStations
      INTEGER             :: S
      INTEGER             :: SS
      INTEGER,ALLOCATABLE :: StationsElem(:)
      INTEGER             :: UserSel

      REAL(8)             :: DefaultValue
      REAL(8),ALLOCATABLE :: Global1(:)
      REAL(8),ALLOCATABLE :: Global2(:)
      REAL(8),ALLOCATABLE :: GridLat(:)
      REAL(8),ALLOCATABLE :: GridLon(:)
      REAL(8)             :: JunkR
      REAL(8),ALLOCATABLE :: StationsLat(:)
      REAL(8),ALLOCATABLE :: StationsLon(:)
      REAL(8)             :: StationsTemp1
      REAL(8)             :: StationsTemp2
      REAL(8)             :: StationsTemp11
      REAL(8)             :: SubArea1
      REAL(8)             :: SubArea2
      REAL(8)             :: SubArea3
      REAL(8)             :: TotalArea
      REAL(8),ALLOCATABLE :: Weight(:,:)
      REAL(8)             :: X1
      REAL(8)             :: X2
      REAL(8)             :: X3
      REAL(8)             :: Y1
      REAL(8)             :: Y2
      REAL(8)             :: Y3
      REAL(8), allocatable  :: Bath(:)
      integer, allocatable :: Wet(:),Grid(:), SN(:), UseNode(:)
      character(120), allocatable  :: StnID(:)
      integer             :: nCol
      REAL(8)            :: SnapR
      Integer            :: SnapI, XX1

      if (cntrl.eq.0) then
        WRITE(*,'(A)',ADVANCE="YES") "Enter name of file with lat/lon or node numbers for stations: "
        extension = 2
        call choosefile(StationsFile,extension,os)
        write(6,*)
      else
        StationsFile = trim(filestationu)
      endif

      OPEN(UNIT=11,FILE=trim(dfolder)//TRIM(StationsFile),ACTION="READ")
        READ(11,*) NumStations
        ALLOCATE(StationsLon(1:NumStations))
        ALLOCATE(StationsLat(1:NumStations))
        allocate(StnID(1:NumStations),UseNode(1:NumStations))
        ALLOCATE(Weight(1:NumStations,1:3))
        ALLOCATE(StationsElem(1:NumStations))
        allocate(wet(1:NumStations),grid(1:Numstations),SN(1:NumStations))

        DO S=1,NumStations
           UseNode(S) = 0
           READ(11,'(A)') Line
           READ(Line,*) StnID(S), StationsLat(S), StationsLon(S)
           READ(Line,*,ERR=110,END=110) StnID(S), StationsLat(S), StationsLon(S), UseNode(S)
110        CONTINUE
        ENDDO
      CLOSE(UNIT=11,STATUS="KEEP")

      WRITE(*,'(A)',ADVANCE="YES") "Stations information was read successfully!"
      WRITE(*,'(A)',ADVANCE="YES") " "
      if (cntrl.eq.0) then
        WRITE(*,'(A)',ADVANCE="NO") "Enter name of ADCIRC grid file: "
        READ(*,'(A)') GridFile
      else
        GridFile = trim(fort14u)
      endif

      OPEN(UNIT=14,FILE=TRIM(GridFile),ACTION="READ")
        READ(14,'(A)') JunkC
        READ(14,*) NumElems, NumNodes
        ALLOCATE(GridLon(1:NumNodes),GridLat(1:NumNodes),Bath(1:NumNodes))
        allocate(Conn(1:NumElems,1:3))
        DO N=1,NumNodes
           READ(14,*) JunkI, GridLon(N), GridLat(N), Bath(N)
        ENDDO
        DO E=1,NumElems
           READ(14,*) JunkI, JunkI, Conn(E,1), Conn(E,2), Conn(E,3)
        ENDDO
      CLOSE(UNIT=14,STATUS="KEEP")

      OPEN(unit=86,file=trim(StationsFile)//'.Summary',status='replace',action='write')
      write(86,667) 'StationID','Inside Grid','Nearest Node','Station Lat','Station Lon','Node Lat','Node Lon'
667   Format(A50,2A10,4A15)
      DO S=1,NumStations
         IF (StationsLon(S).gt.-9999.0d0) THEN
         Grid(S) = 0
         SN(S) = 0
         inner: DO E=1,NumElems

            X1 = StationsLon(S)
            X2 = GridLon(Conn(E,2))
            X3 = GridLon(Conn(E,3))
            Y1 = StationsLat(S)
            Y2 = GridLat(Conn(E,2))
            Y3 = GridLat(Conn(E,3))
            SubArea1 = ABS((X2*Y3-X3*Y2)-(X1*Y3-X3*Y1)+(X1*Y2-X2*Y1))

            X1 = GridLon(Conn(E,1))
            X2 = StationsLon(S)
            X3 = GridLon(Conn(E,3))
            Y1 = GridLat(Conn(E,1))
            Y2 = StationsLat(S)
            Y3 = GridLat(Conn(E,3))
            SubArea2 = ABS((X2*Y3-X3*Y2)-(X1*Y3-X3*Y1)+(X1*Y2-X2*Y1))

            X1 = GridLon(Conn(E,1))
            X2 = GridLon(Conn(E,2))
            X3 = StationsLon(S)
            Y1 = GridLat(Conn(E,1))
            Y2 = GridLat(Conn(E,2))
            Y3 = StationsLat(S)
            SubArea3 = ABS((X2*Y3-X3*Y2)-(X1*Y3-X3*Y1)+(X1*Y2-X2*Y1))

            X1 = GridLon(Conn(E,1))
            X2 = GridLon(Conn(E,2))
            X3 = GridLon(Conn(E,3))
            Y1 = GridLat(Conn(E,1))
            Y2 = GridLat(Conn(E,2))
            Y3 = GridLat(Conn(E,3))
            TotalArea = ABS((X2*Y3-X3*Y2)-(X1*Y3-X3*Y1)+(X1*Y2-X2*Y1))

            IF((SubArea1+SubArea2+SubArea3).LE.(1.01*TotalArea))THEN

               StationsElem(S) = E
               
               Weight(S,1) = ( (StationsLon(S)-X3)*(Y2-Y3)+(X2-X3)*(Y3-StationsLat(S)))/TotalArea
               Weight(S,2) = ( (StationsLon(S)-X1)*(Y3-Y1)-(StationsLat(S)-Y1)*(X3-X1))/TotalArea
               Weight(S,3) = (-(StationsLon(S)-X1)*(Y2-Y1)+(StationsLat(S)-Y1)*(X2-X1))/TotalArea

               PRINT*, Weight(S,1), Weight(S,2), Weight(S,3)
               Grid(S) = 1

               EXIT inner

            ENDIF

         ENDDO inner
         ENDIF
         if ((Grid(S).eq.0)) then
           write(6,*) trim(StnID(S)), " is located outside of Grid"
         endif
         X3 = 1000000000.0d0
         do N=1,NumNodes
           X1 = GridLon(N)-StationsLon(S)
           Y1 = GridLat(N)-StationsLat(S)
           X2 = (X1**2.0d0+Y1**2.0d0)**0.5d0
           if (X2.lt.X3) then
             X3 = X2
             SN(S) = N
           endif  
         enddo

         write(86,666) adjustL(trim(StnID(S))),Grid(S),SN(S),StationsLat(S),StationsLon(S),GridLat(SN(S)),GridLon(SN(S))
666   Format(A50,2i10,4f15.10)
      ENDDO
      close(86)

      WRITE(*,'(A)',ADVANCE="YES") "ADCIRC grid file was read successfully!"

      WRITE(*,'(A)',ADVANCE="YES") " "
      if (cntrl.eq.0) then
        WRITE(*,'(A)',ADVANCE="NO") "Enter name of file containing global values: "
        READ(*,'(A)',ADVANCE="YES") GlobalFile
        WRITE(*,'(A)',ADVANCE="NO") "Enter Run Tag: "
        READ(*,'(A)',ADVANCE="YES") RunID
      else
        GlobalFile=fort63u
      endif


      OPEN(UNIT=12,FILE=TRIM(GlobalFile),ACTION="READ")

      READ(12,'(A)') JunkC
      READ(12,'(A)') Line
      READ(Line,*) NumSnaps, JunkI, JunkR, Interval, nCol, Comments
      WRITE(*,'(A)',ADVANCE="YES") " "
      XX1 = len_trim(StationsFile)
      if (StationsFile(XX1-7:XX1).eq.'Stations') then
        Outputfile = StationsFile(1:XX1-9)//'.'//trim(RunID)//'.61'
      else      
        Outputfile = TRIM(StationsFile)//'.'//trim(RunID)//'.61'
      endif
      OPEN(UNIT=14,FILE=TRIM(OutputFile),ACTION="WRITE")

      WRITE(14,'(A)') "Interpolated values at stations"
      WRITE(14,'(5I10,A50)') NumSnaps, NumStations, Interval, Interval, nCol, Comments
      WRITE(*,'(A)',ADVANCE="YES") " "

      DO SS=1,NumSnaps

         WRITE(*,'(A,I5,A,I5,A)',ADVANCE="YES") "Processing snap #",SS," of ",NumSnaps,"."

         ALLOCATE(Global1(1:NumNodes),Global2(1:NumNodes))

         READ(12,'(A)',ERR=999,END=999) Line
         
         Read(Line,*) SnapR, SnapI
         Read(Line,*,ERR=907,END=907) SnapR, SnapI, NumNodesNonDefault, DefaultValue
         Goto 908
907      NumNodesNonDefault = NumNodes
         DefaultValue = -99999.0d0       
908      WRITE(14,*) SnapR, SnapI
         DO N=1,NumNodes
            Global1(N) = DefaultValue
            Global2(N) = DefaultValue
         ENDDO
         if (nCol.eq.2) then
            DO N=1,NumNodesNonDefault
               READ(12,*,ERR=999,END=999) JunkI, StationsTemp1,StationsTemp2
               Global1(JunkI) = StationsTemp1
               Global2(JunkI) = StationsTemp2
            ENDDO
            DO S=1,NumStations
               if (UseNode(S).eq.0) then
                 StationsTemp1 = Global1(Conn(StationsElem(S),1)) * Weight(S,1) &
                               + Global1(Conn(StationsElem(S),2)) * Weight(S,2) &
                               + Global1(Conn(StationsElem(S),3)) * Weight(S,3)
                 StationsTemp2 = Global2(Conn(StationsElem(S),1)) * Weight(S,1) &
                               + Global2(Conn(StationsElem(S),2)) * Weight(S,2) &
                               + Global2(Conn(StationsElem(S),3)) * Weight(S,3)
               else
                 StationsTemp1 = Global1(UseNode(S))
                 StationsTemp2 = Global2(UseNode(S))
               endif
               WRITE(14,'(I10,5X,2E17.10)') S, StationsTemp1, StationsTemp2
            ENDDO
         ELSE
            DO N=1,NumNodesNonDefault
               READ(12,*,ERR=999,END=999) JunkI, StationsTemp1
               Global1(JunkI) = StationsTemp1
            ENDDO
            DO S=1,NumStations
              IF (UseNode(S).eq.0) THEN
                if (Grid(S).eq.1) then
                  StationsTemp1 = Global1(Conn(StationsElem(S),1)) * Weight(S,1) &
                                + Global1(Conn(StationsElem(S),2)) * Weight(S,2) &
                                + Global1(Conn(StationsElem(S),3)) * Weight(S,3)
                  X1 = Global1(Conn(StationsElem(S),1))
                  X2 = Global1(Conn(StationsElem(S),2))
                  X3 = Global1(Conn(StationsElem(S),3))
                  if ((X1.eq.-99999.0d0).or.(X2.eq.-99999.0d0).or.(X3.eq.-99999.0d0)) then
                    StationsTemp1 = -99999.0d0
                  endif
                else
                  StationsTemp1 = Global1(SN(S))
                ENDIF
              else
                StationsTemp1 = Global1(UseNode(S))
              end if
               WRITE(14,'(I10,5X,1E17.10)') S, StationsTemp1
            ENDDO
         ENDIF
         DEALLOCATE(Global1)
         DEALLOCATE(Global2)
      ENDDO

 999  CONTINUE

      CLOSE(UNIT=12,STATUS="KEEP")

      WRITE(*,'(A)',ADVANCE="YES") "Time series extracted successfully!"

      CLOSE(UNIT=14,STATUS="KEEP")

      DEALLOCATE(StationsElem)
      DEALLOCATE(StationsLat)
      DEALLOCATE(StationsLon)
      DEALLOCATE(Conn)
      DEALLOCATE(Weight)

   end subroutine TSextract
!----------------------------------------------------------------------
!     11
!----------------------------------------------------------------------
   Subroutine wetdry

       implicit none
       character(120)       :: file14, file63, filewet, junkC
       real(8)              :: junkR
       real(8), allocatable :: lat(:), Lon(:)
       integer, allocatable :: wetN(:), Conn(:,:)
       integer              :: i, j, junkI, NumNodes, NumElems, EC
       integer              :: N, E, NumSnaps, NumNodesNonDefault, SS

       write(6,*) "Enter the name of the fort.14 file"
       read(5,*) file14
       write(6,*) "Enter the name of the fort.63 file" 
       read(5,*) file63      
       filewet = 'wet.14'

       open(10,file=file14,status='old',action='read')
         read(10,*)
         read(10,*) NumElems, NumNodes
         allocate(Lon(1:NumNodes),Lat(1:NumNodes))
         allocate(Conn(1:NumElems,1:3))
         allocate(WetN(1:NumNodes))
         do N = 1,NumNodes
           read(10,*) junkI, Lon(N), Lat(N)
         enddo
         do E = 1,NumElems
           read(10,*) junkI, junkI, Conn(E,1), Conn(E,2), Conn(E,3)
         enddo
       close(10)

       open(20,file=file63,status='old',action='read')
         read(20,*)
         read(20,*) NumSnaps
         do SS = 1,NumSnaps
           write(6,'(A,I5,A,I5,A)') "Processing snap #",SS," of ",NumSnaps,"."
           read(20,*,END=999) junkR, junkI, NumNodesNonDefault
           do j = 1,NumNodesNonDefault
             read(20,*) N
             wetN(N) = 1
           enddo
         enddo
999      continue
       close(20)

       open(30,file=filewet,status='replace',action='write')
         write(30,'(A)') "Wetness Extent fort.14 style Grid"
         write(30,300) NumElems, NumNodes
         do N = 1,NumNodes
           write(30,301) N, Lon(N), Lat(N), WetN(N)
         enddo
         EC=3
         do E = 1,NumElems
           write(30,302) E, EC, Conn(E,1), Conn(E,2), Conn(E,3)
         enddo
300    Format(2i10) 
301    Format(i10,2f15.6,i5)
302    Format(5i10)
       close(30)

   end subroutine wetdry
!----------------------------------------------------------------------
!     12
!----------------------------------------------------------------------
   subroutine findminmax(os)
      implicit none
      character(10),intent(inout)      :: os
      character(120)       :: file14, GlobalFile, junkC, Line, Comments
      real(8)              :: junkR, SnapR, DefaultValue
      real(8), allocatable :: lat(:), Lon(:), maxR(:), minR(:), TempR(:)
      integer, allocatable :: wetN(:), Conn(:,:)
      integer              :: i, j, V, N, junkI, NumNodes, nCol
      integer              :: Interval, NumElems
      integer              :: NumSnaps, NumNodesNonDefault, SS, SnapI

      write(6,'(A)',ADVANCE="NO") "Enter the name of the fort.14 file: "
      read(5,'(A)',ADVANCE="YES") file14
      write(6,'(A)',ADVANCE="NO") "Enter the name of the global file: " 
      read(5,'(A)',ADVANCE="YES") GlobalFile      

      open(10,file=trim(file14),status='old',action='read')
        read(10,*)
        read(10,*) NumElems, NumNodes
        allocate(Lon(1:NumNodes),Lat(1:NumNodes))
        do N = 1,NumNodes
          read(10,*) junkI, Lon(N), Lat(N)
        enddo
      close(10)

      OPEN(UNIT=12,FILE=TRIM(GlobalFile),ACTION="READ")
      READ(12,'(A)') JunkC
      READ(12,'(A)') Line
      READ(Line,*) NumSnaps, JunkI, JunkR, Interval, nCol, Comments
      Allocate(maxR(1:nCol),minR(1:nCol),TempR(1:nCol))
      write(6,*)
      DO SS=1,NumSnaps
        WRITE(*,'(A,I5,A,I5,A)') "Processing snap #",SS," of ",NumSnaps,"."
        READ(12,'(A)',ERR=999,END=999) Line
        Read(Line,*) SnapR, SnapI
        Read(Line,*,ERR=907,END=907) SnapR, SnapI, NumNodesNonDefault
        Goto 908
907     NumNodesNonDefault = NumNodes
908     DO N=1,NumNodesNonDefault
          READ(12,*,ERR=999,END=999) JunkI, (TempR(V), V=1,nCol)
          DO V=1,nCol
            if ((TempR(V).gt.maxR(V)).and.(TempR(V).ne.-99999.0d0)) maxR(V) = TempR(V) 
            if ((TempR(V).lt.minR(V)).and.(TempR(V).ne.-99999.0d0)) minR(V) = TempR(V)            
          enddo
        ENDDO        
      enddo
      write(6,*)
      write(6,*) "Results:"
      write(6,219) "Vector", "Maximum", "Minimum"
999   DO V=1,nCol
        write(6,220) V, maxR(V), minR(V)
      enddo
219   Format(3a10)
220   Format(i10,2f10.4) 
   end subroutine findminmax
!----------------------------------------------------------------------
!     13
!----------------------------------------------------------------------
   subroutine meow(os)
      implicit none
      character(10),intent(inout)      :: os
      real*8           :: surge,r1,r2
      integer          :: nn,node,c1,c3,c4,c5
      integer          :: nf,tag,i,j
      character(60)    :: title, maxele
      character(35)    :: title35
      character(60)    :: maxele_filelist,output_file
      real*8,dimension(:),allocatable :: Z

      write(6,*)
      write(6,*) "Maximum Envelope of Water (MEOW) Compiler Program"
      write(6,*)
      write(6,*) "Enter the name of the MEOW Output File: "       
      read(5,*) output_file
      write(6,*) "Enter the name of the MEOW Input File List: "
      read(5,*)  maxele_filelist
      write(6,*) "Enter the number of Files in the Input File List: "
      read(5,*) nf
      open(1,file=output_file,action="write")           ! output file
      open(700,file=maxele_filelist,action="read")       ! list of all max elevation files

101   format(I10,E22.10)
      do i=1,nf
        read(700,*) maxele
        write(*,*) i,nf,maxele
        open(700+i,file=maxele)
          read(700+i,*) title
          read(700+i,*) c1,nn,r1,c3,c4
          read(700+i,*) r2,c5
          if (i==1) then
            allocate(Z(nn))
            do j=1,nn
              Z(j)=-99999d0
            end do
            write(1,*) title
            write(1,*) c1,nn,r1,c3,c4
            write(1,*) r2,c5
          end if
          write(*,*) "Reading the file:  ", title
          do j=1,nn
            read(700+i,*) node,surge
            if (surge>Z(j)) then
              Z(j)=surge
            end if
          end do
        close(700+i)
      end do
      do i=1,nn
        write(1,101) i,Z(i)
      end do
      close(1)
      close(700)
   end subroutine meow
!----------------------------------------------------------------------
!     14
!----------------------------------------------------------------------
   subroutine generatemax(os)
      implicit none
      character(10),intent(inout)      :: os
      character(120)       :: file14, GlobalFile, junkC, Line, Comments
      character(120)       :: Maxfile
      real(8)              :: junkR, SnapR, DV
      real(8), allocatable :: lat(:), Lon(:), maxR(:,:), TempR(:)
      integer, allocatable :: wetN(:), Conn(:,:)
      integer              :: i, j, V, N, junkI, NumNodes, nCol
      integer              :: Interval, NumElems
      integer              :: NumSnaps, NumNodesNonDefault, SS, SnapI

      write(6,'(A)',ADVANCE="NO") "Enter the name of the fort.14 file: "
      read(5,'(A)',ADVANCE="YES") file14
      write(6,'(A)',ADVANCE="NO") "Enter the name of the global file: " 
      read(5,'(A)',ADVANCE="YES") GlobalFile      
      write(6,'(A)',ADVANCE="NO") "Enter the name of the max file: " 
      read(5,'(A)',ADVANCE="YES") MaxFile            

      open(10,file=trim(file14),status='old',action='read')
        read(10,*)
        read(10,*) NumElems, NumNodes
        allocate(Lon(1:NumNodes),Lat(1:NumNodes))
        do N = 1,NumNodes
          read(10,*) junkI, Lon(N), Lat(N)
        enddo
      close(10)

      OPEN(UNIT=12,FILE=TRIM(GlobalFile),ACTION="READ")
      OPEN(UNIT=13,FILE=TRIM(MaxFile),Status='replace',ACTION="write")
      READ(12,'(A)') JunkC
      write(13,'(A)') JunkC
      READ(12,'(A)') Line
      READ(Line,*) NumSnaps, JunkI, JunkR, Interval, nCol, Comments
      write(13,131) 1, NumNodes, 1, 1, nCol, trim(Comments)
      write(13,132) 0, 0, NumNodes, -9999.0d0
131   Format(2i10, e10.6, 2i10, a100)
132   Format(e10.6,2i10,e10.6)
      Allocate(maxR(1:NumNodes,1:nCol),TempR(1:nCol))
      Do N=1,NumNodes
        do V=1,nCol
          maxR(N,V) = -99999.0d0
        enddo
      enddo
      write(6,*)
      DO SS=1,NumSnaps
        WRITE(*,'(A,I5,A,I5,A)') "Processing snap #",SS," of ",NumSnaps,"."
        READ(12,'(A)',ERR=999,END=999) Line
        Read(Line,*) SnapR, SnapI
        Read(Line,*,ERR=907,END=907) SnapR, SnapI, NumNodesNonDefault, DV
        Goto 908
907     NumNodesNonDefault = NumNodes
908     DO N=1,NumNodesNonDefault
          READ(12,*,ERR=999,END=999) i, (TempR(V), V=1,nCol)
          DO V=1,nCol
            if ((TempR(V).gt.maxR(i,V)).and.(TempR(V).ne.-99999.0d0)) then
              maxR(i,V) = TempR(V)
            endif 
          enddo
        ENDDO        
      enddo
      write(6,*)
999   Do N=1,NumNodes
          write(6,*) N, (maxR(N,V),V=1,nCol)
      enddo
219   Format(3a10)
   end subroutine generatemax
!----------------------------------------------------------------------
!     15
!----------------------------------------------------------------------
   subroutine projector(os)
      character(10),intent(inout)      :: os



   end subroutine projector
!----------------------------------------------------------------------
!     16
!----------------------------------------------------------------------
   subroutine generatediff(os)

       implicit none
       character(120)         :: file1,file2,file3,junkC
      character(10),intent(inout)      :: os
       real(8)                :: wse1,wse2,wse3
       integer                :: i

       write(6,*)
       write(6,*) "************************************************"
       write(6,*) "   This Program will Subtract File2 from File1"
       write(6,*) "************************************************"
       write(6,'(A)',ADVANCE="NO") "Enter Filename 1: "
       read(5,'(A)',ADVANCE="YES") file1
       write(6,'(A)',ADVANCE="NO") "Enter Filename 2: "
       read(5,'(A)',ADVANCE="YES") file2
       write(6,'(A)',ADVANCE="NO") "Enter Output File: "
       read(5,'(A)',ADVANCE="YES") file3
    
       open(10,file=file1,status='old',action='read')
       open(20,file=file2,status='old',action='read')
       open(30,file=file3,status='replace',action='write')
         do i = 1,3
           read(10,'(A)') junkC
           read(20,'(A)')
           write(30,'(A)') junkC
         enddo
         write(6,*) junkC
         do
           read(10,*,END=999) i, wse1
           read(20,*) i, wse2
           if ((wse1.eq.-99999.0d0).and.(wse2.eq.-99999.0d0)) then
             wse3  = -99999.0d0
           elseif(wse1.eq.-99999.0d0) then
             wse1 = 0.0d0
             wse3 = wse1 - wse2
           elseif(wse2.eq.-99999.0d0) then
             wse2 = 0.0d0
             wse3 = wse1 - wse2
           else
             wse3 = wse1 - wse2        
           endif
           write(30,100) i, wse3
         enddo
100    Format(i10,e22.10)
999    close(10)
       close(20)
       close(30)
   end subroutine generatediff
!----------------------------------------------------------------------
!     17
!----------------------------------------------------------------------     
   subroutine listnodes(os)

      implicit none
      character(120)                :: StationsFile,NodesFile,PFile
      character(120)                :: StnID
      character(120), allocatable   :: StationName(:)
      character(10), intent(in)     :: os
      integer                       :: extension, X1, NumNodes, i, S
      integer                       :: NumStations, UseNode
      integer, allocatable          :: NodeNumber(:)
      real (8)                      :: StationsLon, StationsLat

      WRITE(*,'(A)',ADVANCE="YES") "Enter name of stationfile: "
      extension = 2
      call choosefile(StationsFile,extension,os)
      write(6,*)

      WRITE(*,'(A)',ADVANCE="YES") "Enter name of preferred node file: "
      extension = 4
      call choosefile(NodesFile,extension,os)
      write(6,*)

      X1 = len_trim(StationsFile)      
      PFile = StationsFile(1:X1-8)//'P.Stations'


      OPEN(UNIT=21,FILE=TRIM(NodesFile),ACTION="READ")
        read(21,*) NumNodes
        allocate(StationName(1:NumNodes),NodeNumber(1:NumNodes))
        do i = 1,NumNodes
          read(21,*,END=999) StationName(i),NodeNumber(i)
        enddo
999   continue
      close(21)


      open(UNIT=11,FILE=TRIM(StationsFile),ACTION="READ")
      open(UNIT=31,FILE=TRIM(PFile),status='replace',ACTION="write")      
        read(11,*) NumStations
        write(31,*) NumStations
        do S=1,NumStations
           read(11,*) StnID, StationsLat, StationsLon
           UseNode = 0
           do i = 1,NumNodes
             if (trim(StnID).eq.trim(StationName(i))) UseNode = i
           enddo
           if (UseNode.gt.0) then
             write(31,*) trim(StnID),StationsLat,StationsLon,NodeNumber(UseNode)
           else
             write(31,*) trim(StnID),StationsLat,StationsLon
           endif             
        enddo
      close(UNIT=11,STATUS="KEEP")
      close(UNIT=31,STATUS="KEEP")      

   end subroutine listnodes   
!----------------------------------------------------------------------
!     21
!----------------------------------------------------------------------   
   subroutine CRMS2IMEDS

      implicit none
      character(120)                :: filestations, fileCRMS, fileIMEDS, tempC
      character(1000)               :: templine
      character(120)                :: stnid, pstnid, sdate, stime, fstnid
      integer                       :: iflag, i , j, k, nsta 
      integer                       :: yyi, moi, ddi, hhi, mii, ssi
      integer                       :: yyf, mof, ddf, hhf, mif, ssf
      integer                       :: yyc, moc, ddc, hhc, mic, ssc
      integer                       :: defval=-999
      integer, allocatable          :: X(:)
      integer,allocatable           :: calen(:), cd(:)
      double precision              :: IDATE, CDATE, FDATE, lat, lon, adjetd

      write(6,*) "What is the initial date? (Year, Month, Day, Hour, Min, Sec)"
      read(5,*) yyi, moi,ddi,hhi,mii,ssi
      write(6,*) "What is the final date? (Year, Month, Day, Hour, Min, Sec)"
      read(5,*) yyf, mof,ddf,hhf,mif,ssf
      write(6,*)
      write(6,*) "Enter the name of the CRMS input file"
      read(5,*) fileCRMS
      write(6,*) "Enter the name of the IMEDS output file"
      read(5,*) fileIMEDS
      write(6,*) "Enter the name of the CRMS stations file"
      read(5,*) filestations
      write(6,*)
      Allocate(X(1:17))

      if (yyi.ne.yyf) then
        write(6,*) "Cross-years currently not permitted with this release"
        stop
      endif

      open(unit=20,file=fileCRMS,status='old',action='read')
      read(20,*)
      open(unit=21,file=fileIMEDS,status='replace',action='write')
      open(unit=23,file='notfound.txt',status='replace',action='write')

      write(21,*) "% IMEDS generic format - Water Level"
      write(21,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
      write(21,*) "CRMS " , "UTC", " NAVD88"

      allocate(calen(1:12), cd(1:13))

      calen = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
      cd = (/ 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 /)
      if( mod(yyi,4) == 0 ) then
        calen(2) = 29 !leap year
        cd = (/ 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366 /)
      endif
      IDATE = cd(moi) + ddi + hhi/24.0d0 + mii/1440.0d0 + ssi/86400.0d0
      FDATE = cd(mof) + ddf + hhf/24.0d0 + mif/1440.0d0 + ssf/86400.0d0
     
      iflag = 1
      nsta = 0
      pstnid = "0"
      do while (iflag.eq.1) 
        read(20,'(A1000)',ERR=999,END=999) templine
        X(1) = index(templine,",")
        do i = 2,17
          X(i) =X(i-1) + index(templine(X(i-1)+1:1000),",")
        enddo
        stnid = templine(1:X(1)-1)
        stnid = trim(stnid)
        sdate = templine(X(1)+1:X(2)-1)
        stime = templine(X(2)+1:X(3)-1)
        tempC = TRIM(templine(X(15)+1:X(16)-1))
        if (len_trim(tempC).eq.0) then
          adjetd = 0.0d0
        else 
          read(tempC(:),'(f10.5)') adjetd
        endif
          read(sdate(1:2),'(i10)') moc
          read(sdate(4:5),'(i10)') ddc
          read(sdate(7:10),'(i10)') yyc
          read(stime(1:2),'(i10)') hhc
          read(stime(4:5),'(i10)') mic
          read(stime(7:8),'(i10)') ssc
        CDATE = cd(moc) + ddc + hhc/24.0d0 + mic/1440.0d0 + ssc/86400.0d0
        if ((CDATE.ge.IDATE).and.(CDATE.le.FDATE).and.(yyc.eq.yyi)) then
          if (stnid.ne.pstnid) then
            write(6,*) "Processing Station Id: ", trim(stnid)
            pstnid=stnid
            !Search for Latitude,Longitude
            open(unit=22,file=filestations,status='old',action='read')
              fstnid = "0"
              do while ((trim(trim(fstnid))).ne.(trim(trim(stnid))))  
                read(22,*,ERR=997,END=998) fstnid, lon,lat
                fstnid = trim(fstnid)
              enddo
              if ((trim(trim(fstnid))).eq.(trim(trim(stnid)))) goto 995
997           write(6,*) trim(stnid), " ERROR"
998           continue
              lat = 1.0d0
              lon = 1.0d0
              write(6,*) trim(stnid), " Could not be found"
              write(23,*) trim(stnid)
995         continue
            close(22)
            nsta = nsta + 1
            write(21,*) "CRMS_"//TRIM(stnid), lat, lon
          endif
          adjetd = 0.3048d0 * adjetd         ! Convert Feet to Meters
          write(21,220) yyc, moc, ddc, hhc, mic, ssc, adjetd
        endif
      enddo
220   Format(6i7,F14.4)
999   continue

      close(23)
      close(21)
      close(20)
      write(6,*) "Processed ", nsta, " Stations"

   end subroutine CRMS2IMEDS
!----------------------------------------------------------------------
!     22
!----------------------------------------------------------------------
   subroutine NOAA2IMEDS

      implicit none

      character(120)                :: filestations
      character(120)                :: sdate, stime, tempC, junkC
      character(200)                :: templine, templine2
      character(120),allocatable    :: stnid(:), datum(:), filename(:),state(:)
      integer                       :: iflag, i , j, k, nsta, iver 
      integer                       :: yy, mo, dd, hh, mi, ss
      double precision, allocatable :: lat(:), lon(:), conv(:)
      double precision              :: pred, ver
      integer                       :: defval=-999

      write(6,*) "Enter the name of the station list"
      read(5,*) filestations
!      filestations = "NOAA_Stations.txt"

! Read Station Data
      open(unit=20,file=filestations,status='old',action='read')
        read(20,*) nsta
        read(20,*)
        allocate(lat(1:nsta), lon(1:nsta),filename(1:nsta), conv(1:nsta))
        allocate(stnid(1:nsta), state(1:nsta))
        do i=1,nsta
          read(20,*) stnid(i), filename(i), state(i), lat(i), lon(i), conv(i)
        enddo
      close(20)

! Read & Write Raw Data to IMEDS format

      open(unit=21,file="watlev_NOAA_NAVD_VER.IMEDS",status='replace',action='write')
      write(21,*) "% IMEDS generic format - Water Level"
      write(21,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
      write(21,*) "NOAA " , "UTC", " NAVD88"

      open(unit=22,file="watlev_NOAA_MSL_VER.IMEDS",status='replace',action='write')
      write(22,*) "% IMEDS generic format - Water Level"
      write(22,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
      write(22,*) "NOAA " , "UTC", " MSL"

      open(unit=23,file="watlev_NOAA_NAVD_PRE.IMEDS",status='replace',action='write')
      write(23,*) "% IMEDS generic format - Water Level"
      write(23,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
      write(23,*) "NOAA " , "UTC", " NAVD88"

      open(unit=24,file="watlev_NOAA_MSL_PRE.IMEDS",status='replace',action='write')
      write(24,*) "% IMEDS generic format - Water Level"
      write(24,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
      write(24,*) "NOAA " , "UTC", " MSL"

      iflag = 1
      ss = 0
      do i=1,nsta
        write(6,*) "Processing station Id: ", i, trim(stnid(i))
        open(unit=11,file=filename(i),status='old',action='read')
          do j=1,7
            read(11,'(a)') templine
          enddo
          iver = 1
          if (len_trim(templine).lt.35) iver = 0
          if (iver.eq.1) then
              if (conv(i).ne.-9999.0d0) then
              write(21,*) "NOAA_"//trim(stnid(i)), lat(i), lon(i)
            else
              write(22,*) "NOAA_"//trim(stnid(i)), lat(i), lon(i)
            endif
          else
              if (conv(i).ne.-9999.0d0) then
              write(23,*) "NOAA_"//trim(stnid(i)), lat(i), lon(i)
            else
              write(24,*) "NOAA_"//trim(stnid(i)), lat(i), lon(i)
            endif
          endif
          do while (iflag.eq.1)
            read(11,'(a)',END=996) templine
            if (len_trim(templine).eq.0) goto 996
            read(templine(9:12),'(i10)') yy
            read(templine(13:14),'(i10)') mo
            read(templine(15:16),'(i10)') dd
            read(templine(18:19),'(i10)') hh
            read(templine(21:22),'(i10)') mi
            templine2 = templine(24:len_trim(templine))
            if (iver.eq.1) then
              read(templine2,221,ERR=998) pred, ver
              if (conv(i).ne.-9999.0d0) then
                ver = ver-conv(i)
                write(21,220) yy, mo, dd, hh, mi, ss, ver
              else
                write(22,220) yy, mo, dd, hh, mi, ss, ver
              endif
              goto 997
998           if (conv(i).ne.-9999.0d0) then
                ver = ver-conv(i)        
                write(21,220) yy, mo, dd, hh, mi, ss, -999
              else
                write(22,220) yy, mo, dd, hh, mi, ss, -999
              endif
            else
              read(templine2,*) pred
              if (conv(i).ne.-9999.0d0) then
                pred = pred-conv(i)                      
                write(23,220) yy, mo, dd, hh, mi, ss, pred
              else
                write(24,220) yy, mo, dd, hh, mi, ss, pred
              endif              
            endif
997         continue
          enddo
996       continue
        close(11)
      enddo
      write(6,*) "FINISHED"
220   Format(6i7,F14.4)
221   Format(f7.3,1x,f7.3)
222   Format(6i6,i10)
      close(21)
      close(22)
      close(23)
      close(24)
      close(25)

   end subroutine NOAA2IMEDS
!----------------------------------------------------------------------
!     23
!----------------------------------------------------------------------
   subroutine TCOON2IMEDS
 
      implicit none
      character(120)                :: filestations
      character(120)                :: sdate, stime
      character(120),allocatable    :: stnid(:), filename(:), desc(:), datum(:)
      integer                       :: iflag, i , j, k, nsta
      integer                       :: yy, mo, dd, hh, mi, ss, dy
      double precision, allocatable :: lat(:), lon(:), conv(:)
      double precision              :: wse, junkD

      write(6,*) "Enter the name of the TCOON station list"
      read(5,*) filestations

! Read Station Data
      open(unit=20,file=filestations,status='old',action='read')
      read(20,*) nsta
      read(20,*)
      allocate(lat(1:nsta), lon(1:nsta),filename(1:nsta), conv(1:nsta))
      allocate(stnid(1:nsta),desc(1:nsta),datum(1:nsta))
      do i=1,nsta
        read(20,*) stnid(i), desc(i), filename(i), lat(i), lon(i), datum(i), conv(i)
      enddo
      close(20)

! Read & Write Raw Data to IMEDS format

      open(unit=21,file="watlev_TCOON_NAVD88.IMEDS",status='replace',action='write')
      write(21,*) "% IMEDS generic format - Water Level (surge)"
      write(21,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
      write(21,*) "TCOON " , "UTC", " NAVD88"

      iflag = 1
      ss = 0
      do i=1,nsta
        write(6,*) "Processing station Id: ", i, trim(stnid(i))
        open(unit=11,file=filename(i),status='old',action='read')
          do j=1,19
            read(11,*)
          enddo
          write(21,*) "TCOON_"//trim(stnid(i)), lat(i), lon(i)
          do while (iflag.eq.1)
            read(11,*,ERR=998, END=999) sdate, stime, wse

            read(sdate(1:4),'(i10)') yy
            read(sdate(5:7),'(i10)') dy
            read(stime(1:2),'(i10)') hh
            read(stime(3:4),'(i10)') mi
            if (conv(i).ne.-9999) wse = wse + conv(i)
            call getmonthday(dy,yy,mo,dd)
            write(21,200) yy, mo, dd, hh, mi, ss, wse
998         continue            
          enddo
999       continue
        close(11)
      enddo
200   Format(6i7,F14.4)      
      close(21)
      close(22)

   end subroutine TCOON2IMEDS
!----------------------------------------------------------------------
!     24
!----------------------------------------------------------------------
   subroutine USACE2IMEDS

      implicit none
      character(120)                :: filestations, tempC
      character(120)                :: sdate, stime
      character(120),allocatable    :: stnid(:), filename(:), datum(:)
      integer                       :: iflag, i , j, k, nsta
      integer                       :: X1, X2, X3,TZC=5
      integer                       :: yy, mo, dd, hh, mi, ss
      double precision, allocatable :: lat(:), lon(:), conv(:)
      double precision              :: wse, junkD

      write(6,*) "Enter the name of the USACE station list"
      read(5,*) filestations
!      filestations = "USACE_Stations.txt"

! Read Station Data
      open(unit=20,file=filestations,status='old',action='read')
      read(20,*) nsta
      read(20,*)
      allocate(lat(1:nsta), lon(1:nsta), filename(1:nsta))
      allocate(stnid(1:nsta), conv(1:nsta), datum(1:nsta))
      do i=1,nsta
        read(20,*) stnid(i), lat(i), lon(i), filename(i), datum(i), conv(i)
      enddo
      close(20)

! Read & Write Raw Data to IMEDS format

      open(unit=21,file="watlev_USACE.IMEDS",status='replace',action='write')
      write(21,*) "% IMEDS generic format - Water Level"
      write(21,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
      write(21,*) "USACE " , "UTC", " NAVD88"

      ss = 0
      do i=1,nsta
        write(6,*) "Processing station Id: ", i, trim(stnid(i))
        open(unit=11,file=filename(i),status='old',action='read')
          write(21,*) "USACE_"//trim(stnid(i)), lat(i), lon(i)
          do
            read(11,'(a)',END=999) tempC
            X1 = index(tempC,"/")
            X2 = index(tempC(X1+1:len_trim(tempC)),"/")+X1
            X3 = index(tempC,":")
            read(tempC(1:X1-1),'(i10)') mo
            read(tempC(X1+1:X2-1),'(i10)') dd
            read(tempC(X2+1:X2+4),'(i10)') yy
            read(tempC(X2+6:X3-1),'(i10)') hh
            read(tempC(X3+1:X3+2),'(i10)') mi
            read(tempC(X3+3:len_trim(tempC)),*,ERR=998,END=998) wse
            if (conv(i).ne.-9999) wse = wse + conv(i)
            wse = 0.3048d0*wse
            goto 997
998         wse = -999.0d0
997         Call TZconvert(yy,mo,dd,hh,TZC) !Adjust for Central Time to UTC           
            write(21,200) yy, mo, dd, hh, mi, ss, wse
          enddo
999       continue
        close(11)
      enddo
200   Format(6i7,F14.4)     
      close(21)
      close(22)
      close(23)

   end subroutine 
!----------------------------------------------------------------------
!     25
!----------------------------------------------------------------------
   subroutine USGSDEPL2IMEDS

      implicit none
      character(120)                :: filestations
      character(120)                :: sdate, stime, junkC, TempC
      character(120),allocatable    :: stnid(:), datum(:), site(:),filename(:)
      integer                       :: iflag, i , j, k, nsta, iopt
      integer                       :: yy, mo, dd, hh, mi, ss, X1, X2, X3
      double precision, allocatable :: lat(:), lon(:), conv(:)
      double precision              :: wse
      integer                       :: TZC=5

      write(6,*) "Enter the name of the USGS-DEPL station list"
      read(5,*) filestations
!      filestations = "USGS-DEPL_Stations.txt"
      write(6,*)
      write(6,*) "Enter 1 for Ike or 2 for Rita"
      read(5,*) iopt
      write(6,*)

! Read Station Data
      open(unit=20,file=filestations,status='old',action='read')
      read(20,*) nsta
      read(20,*)
      allocate(lat(1:nsta), lon(1:nsta),filename(1:nsta))
      allocate(stnid(1:nsta),datum(1:nsta),site(1:nsta),conv(1:nsta))
      do i=1,nsta
        read(20,*) stnid(i), lat(i), lon(i), filename(i), datum(i), conv(i), junkC, site(i)
      enddo
      close(20)

! Read & Write Raw Data to IMEDS format

      open(unit=21,file="watlev_USGS-DEPL_surge.IMEDS",status='replace',action='write')
      write(21,*) "% IMEDS generic format - Water Level (surge)"
      write(21,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
      write(21,*) "USGS-DEPL " , "UTC", " NAVD88"

      open(unit=22,file="watlev_USGS-DEPL_beach.IMEDS",status='replace',action='write')
      write(22,*) "% IMEDS generic format - Water Level (beach)"
      write(22,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
      write(22,*) "USGS-DEPL " , "UTC", " NAVD88"

      open(unit=23,file="watlev_USGS-DEPL_riverine.IMEDS",status='replace',action='write')
      write(23,*) "% IMEDS generic format - Water Level (riverine)"
      write(23,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
      write(23,*) "USGS-DEPL " , "UTC", " NAVD88"
   
      iflag = 1
      ss = 0
      do i=1,nsta
        write(6,*) "Processing station Id: ", i, trim(stnid(i))
        open(unit=11,file=trim(filename(i)),status='old',action='read')
          select case (site(i))
            case ("surge")
              write(21,*) "USGS-DEPL_"//trim(stnid(i)), lat(i), lon(i)
            case("beach")
              write(22,*) "USGS-DEPL_"//trim(stnid(i)), lat(i), lon(i)                    
            case("riverine")
              write(23,*) "USGS-DEPL_"//trim(stnid(i)), lat(i), lon(i)
          end select  
          select case (iopt)
            case (1)
              do j=1,28
                read(11,*)
              enddo
              do while (iflag.eq.1)
                read(11,*,END=999) sdate, stime, wse
                read(sdate(7:10),'(i10)') yy
                read(sdate(1:2),'(i10)') mo
                read(sdate(4:5),'(i10)') dd
                read(stime(1:2),'(i10)') hh
                read(stime(4:5),'(i10)') mi
                Call TZconvert(yy,mo,dd,hh,TZC)
                wse = 0.3048d0*wse         !Convert Feet to Meters
                select case (site(i))
                  case ("surge")
                    write(21,200) yy, mo, dd, hh, mi, ss, wse
                  case("beach")
                    write(22,200) yy, mo, dd, hh, mi, ss, wse
                  case("riverine")
                    write(23,200) yy, mo, dd, hh, mi, ss, wse
                end select  
              enddo
            case (2)
              do j=1,23
                read(11,*)
              enddo
              do while (iflag.eq.1)
                read(11,'(a)',END=999) tempC
                X1 = index(tempC,"/")
                X2 = index(tempC(X1+1:len_trim(tempC)),"/")+X1
                X3 = index(tempC,":")
                read(tempC(1:X1-1),'(i10)') mo
                read(tempC(X1+1:X2-1),'(i10)') dd
                read(tempC(X2+1:X2+4),'(i10)') yy
                read(tempC(X3-2:X3-1),'(i10)') hh
                read(tempC(X3+1:X3+2),'(i10)') mi
                read(tempC(X3+4:X3+5),'(i10)') ss
                if (tempC(X3+7:X3+8).eq."PM") hh = hh + 12
                if ((tempC(X3+7:X3+8).eq."AM").and.(hh.eq.12)) hh = 0
                if (hh.eq.24) hh = 12
                read(tempC(X3+9:len_trim(tempC)),*,ERR=998,END=998) wse
                wse = 0.3048d0*wse
                goto 997
998             wse = -999.0d0
997             continue
                Call TZconvert(yy,mo,dd,hh,TZC)
                write(21,200) yy, mo, dd, hh, mi, ss, wse
              enddo
          end select
999       continue
        close(11)
      enddo
200   Format(6i7,F14.4)
      close(21)
      close(22)

   end subroutine USGSDEPL2IMEDS
!----------------------------------------------------------------------
!     26
!----------------------------------------------------------------------
   subroutine USGSPERM2IMEDS

      implicit none
      character(120)                :: filestations,file1,file2,file3
      character(120)                :: sdate, stime, tzone, Header1
      character(120)                :: junkC, tempC
      character(120),allocatable    :: stnid(:), filename(:), datum(:)
      integer                       :: iflag, i , j, k, nsta
      integer                       :: X1, X2, X3
      integer                       :: yy, mo, dd, hh, mi, ss
      double precision, allocatable :: lat(:), lon(:), conv(:)
      double precision              :: wse, junkD

      write(6,*) "Enter the name of the USGS-PERM station list"
      read(5,*) filestations
!      filestations = "USGS-PERM_Stations.txt"

! Read Station Data
      open(unit=20,file=filestations,status='old',action='read')
      read(20,*) nsta
      read(20,*)
      allocate(lat(1:nsta), lon(1:nsta), filename(1:nsta))
      allocate(stnid(1:nsta), conv(1:nsta), datum(1:nsta))
      do i=1,nsta
        read(20,*) stnid(i),lat(i),lon(i),filename(i),datum(i),conv(i)
      enddo
      close(20)

! Read & Write Raw Data to IMEDS format
      file1="watlev_USGS-PERM_Ike_NAVD88.IMEDS"
      Header1="% IMEDS generic format - Water Level"      

      open(unit=21,file=trim(file1),status='replace',action='write')
      write(21,*) trim(Header1)
      write(21,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
      write(21,*) "USGS-PERM " , "UTC", " NAVD88"

      ss = 0
      do i=1,nsta
        write(6,*) "Processing station Id: ", i, trim(stnid(i))
        open(unit=11,file=filename(i),status='old',action='read')
          write(21,*) "USGS-PERM_"//trim(stnid(i)), lat(i), lon(i)
          do  
            read(11,*) junkC
            if (JunkC(1:1).ne.('#')) goto 667
          enddo
667       read(11,*)          
          do
            read(11,'(A)',ERR=998,END=999) junkC
            junkC = adjustL(junkC)
            if ((JunkC(3:3).eq.'/').or.(JunkC(2:2).eq.'/')) then
              read(junkC(1:19),'(A)') tempC
              read(junkC(20:len_trim(junkC)),*) tzone, wse
              X1 = index(tempC,"/")
              X2 = index(tempC(X1+1:len_trim(tempC)),"/")+X1
              X3 = index(tempC,":")
              read(tempC(1:X1-1),'(i10)') mo
              read(tempC(X1+1:X2-1),'(i10)') dd
              read(tempC(X2+1:X2+4),'(i10)') yy
              read(tempC(X3-2:X3-1),'(i10)') hh
              read(tempC(X3+1:X3+2),'(i10)') mi
              read(tempC(X3+4:X3+5),'(i10)') ss
            else
              read(junkC,*) sdate, stime, tzone, wse
              read(sdate(1:4),'(i10)') yy
              read(sdate(5:6),'(i10)') mo
              read(sdate(7:8),'(i10)') dd
              read(stime(1:2),'(i10)') hh
              read(stime(3:4),'(i10)') mi
              read(stime(5:6),'(i10)') ss
            end if
            if (trim(tzone).ne."CDT") then
              write(6,*) "Time Zone Error"
              write(6,*) tzone, len_trim(tzone)
            endif
            if (conv(i).ne.-9999) wse = wse + conv(i)
            wse  = 0.3048d0*wse    !Convert Feet to Meters
            write(21,200) yy, mo, dd, hh, mi, ss, wse
998         continue            
          enddo
999       continue
        close(11)
      enddo
200   Format(6i7,F14.4)      
      close(21)
      close(22)
      close(23)

   end subroutine USGSPERM2IMEDS
!----------------------------------------------------------------------
!     27
!----------------------------------------------------------------------
   subroutine USACECHL

      implicit none
      character(120)                :: filestations
      character(120),allocatable    :: stnid(:), filename(:)
      integer                       :: nsta, NumPts, i, j
      integer                       :: yy, mo, dd, hh, mi, ss
      double precision, allocatable :: lat(:), lon(:), conv(:)
      double precision              :: wse, hs, tm, tp

      write(6,*) "Enter the name of the USACE-CHL station list"
      read(5,*) filestations
!      filestations = "USACE-CHL_Stations.txt"

! Read Station Data
      open(unit=20,file=trim(filestations),status='old',action='read')
      read(20,*) nsta
      read(20,*)
      allocate(lat(1:nsta), lon(1:nsta), filename(1:nsta))
      allocate(stnid(1:nsta), conv(1:nsta))
      do i=1,nsta
        read(20,*) stnid(i),filename(i), lat(i),lon(i),conv(i)
      enddo
      close(20)

! Read & Write Raw Data to IMEDS format
      open(unit=21,file="hs_USACE-CHL.IMEDS",status='replace',action='write')
      write(21,*) "% IMEDS generic format - Wave Height"
      write(21,*) "% ", "year ","month ","day ","hour ","min ","sec ", "hs (m)"
      write(21,*) "USACE-CHL " , "UTC", " NAVD88"

      open(unit=22,file="tp_USACE-CHL.IMEDS",status='replace',action='write')
      write(22,*) "% IMEDS generic format - Peak Period"
      write(22,*) "% ", "year ","month ","day ","hour ","min ","sec ", "tp (s)"
      write(22,*) "USACE-CHL " , "UTC", " NAVD88"

      open(unit=23,file="tm_USACE-CHL.IMEDS",status='replace',action='write')
      write(23,*) "% IMEDS generic format - Mean Period"
      write(23,*) "% ", "year ","month ","day ","hour ","min ","sec ", "tp (s)"
      write(23,*) "USACE-CHL " , "UTC", " NAVD88"

      open(unit=24,file="watlev_USACE-CHL.IMEDS",status='replace',action='write')
      write(24,*) "% IMEDS generic format - Water Level"
      write(24,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
      write(24,*) "USACE-CHL " , "UTC", " NAVD88"      

      ss = 0
      mi = 0
      do i=1,nsta
        write(6,*) "Processing station Id: ", i, trim(stnid(i))
        open(unit=11,file=filename(i),status='old',action='read')
          write(21,*) "USACE-CHL_"//trim(stnid(i)), lat(i), lon(i)
          write(22,*) "USACE-CHL_"//trim(stnid(i)), lat(i), lon(i)
          write(23,*) "USACE-CHL_"//trim(stnid(i)), lat(i), lon(i)
          write(24,*) "USACE-CHL_"//trim(stnid(i)), lat(i), lon(i)
          read(11,*) NumPts
          do j = 1,8
            read(11,*)
          enddo
          do j = 1,NumPts
            read(11,*) mo, dd, yy, hh, hs, tm, tp, wse
            yy = yy + 2000
            wse = wse + conv(i)
            write(21,200) yy, mo, dd, hh, mi, ss, hs
            write(22,200) yy, mo, dd, hh, mi, ss, tp
            write(23,200) yy, mo, dd, hh, mi, ss, tm
            write(24,200) yy, mo, dd, hh, mi, ss, wse            
          enddo
        close(11)
      enddo
200   Format(6i7,F14.4)      
      close(21)
      close(22)
      close(23)
      close(24)      

   end subroutine USACECHL
!----------------------------------------------------------------------
!     28
!----------------------------------------------------------------------
   subroutine SLOSH2IMEDS

      implicit none
      character(120)                :: filestations, Line
      character(120),allocatable    :: stnid(:), filename(:)
      integer                       :: nsta, i, j
      integer                       :: yy, mo, dd, hh, mi, ss
      double precision, allocatable :: lat(:), lon(:)
      double precision              :: wse

      write(6,*) "Enter the name of the SLOSH station list"
      read(5,*) filestations

! Read Station Data
      open(unit=20,file=trim(filestations),status='old',action='read')
      read(20,*) nsta
      read(20,*)
      allocate(lat(1:nsta), lon(1:nsta), filename(1:nsta))
      allocate(stnid(1:nsta))
      do i=1,nsta
        read(20,*) stnid(i),lat(i),lon(i),filename(i)
      enddo
      close(20)

! Read & Write Raw Data to IMEDS format
      open(unit=21,file="watlev_SLOSH.IMEDS",status='replace',action='write')
      write(21,*) "% IMEDS generic format - Water Level"
      write(21,*) "% ", "year ","month ","day ","hour ","min ","sec ", "watlev (m)"
      write(21,*) "SLOSH " , "UTC", " NAVD88"
      do i=1,nsta
        write(6,*) "Processing station Id: ", i, trim(stnid(i))
        open(unit=11,file=filename(i),status='old',action='read')
          write(21,*) trim(stnid(i)), lat(i), lon(i)
          do j = 1,4
            read(11,*)
          enddo
          do
            read(11,'(A)',END=999,ERR=999) Line
            read(Line(1:2),'(i10)') mo
            read(Line(4:5),'(i10)') dd
            read(Line(7:10),'(i10)') yy
            read(Line(12:13),'(i10)') hh
            read(Line(15:16),'(i10)') mi
            read(Line(18:19),'(i10)') ss
            read(Line(21:len_trim(Line)),*) wse
            write(21,200) yy, mo, dd, hh, mi, ss, wse
          enddo
999     close(11)
      enddo
200   Format(6i7,F14.4)      
      close(21)
      close(22)
      close(23)
      close(24)      

   end subroutine SLOSH2IMEDS   
!----------------------------------------------------------------------
!     31
!----------------------------------------------------------------------
   subroutine IMEDScntrl(os)

      implicit none
      character(120)                :: filecntrl, RunID
      character(10), intent(inout)  :: os
      integer                       :: extension=5, cntrl=1, X1
      integer                       :: i, NumFiles, dtype
      integer                       :: dateu(5),j, NumTypes
      character(120)                :: filestationu,fort14u
      character(120)                :: fort63u,fort61u     
      character(120)                :: filestation
      character(120)                :: dfolder 

      write(6,*) "Enter the name of the input cntrl file"
      call choosefile(filecntrl,extension,os)
      write(6,*)
      open(unit=10,file=filecntrl,status='old',action='read')
        read(10,*) dateu(1), dateu(2), dateu(3), dateu(4), dateu(5)
        read(10,*) fort14u
        read(10,*) RunID
        read(10,*) dfolder
        read(10,*) NumTypes
        do j = 1,NumTypes
          read(10,*) NumFiles
          read(10,*) fort63u
          read(10,*) dtype
          do i = 1,NumFiles
            read(10,'(A)') filestation
            filestationu = trim(filestation)
             X1 = len_trim(filestationu)
             if (filestationu(X1-7:X1).eq.'Stations') then
               fort61u = filestationu(1:X1-9)//'.'//trim(RunID)//'.61'
             else
               fort61u = trim(filestationu)//'.'//trim(RunID)//'.61'
            endif
            call TSextract(os,cntrl,filestationu,fort14u,fort63u,RunID,dfolder)
            call IMEDS61(os, cntrl, dateu, filestationu, fort61u,dtype,dfolder)
          enddo
        enddo
      close(10)

   end subroutine IMEDScntrl
!----------------------------------------------------------------------
!     TOOLS-1
!----------------------------------------------------------------------
   subroutine getmonthday(dy,yy,mo,dd)

      implicit none
      integer, intent(out)           :: mo, dd
      integer, intent(in)            :: yy, dy
      integer                       :: i
      integer, allocatable          :: cd(:)

      allocate(cd(1:13))
      cd = (/ 0,31,59,90,120,151,181,212,243,273,304,334,365 /)
      if( mod(yy,4) == 0 ) then
        cd = (/ 0,31,60,91,121,152,182,213,244,274,305,335,366 /)
      endif
      do i = 1,12
        if (dy.gt.cd(i)) then
          mo = i
          dd = dy-cd(i)
        endif
      enddo

   end subroutine
!----------------------------------------------------------------------
!     TOOLS-2
!----------------------------------------------------------------------
   subroutine TZconvert(yy,mo,dd,hh,TZC)

      implicit none
      integer, intent(inout)      :: yy, mo, dd, hh, TZC
      integer                     :: i 
      integer, allocatable          :: calen(:)

      allocate(calen(1:12))
      calen = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
      if( mod(yy,4) == 0 ) then
        calen(2) = 29
      endif
      hh = hh + TZC
      if (hh.gt.23) then
        hh = hh-24
        dd = dd + 1
        if (dd.gt.calen(mo)) then
          dd = 1
          mo = mo + 1
          if (mo.gt.12) then
            mo = 1
            yy = yy + 1
          endif
        endif
      endif

   end subroutine TZconvert
!----------------------------------------------------------------------
!     TOOLS-3
!----------------------------------------------------------------------
   subroutine choosefile(filename,extnum,os)

      implicit none
      character(10)                     :: extension
      character(10), intent(inout)      :: os
      character(120)                    :: filename
      character(120)                    :: systemcommand
      character(120), allocatable       :: filelist(:)
      integer                           :: i, n, iopt
      integer, intent(in)               :: extnum

      select case(extnum)
        case(1)
          extension='IMEDS'
        case(2) 
          extension='Stations'
        case(3)
          extension='61'
        case(4)
          extension='txt'
        case(5)
          extension='cntrl'
      end select
      if (trim(os) == "unix") then
        CALL system('ls -1 -p *.'//TRIM(extension)//'> choosefilelist')
      else
        CALL system('dir /b *.'//TRIM(extension)//'> choosefilelist')
      endif

      open(15,file="choosefilelist")
        n = 0
        do
          read(15,'(A)',END=10)
          n = n + 1
        enddo
10    close(15)
      allocate(filelist(1:n))
      open(15,file="choosefilelist")
        do i = 1,n
          read(15,'(A)') filelist(i)
          write(6,*) i, ") ", trim(filelist(i)) 
        enddo
      close(15)
      write(6,*) n+1,") ", "User-Defined"
999   write(6,'(A)',ADVANCE="NO") "Enter Selection: "
      read(5,'(i10)',ERR=999) iopt
      if (iopt<n+1) then
        filename = trim(filelist(iopt))
      else
        write(6,'(A)',ADVANCE="NO") "Enter User-Defined Filename:"
        read(5,*) filename
      endif
      write(6,*) filename
   end subroutine

