module util
      public :: raicas
      contains
      subroutine raicas (zstr)
      character (len=*), intent(in out) :: zstr
!  Raise a string to upper case
      character (len=26), parameter :: zlwc = "abcdefghijklmnopqrstuvwxyz"
      character (len=26), parameter :: zupc = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
      integer :: lstr, istr, irnk
!  
      lstr = len_trim (zstr)
      do istr = 1, lstr
        irnk = index (zlwc, zstr (istr:istr))
        if (irnk .gt. 0) then
          zstr (istr:istr) = zupc (irnk:irnk)
        end if
      end do
      return
      end subroutine raicas
      end module util
!  -------------
      program airport
      use is_file
      use util
!  -------------
!     demonstration program for isf110.f90
!     copyright (c) 1997, Garnatz and Grovender, Inc. 
!  -------------
      implicit none
      character(len=1) ::  yn
      character(len=128) ::  fname
      character(len=8) ::  mrec_key
      character(len=120) ::  mrec_data
      type(data_record_type_isdata) :: tmp_rec
      type(is_block_defn), pointer :: is_air
      integer  ::  ierr, jerr, i
!
      ierr = 0
!     open file
      ! write(unit=*,fmt=*) " try to open file "
      nullify(is_air)
      call is_file_open(is_air, "airport", 21, 22)
      if(.not.associated(is_air)) then
        ierr = -1
      end if
      !write(unit=*,fmt=*) " after first open ",ierr
      if(ierr .ne. 0) then
         !write(unit=*,fmt=*) " create file "
         write(unit=*,fmt=*)" indexed file is empty, the first command you want to do"
         write(unit=*,fmt=*)" is either 'a' to add a record, or 'A' to add from a file"
         ierr = 0
         jerr = 0
         call is_file_create("airport", 21, 22, ierr)
         if(ierr .ne. 0) then
            write(unit=*,fmt=*) " create error ",ierr
         end if
         call is_file_open(is_air ,"airport", 21, 22)
         if(.not.associated(is_air)) then
            jerr = -1
         end if
         if((ierr .ne. 0) .or. (jerr .ne. 0)) then
            write(unit=*,fmt=*) " can't open or create file", jerr
            stop
          end if
      end if
!
      yn = "?"
      outer: do
      ierr = 0
      if( yn .eq. "?" ) then
        write(unit=*,fmt=*) "function:  l= lookup, m= modify,  q= quit"
        write(unit=*,fmt=*) "           1= rewind, $= skip-to-eof, >= next, <= prev"
        write(unit=*,fmt=*) "           A= add-from-file, a= add-new-record"
        write(unit=*,fmt=*) "           D= delete-from-file, d= delete-record"
      end if
      write(unit=*,fmt="(a)") " Command: "
      read (unit=*,fmt=*) yn
      if (yn .eq. "q")  then
        exit outer
      end if
      if (yn .eq. "A" ) then
        i = 0
        fname = " "
        write(unit=*, fmt="(a)") " Filename: "
        read(unit=*,fmt=*) fname
        open(unit=1,file=fname, action="read",status="old", iostat=ierr)
        rdloop : do
          read(unit=1,fmt="(a3,5x,a)", iostat = ierr) mrec_key, mrec_data
          if(ierr /= 0) then
             exit rdloop
          end if
          call raicas(mrec_key)
          i = i + 1
          tmp_rec % key = mrec_key
          tmp_rec % data = mrec_data
          call is_put_record (is_air, tmp_rec, ierr)
          if(ierr .ne. 0) then
             write(unit=*,fmt=*) " put error ", ierr, mrec_key
          end if
        end do rdloop
        !write(unit=*,fmt=*) " eof ", ierr, mrec_key
        close(unit=1)
        write(unit=*,fmt=*) i," records read "
      else if (yn .eq. "l") then
         write(unit=*,fmt=*)  " please type in key"
         read(unit=*,fmt=*) mrec_key
         call raicas(mrec_key)
         call is_get_record(is_air, mrec_key, tmp_rec, ierr)
         mrec_data = tmp_rec % data
           if(ierr /= 0) then
             write(unit=*,fmt=*)" Record not found, here is what is close"
             call is_get_prev_record(is_air, tmp_rec, ierr)
             call is_get_prev_record(is_air, tmp_rec, ierr)
             if(ierr == 0) then
                write(unit=*,fmt="(1x,a,a)")  tmp_rec%key, tmp_rec%data
             end if
             call is_get_next_record(is_air, tmp_rec, ierr)
             if(ierr == 0) then
                write(unit=*,fmt="(1x,a,a)")  tmp_rec%key, tmp_rec%data
             end if
             call is_get_next_record(is_air, tmp_rec, ierr)
             if(ierr == 0) then
                write(unit=*,fmt="(1x,a,a)")  tmp_rec%key, tmp_rec%data
             end if
           else
             write(unit=*,fmt="(a,a8,a8,a)") " record found= ", mrec_key, tmp_rec % key, mrec_data
           end if
       else if (yn .eq. "a") then
         write(unit=*,fmt=*)" type in new record data "
         read(unit=*,fmt=*)mrec_key, mrec_data
         call raicas(mrec_key)
         tmp_rec % key = mrec_key
         tmp_rec % data = mrec_data
         call is_put_record (is_air, tmp_rec, ierr)
           if(ierr .ne. 0)  then
               write(unit=*,fmt=*) " write(new) error"
           end if
       else if (yn .eq. "m") then
         write(unit=*,fmt=*)  " please type in key"
         read(unit=*,fmt=*) mrec_key
         call raicas(mrec_key)
         call is_get_record(is_air, mrec_key, tmp_rec, ierr)
           if(ierr .ne. 0) then
             write(unit=*,fmt=*) "  Record not found", ierr, mrec_key
             yn = " "
             cycle outer
           else
             mrec_data = tmp_rec % data
             write(unit=*,fmt="(a,a8,a8,a)") " record = ", mrec_key, tmp_rec % key, mrec_data
           end if
         write(unit=*,fmt=*) " type in new record data "
         read(unit=*,fmt=*) mrec_data
         tmp_rec % data = mrec_data 
         call is_delete_record(is_air, mrec_key, ierr)
         call is_put_record (is_air, tmp_rec, ierr)
         if(ierr .ne. 0) then
             write(unit=*,fmt=*)" write(replace) error", ierr
         end if
       else if (yn .eq. "d") then
         write(unit=*,fmt=*) " please type in key"
         read (unit=*,fmt=*) mrec_key
         call raicas(mrec_key)
         call is_delete_record(is_air, mrec_key, ierr)
           if(ierr .ne. 0) then
             write(unit=*,fmt=*) " delete error:", mrec_key," ",ierr
           end if
       else if (yn .eq. "D") then
         i = 0
         fname = " "
         write(unit=*,fmt="(a)") " Filename: "
         read (unit=*,fmt=*) fname
         open(unit=2,file=fname, action="read",status="old",iostat=ierr)
        if(ierr /= 0) then
           write(unit=*,fmt=*) " data input (Delete)  open error "
           cycle outer
        end if
         readloop : do
          read(unit=2,fmt="(a3)",iostat=ierr) mrec_key
          if (ierr /= 0) then
            exit readloop
          end if
          call raicas(mrec_key)
          call is_delete_record(is_air, mrec_key, ierr)
           if(ierr .ne. 0) then
             write(unit=*,fmt=*) " delete error ", mrec_key
           else
             i = i + 1
           end if
         end do readloop
         write(unit=*,fmt=*) i," records deleted"
         close(unit=2)
       else if (yn == "1") then
         write(unit=*,fmt=*) " position at beginning "
         call is_pos_begin(is_air, ierr)
           if(ierr < 0) then
             write(unit=*,fmt=*)" position error", ierr
           end if
       else if (yn == "$") then
         write(unit=*,fmt=*) " position at end "
         call is_pos_eof(is_air, ierr)
           if(ierr < 0) then
             write(unit=*,fmt=*)" posiion error", ierr
           end if
       else if (yn == "<") then
         write(unit=*,fmt=*) " previous "
         call is_get_prev_record(is_air, tmp_rec, ierr)
           if(ierr < 0) then
             write(unit=*,fmt=*)" read error", ierr
           else
             write(unit=*,fmt=*)" record = ", tmp_rec % key," ", trim(tmp_rec % data)
           end if
       else if (yn == ">") then
         write(unit=*,fmt=*) " next "
         call is_get_next_record(is_air, tmp_rec, ierr)
           if(ierr < 0) then
             write(unit=*,fmt=*)" read error", ierr
           else
             write(unit=*,fmt=*)" record = ", tmp_rec % key," ", trim(tmp_rec % data)
           end if
       else
         write(unit=*,fmt=*) " unrecogized command ",yn
         yn = "?"
       end if

      end do outer

      if(ierr .eq. 0) then
         write(unit=*,fmt=*) " closing "
         call is_file_close(is_air, ierr)
      end if
        if(ierr .ne. 0) then
          write(unit=*,fmt=*) " close error", ierr
        end if
      stop
! ------------------------------------------------
      end program airport