!----- AGPL --------------------------------------------------------------------
!                                                                               
!  Copyright (C)  Stichting Deltares, 2015.                                     
!                                                                               
!  This file is part of Delft3D (D-Flow Flexible Mesh component).               
!                                                                               
!  Delft3D is free software: you can redistribute it and/or modify              
!  it under the terms of the GNU Affero General Public License as               
!  published by the Free Software Foundation version 3.                         
!                                                                               
!  Delft3D  is distributed in the hope that it will be useful,                  
!  but WITHOUT ANY WARRANTY; without even the implied warranty of               
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the                
!  GNU Affero General Public License for more details.                          
!                                                                               
!  You should have received a copy of the GNU Affero General Public License     
!  along with Delft3D.  If not, see <http://www.gnu.org/licenses/>.             
!                                                                               
!  contact: delft3d.support@deltares.nl                                         
!  Stichting Deltares                                                           
!  P.O. Box 177                                                                 
!  2600 MH Delft, The Netherlands                                               
!                                                                               
!  All indications and logos of, and references to, "Delft3D",                  
!  "D-Flow Flexible Mesh" and "Deltares" are registered trademarks of Stichting 
!  Deltares, and remain the property of Stichting Deltares. All rights reserved.
!                                                                               
!-------------------------------------------------------------------------------

! $Id: xbeach_readkey.F90 42642 2015-10-21 11:34:20Z dam_ar $
! $HeadURL: https://repos.deltares.nl/repos/ds/trunk/additional/unstruc/src/xbeach_readkey.F90 $
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
! Copyright (C) 2007 UNESCO-IHE, WL|Delft Hydraulics and Delft University !
! Dano Roelvink, Ap van Dongeren, Ad Reniers, Jamie Lescinski,            !
! Jaap van Thiel de Vries, Robert McCall                                  !       
!                                                                         !
! d.roelvink@unesco-ihe.org                                               !
! UNESCO-IHE Institute for Water Education                                !
! P.O. Box 3015                                                           !
! 2601 DA Delft                                                           !
! The Netherlands                                                         !
!                                                                         !
! This library is free software; you can redistribute it and/or           !
! modify it under the terms of the GNU Lesser General Public              !
! License as published by the Free Software Foundation; either            !
! version 2.1 of the License, or (at your option) any later version.      !
!                                                                         !
! This library is distributed in the hope that it will be useful,         !
! but WITHOUT ANY WARRANTY; without even the implied warranty of          !
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU        !
! Lesser General Public License for more details.                         !
!                                                                         !
! You should have received a copy of the GNU Lesser General Public        !
! License along with this library; if not, write to the Free Software     !
! Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307     !
! USA                                                                     !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!! Adapted for use in DFLOW FM

module m_xbeach_readkey
  use m_xbeach_typesandkinds
  implicit none

contains

  real*8 function readkey_dbl(fname,key,defval,mnval,mxval,bcast,required)
    use m_xbeach_errorhandling
    use m_xbeach_filefunctions
    implicit none
    character(len=*)  :: fname,key
    character(slen)     :: printkey
    real*8            :: defval,mnval,mxval
    logical, intent(in), optional :: bcast,required

    character(slen)   :: value,tempout
    real*8         :: value_dbl
    logical        :: lbcast,lrequired
    character(slen)  :: fmt
    integer          :: ier

    fmt = '(a,a,a,f0.4,a,f0.4)'

    if (present(bcast)) then
       lbcast = bcast
    else
       lbcast = .true.
    endif

    if (present(required)) then
       lrequired = required
    else
       lrequired = .false.
    endif

    printkey = ' '
    printkey(2:24)=trim(key)
    printkey(1:1)=' '


       call readkey(fname,key,value)

       if (value/=' ') then
          read(value,'(f10.0)',iostat=ier)value_dbl
          if (ier .ne. 0) then
             tempout = trim(fname)//' (value of '''//trim(printkey)//''' cannot be interpreted)'
             call report_file_read_error(tempout)
          endif
          if (value_dbl>mxval) then
             call writelog('lw','(a12,a,f0.4,a,f0.4)',(printkey),' = ',value_dbl,' Warning: value > recommended value of ',mxval)
             call writelog('s','(a12,a,a,f0.4)','Warning: ',trim(printkey),' > recommended value of ',mxval)
          elseif (value_dbl<mnval) then
             call writelog('lw','(a12,a,f0.4,a,f0.4)',(printkey),' = ',value_dbl,' Warning: value < recommended value of ',mnval)
             call writelog('s','(a12,a,a,f0.4)','Warning: ',trim(printkey),' < recommended value of ',mnval)
          else
             call writelog('l','(a12,a,f0.4)',(printkey),' = ',value_dbl)
          endif
       else
          if (lrequired) then
             call writelog('lse','','Error: missing required value for parameter ',printkey)
             call xbeach_errorhandler
          else
             value_dbl=defval
             call writelog('l','(a12,a,f0.4,a)',(printkey),' = ',value_dbl,' (no record found, default value used)')
          endif
       endif

    readkey_dbl=value_dbl
  end function readkey_dbl

  function readkey_int(fname,key,defval,mnval,mxval,bcast,required) result (value_int)
    use m_xbeach_errorhandling
    use m_xbeach_filefunctions
    implicit none
    character*(*)  :: fname,key
    character(slen)  :: printkey
    character(slen)  :: value
    integer*4      :: value_int
    integer*4      :: defval,mnval,mxval,ier
    logical, intent(in), optional :: bcast, required
    logical        :: lbcast,lrequired
    character(slen)  :: fmt,tempout

    fmt = '(a,a,a,i0,a,i0)'

    if (present(bcast)) then
       lbcast = bcast
    else
       lbcast = .true.
    endif

    if (present(required)) then
       lrequired = required
    else
       lrequired = .false.
    endif
    printkey = ' '
    printkey(2:24)=trim(key)
    printkey(1:1)=' '

       call readkey(fname,key,value)

       if (value/=' ') then
          read(value,'(i256)',iostat=ier)value_int
          if (ier .ne. 0) then
             tempout = trim(fname)//' (value of '''//trim(printkey)//''' cannot be interpreted)'
             call report_file_read_error(tempout)
          endif
          if (value_int>mxval) then
             call writelog('lw',fmt,'Warning: variable ',(printkey),' ',value_int,' > recommended value of ',mxval)
             call writelog('s','(a12,a,a,i0)','Warning: ',trim(printkey),' > recommended value of ',mxval)
          elseif (value_int<mnval) then
             call writelog('lw',fmt,'Warning: variable ',(printkey),' ',value_int,' < recommended value of ',mnval)
             call writelog('s','(a12,a,a,i0)','Warning: ',trim(printkey),' < recommended value of ',mnval)
          else
             call writelog('l','(a12,a,i0)',(printkey),' = ',value_int)
          endif
       else
          if (lrequired) then
             call writelog('lse','','Error: missing required value for parameter ',printkey)
             call xbeach_errorhandler   
          else
             value_int=defval
             call writelog('l','(a12,a,i0,a)',(printkey),' = ',value_int,' (no record found, default value used)')
          endif
       endif
  end function readkey_int

  function readkey_str(fname,key,defval,nv,nov,allowed,old,bcast,required) result (value_str)
    use m_xbeach_filefunctions
    use m_xbeach_errorhandling
    implicit none
    character*(*)  :: fname,key,defval
    character(slen)  :: value_str
    character(slen)   :: value
    integer*4      :: nv,nov,i,j
    character(slen),dimension(nv) :: allowed
    character(slen),dimension(nov):: old
    logical, intent(in), optional :: bcast,required
    logical        :: lbcast,lrequired,passed
    character(slen)  :: printkey

    printkey(2:slen)=key
    printkey(1:1)=' '

    if (present(bcast)) then
       lbcast = bcast
    else
       lbcast = .true.
    endif

    if (present(required)) then
       lrequired = required
    else
       lrequired = .false.
    endif

    passed = .false.

       call readkey(fname,key,value)
       ! Change to lowercase
       call lowercase(value)
       if (value == ' ') then
          if (lrequired) then
             call writelog('lse','','Error: missing required value for parameter ',printkey)
             call xbeach_errorhandler
          else 
             value_str=defval
             call writelog('l','(a12,a,a,a)',(printkey),' = ',trim(value_str),' (no record found, default value used)')
          endif
       else
          value=adjustl(value)
          do i=1,nv
             if (trim(value)==trim(allowed(i))) then
                passed = .true.
                value_str = value
             endif
          enddo
          do j=1,nov
             if (trim(value)==trim(old(j))) then
                passed = .true.
                value_str = allowed(j)
             endif
          enddo
          if (passed) then
             call writelog('l','(a12,a,a)',printkey,' = ',trim(value_str))
          else
             call writelog('sle','(a12,a,a,a)','Invalid option for ',trim(printkey),' : ',trim(value))
             call writelog('sle','(a12,a,a)','Valid options for ',trim(printkey),' are:')
             do i=1,nv
                call writelog('sle','(a12)',trim(allowed(i)))
             enddo
             do j=1,nov
                call writelog('sle','(a12)',trim(old(j)))
             enddo
             call xbeach_errorhandler
          endif
       endif
  end function readkey_str


  function readkey_name(fname,key,bcast,required) result (value_str)
    use m_xbeach_filefunctions
    use m_xbeach_errorhandling
    implicit none
    character*(*)  :: fname,key
    character(slen)  :: value_str
    character(slen)   :: value
    logical, intent(in), optional :: bcast,required
    logical        :: lbcast,lrequired
    character(slen)  :: printkey

    printkey(2:slen)=key
    printkey(1:1)=' '

    if (present(bcast)) then
       lbcast = bcast
    else
       lbcast = .true.
    endif

    if (present(required)) then
       lrequired = required
    else
       lrequired = .false.
    endif

       call readkey(fname,key,value)
       if (value == ' ') then
          if (lrequired) then
             call writelog('lse','','Error: missing required value for parameter ',printkey)
             call xbeach_errorhandler
          else 
             value_str=' '
             call writelog('l',' (a12,a)'    ,printkey,' = None specified')
             ! write to basic params data file
             !    write(pardatfileid,*)'c ',key,' ','none'
          endif
       else
          value_str=adjustl(value)
          call writelog('l','(a12,a,a)',printkey,' = ',trim(value_str))
          ! write to basic params data file
          !    write(pardatfileid,*)'c ',printkey,' ',value_str
       endif 
  end function readkey_name

  function readkey_dblvec(fname,key,vlength,tlength,defval,mnval,mxval,bcast,required) result (value_vec)
    use m_xbeach_filefunctions
    use m_xbeach_errorhandling
    implicit none
    character*(*)  :: fname,key
    integer, intent(in) :: vlength,tlength
    real*8,dimension(tlength)  :: value_vec
    real*8            :: defval,mnval,mxval
    logical, intent(in), optional :: bcast,required
    logical        :: lbcast,lrequired

    integer          :: i, ioerr
    character(slen)   :: value
    character(slen)  :: printkey,tempout

    printkey(2:slen)=key
    printkey(1:1)=' '

    if (present(bcast)) then
       lbcast = bcast
    else
       lbcast = .true.
    endif

    if (present(required)) then
       lrequired = required
    else
       lrequired = .false.
    endif
       call readkey(fname,key,value)
       if (value/=' ') then
          read(value,*,IOSTAT=ioerr)value_vec(1:vlength)
          if (ioerr < 0) then
             call writelog('lse','','Error reading value for parameter ',printkey)
             call writelog('lse','','Check whether parameter is given sufficient number of input values')
             call xbeach_errorhandler
          endif
          do i=1,vlength
             if (value_vec(i)>mxval) then
                call writelog('lw','(a12,a,f0.4,a,f0.4)',(printkey),' = ',value_vec(i), &
                     ' Warning: value > recommended value of ',mxval)
                call writelog('s','(a12,a,a,f0.4)','Warning: ',trim(printkey),' > recommended value of ',mxval)
             elseif (value_vec(i)<mnval) then
                call writelog('lw','(a12,a,f0.4,a,f0.4)',(printkey),' = ',value_vec(i), &
                     ' Warning: value < recommended value of ',mnval)
                call writelog('s','(a12,a,a,f0.4)','Warning: ',trim(printkey),' < recommended value of ',mnval)
             else
                call writelog('l','(a12,a,f0.4)',(printkey),' = ',value_vec(i))
             endif
          enddo
       else
          if (lrequired) then
             call writelog('lse','','Error: missing required value for parameter ',printkey)
             call xbeach_errorhandler
          else
             value_vec(1:vlength)=defval
             do i=1,vlength
                call writelog('l','(a,a,f0.4,a)',(printkey),' = ',value_vec(i),' (no record found, default value used)')
             enddo
          endif
       endif
  end function readkey_dblvec

  function isSetParameter(fname,key,bcast) result (isSet)
    ! Function return logical true if the keyword is specified in file,
    ! or logical false if the keyword is not specified in the file.
    implicit none
    character*(*)   :: fname,key
    logical, intent(in), optional :: bcast
    logical         :: isSet
    character(slen)   :: value
    logical         :: lbcast

    if (present(bcast)) then
       lbcast = bcast
    else
       lbcast = .true.
    endif

       call readkey(fname,key,value)
       if (value == ' ') then
          isSet = .false.
       else
          isSet = .true.
       endif
  end function isSetParameter

!> reset the parameter file
  subroutine reset_paramfile()
     implicit none
     character(len=128) :: value

     call readkey('','dummy',value)

     return
  end subroutine reset_paramfile

  subroutine readkey(fname,key,value)
    ! Reads through input file (fname) looking for key = value combinations
    ! Return value as string
    ! Subroutine also used to keep track of which lines have been succesfully read
    ! If called by readkey('params.txt','checkparams'), will output unsuccesful key = value
    ! combinations in params.txt
    use m_xbeach_filefunctions
    integer                                     :: lun,i,ier,nlines,ic,ikey,itab
    character*1                                 :: ch
    character(len=*), intent(in)                :: fname,key
    character(len=*), intent(out)               :: value
    character(slen), dimension(1024),save          :: keyword,values
    character(slen)                                :: line,lineWithoutSpecials
    integer, save                               :: nkeys
    character(slen), save                          :: fnameold=''
    integer, dimension(:),allocatable,save      :: readindex

    if ( fname.eq.'' ) then   ! (re-)initialize
       fnameold = fname
       return
    end if

    ! If the file name of the input file changes, the file should be reread
    if (fname/=fnameold) then
       ! Make sure this reset only recurs when the input file name changes
       fnameold=fname
       nkeys=0
       ier=0
       ! Read the file for all lines with "=" 
       call writelog('ls','','XBeach reading from ',trim(fname))
       lun=99
       i=0
       open(lun,file=fname)
       do while (ier==0)
          read(lun,'(a)',iostat=ier)ch
          if (ier==0)i=i+1
       enddo
       close(lun)
       nlines=i
       ! reset keyword values and readindex 
       keyword = ''
       values = '' 
       if (allocated(readindex)) deallocate(readindex)
       ! Read through the file to fill all the keyword = value combinations
       open(lun,file=fname)
       ikey=0
       do i=1,nlines
          read(lun,'(a)')line
          do itab=1,slen
              if (ichar(line(itab:itab))<32 .or. ichar(line(itab:itab))>126) then  ! this is anything not in standard
                                                                                   ! alphanumeric
                  lineWithoutSpecials(itab:itab) = ' '
              else
                  lineWithoutSpecials(itab:itab) = line(itab:itab)
              endif
          enddo
          line = lineWithoutSpecials
          ic=scan(line,'=')
          if (ic>0) then
             ikey=ikey+1
             keyword(ikey)=adjustl(line(1:ic-1))
             values(ikey)=adjustl(line(ic+1:slen))
          endif
       enddo
       nkeys=ikey
       close(lun)
       ! allocate index vector that stores which values have succesfully been called to be read
       allocate(readindex(nkeys))
       readindex=0
    endif

    ! Compare the input key with any keyword stored in the keyword vector and return the value.
    ! A succesful key - keyword match is recorded in readindex with a value "1"
    ! Note: in case more than one keyword matches the key, the first keyword - value combination is returned
    value=' '
    do ikey=1,nkeys
       if (key.eq.keyword(ikey)) then
          value=values(ikey)
          readindex(ikey)=1
          exit
       endif
    enddo

    ! Easter egg!
    ! With call for key "checkparams", the subroutine searches readindex for keyword - value combinations that
    ! have not yet been read. It returns a warning to screen and log file for each unsuccesful keyword.
    if (key .eq. 'checkparams') then
       do ikey=1,nkeys
          if (readindex(ikey)==0) then
             call writelog('slw','','Unknown, unused or multiple statements of parameter ', &
                                    trim(uppercase(keyword(ikey))),' in ',trim(fname))
          endif
       enddo
    endif

  end subroutine readkey


  ! The following code is taken from program "CHCASE" @ http://www.davidgsimpson.com/software/chcase_f90.txt:
  !  Programmer:   Dr. David G. Simpson
  !                NASA Goddard Space Flight Center
  !                Greenbelt, Maryland  20771
  !
  !  Date:         January 24, 2003
  !
  !  Language:     Fortran-90
  !
  !  Version:      1.00a
  !                1.1 : Modified uppercase into function form by R.T. McCall 23/7/2013
  !

  pure function UPPERCASE(STR) result(upperstr)

    IMPLICIT NONE

    CHARACTER(LEN=*),intent(in) :: STR
    character(slen)             :: upperstr
    INTEGER                     :: I, DEL

    upperstr = STR

    DEL = IACHAR('a') - IACHAR('A')
    
    DO I = 1, LEN_TRIM(upperstr)
       IF (LGE(upperstr(I:I),'a') .AND. LLE(upperstr(I:I),'z')) THEN
          upperstr(I:I) = ACHAR(IACHAR(upperstr(I:I)) - DEL)
       END IF
    END DO

  end function UPPERCASE
  !
  !  LOWERCASE
  !
  SUBROUTINE LOWERCASE(STR)

    IMPLICIT NONE

    CHARACTER(LEN=*), INTENT(IN OUT) :: STR
    INTEGER :: I, DEL


    DEL = IACHAR('a') - IACHAR('A')

    DO I = 1, LEN_TRIM(STR)
       IF (LGE(STR(I:I),'A') .AND. LLE(STR(I:I),'Z')) THEN
          STR(I:I) = ACHAR(IACHAR(STR(I:I)) + DEL)
       END IF
    END DO

    RETURN

  END SUBROUTINE LOWERCASE

  ! End of code taken from CHCASE

end module m_xbeach_readkey