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 hk_file
      use util
!  -------------
      implicit none
      character(len=1) ::  yn
      character(len=128) ::  fname
      character(len=8) ::  mrec_key
      character(len=120) ::  mrec_data
      type(hk_block_defn_KEY), pointer :: hk_air
      integer  ::  ierr, jerr, i
!
      ierr = 0
!     open file
      call hk_file_open_KEY(hk_air, "airport",  21, "readwrite")
      if(.not.associated(hk_air)) then
        ierr = -1
      end if
      write(unit=*,fmt=*) " after first open ",ierr
      if(ierr .ne. 0) then
         write(unit=*,fmt=*) " create file "
         ierr = 0
         jerr = 0
         call hk_file_create_KEY("airport", 251, 21, ierr)
         if(ierr .ne. 0) then
            write(unit=*,fmt=*) " create error ",ierr
         end if
         call hk_file_open_KEY(hk_air ,"airport",  21, "readwrite")
         if(.not.associated(hk_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: n= write-new, r= read, d= delete"
        write(unit=*,fmt=*) " function: q= quit"
        write(unit=*,fmt=*) "           R= read-from-file, D= delete-from-file"
      end if
      write(unit=*,fmt="(a)") " Command: "
      read (unit=*,fmt=*) yn
      if (yn .eq. "q")  then
        exit outer
      end if
      if (yn .eq. "R" ) 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
          call hk_put_new_record_KEY (hk_air, mrec_key, mrec_data, 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. "r") then
         write(unit=*,fmt=*)  " please type in key"
         read(unit=*,fmt=*) mrec_key
         call raicas(mrec_key)
         call hk_get_record_KEY(hk_air, mrec_key, mrec_data, ierr)
           if(ierr .ne. 0) then
             write(unit=*,fmt=*) "  Record not found"
           else
             write(unit=*,fmt="(a,a8,a)") " record = ", mrec_key, mrec_data
           end if
       else if (yn .eq. "n") then
         write(unit=*,fmt=*)" type in new record data "
         read(unit=*,fmt=*)mrec_key, mrec_data
         call raicas(mrec_key)
         call hk_put_new_record_KEY(hk_air, mrec_key, mrec_data, 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 hk_get_record_KEY(hk_air, mrec_key, mrec_data, ierr)
           if(ierr .ne. 0) then
             write(unit=*,fmt=*) " read error", ierr
           else
             write(unit=*,fmt=*) " record = ", mrec_key," ", mrec_data
           end if
         write(unit=*,fmt=*) " type in new record data "
         read(unit=*,fmt=*) mrec_data
         call hk_delete_record_KEY(hk_air, mrec_key, ierr)
         call hk_put_new_record_KEY(hk_air, mrec_key, mrec_data, 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 hk_delete_record_KEY(hk_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 hk_delete_record_KEY(hk_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
         write(unit=*,fmt=*) " unrecogized command ",yn
         yn = "?"
       end if

      end do outer

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