module readkey_module
use typesandkinds

contains
  real*8 function readkey_dbl(fname,key,defval,mnval,mxval,bcast,required)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    ! 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                                                                     !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! if USEMPI then the master process will read the parameter,
    ! this value is subsequently broadcasted to the other processes

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

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

    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=key
    printkey = ' '
    printkey(2:24)=trim(key)
    printkey(1:1)=' '

    if (xmaster) then
       call readkey(fname,key,value)

       if (value/=' ') then
          read(value,'(f10.0)')value_dbl
          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 halt_program
          else
             value_dbl=defval
             call writelog('l','(a12,a,f0.4,a)',(printkey),' = ',value_dbl,' (no record found, default value used)')
          endif
       endif
       ! write to basic params data file
       !  write(pardatfileid,*)'f ',printkey,' ',value_dbl
    endif

#ifdef USEMPI
    if (lbcast) then
       call xmpi_bcast(value_dbl)
    endif
#endif

    readkey_dbl=value_dbl
  end function readkey_dbl

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

    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)=' '
    if (xmaster) then
       call readkey(fname,key,value)

       if (value/=' ') then
          read(value,'(i256)')value_int
          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 halt_program
          else
             value_int=defval
             call writelog('l','(a12,a,i0,a)',(printkey),' = ',value_int,' (no record found, default value used)')
          endif
       endif
       ! write to basic params data file
       !  write(pardatfileid,*)'i ',printkey,' ',value_int
    endif
#ifdef USEMPI
    if (lbcast) then
       call xmpi_bcast(value_int)
    endif
#endif

  end function readkey_int

  function readkey_str(fname,key,defval,nv,nov,allowed,old,bcast,required) result (value_str)
    use xmpi_module
    use logging_module
    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.
    if (xmaster) then
       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 halt_program
          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 halt_program
          endif
       endif
       ! write to basic params data file
       !  write(pardatfileid,*)'c ',printkey,' ',value_str
    endif
#ifdef USEMPI
    if (lbcast) then
       call xmpi_bcast(value_str)
    endif
#endif   
  end function readkey_str


  function readkey_name(fname,key,bcast,required) result (value_str)
    use xmpi_module
    use logging_module
    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

    if (xmaster) then
       call readkey(fname,key,value)
       if (value == ' ') then
          if (lrequired) then
             call writelog('lse','','Error: missing required value for parameter ',printkey)
             call halt_program
          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
    endif
#ifdef USEMPI
    if (lbcast) then
       call xmpi_bcast(value_str)
    endif
#endif   
  end function readkey_name
  
  function readkey_dblvec(fname,key,vlength,tlength,defval,mnval,mxval,bcast,required) result (value_vec)
    use xmpi_module
    use logging_module
    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
  
    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
    
    if (xmaster) then
       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 halt_program
          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 halt_program
          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
    endif

#ifdef USEMPI
    if (lbcast) then
       do i=1,vlength
          call xmpi_bcast(value_vec(i))
       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.
    use xmpi_module
    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
    
    if (xmaster) then
       call readkey(fname,key,value)
       if (value == ' ') then
          isSet = .false.
       else
          isSet = .true.
       endif
    endif
#ifdef USEMPI
    if (lbcast) then
       call xmpi_bcast(isSet)
    endif
#endif  
  end function isSetParameter

  !
  !  readkey is only to be called from master, ie:
  !  if(xmaster) then
  !    call readkey(....)
  !  No need to cache these results. 
  !
  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 xmpi_module
    use logging_module
    integer                                     :: lun,i,ier,nlines,ic,ikey
    character*1                                 :: ch
    character(len=*), intent(in)                :: fname,key
    character(len=*), intent(out)               :: value
    character(slen), dimension(1024),save          :: keyword,values
    character(slen)                                :: line
    integer, save                               :: nkeys
    character(slen), save                          :: fnameold=''
    integer, dimension(:),allocatable,save      :: readindex

    ! 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
          ic=scan(line,'=')
          if (ic>0) then
             ikey=ikey+1
             keyword(ikey)=adjustl(line(1:ic-1))
             values(ikey)=adjustl(line(ic+1:80))
          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(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
  !

  SUBROUTINE UPPERCASE(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 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 readkey_module