C:/repositories/XBeach/trunk/src/xbeachlibrary/getkey.F90

Go to the documentation of this file.

module getkey_module
   ! This module makes parameters available through introspection/reflection
   ! You can ask for all available parameters using getkeys
   ! You can ask for the value of a specific parameter using getkey
   ! The naming is still a bit inconsistent so that might change in the future
   use typesandkinds, only: slen
   use mnemmodule,    only: maxrank
   implicit none
   private
   public parameter, getkey, getkeys, getkey_indextype, getnkeys
   save
   ! analogue to the arraytype in mnemonic
   type parameter
      character type         ! 'c', 'i' or 'r': integer or real*8
      integer rank           ! 0,1,2,3,4
      character(slen) :: name     ! 'v','ve', .....
      character(slen) :: units     ! m, following udunits convention
      character(slen) :: description
      character(slen), dimension(maxrank) :: dimensions ! the dimensions of the variable, for example (s%nx, s%ny)

      character(slen), pointer :: c0 ! pointer to characters
      character(slen), dimension(:), pointer :: c1 ! pointer to array of characters

      real*8, pointer             :: r0  ! pointer to real8 scalar
      real*8, dimension(:), pointer :: r1  ! pointer to real8 (:)

      integer, pointer             :: i0  ! pointer to integer scalar
      integer, dimension(:), pointer :: i1  ! pointer to integer (:)
   end type parameter

contains
   ! Lookup the index and valuetype of a parameter, currently only works for rank 0
   subroutine getkey_indextype(par, key, index, type)
      use params,      only: parameters
      implicit none
      type(parameters), intent(in) :: par
      character(len=*), intent(in) :: key
      integer, intent(out)         :: index
      character, intent(out)       :: type
      integer                      :: i
      include 'getkey.inc'
      index = -1
      type = ''
      do i=1,nintegerkeys
         if (integerkeys(i) == key) then
            index = i
            type = 'i'
            return
         end if
      end do
      do i=1,nrealkeys
         if (realkeys(i) == key) then
            index = i
            type = 'r'
            return
         end if
      end do
      do i=1,ncharacterkeys
         if (characterkeys(i) == key) then
            index = i
            type = 'c'
            return
         end if
      end do
   end subroutine getkey_indextype

   integer function getkey(par, key, value)
      ! This subroutine returns a value (parameter), given a key (parameter name).
      use params,      only: parameters
      use mnemmodule
      implicit none

      type(parameters), intent(in) :: par
      character(len=*), intent(in) :: key
      type(parameter), intent(inout) :: value
      ! Ok this is ugly, I changed the targets to save, so the pointer is still available after the function ends
      ! But this means that if you call getkey twice, then your old value will now refer to the new value
      character(slen),target, save :: charvalue
      integer, target, save :: intvalue
      real*8, target, save :: realvalue
      integer :: index
      character :: type
      include 'getkey.inc'
      ! This sets index and type
      call getkey_indextype(par, key, index, type)
      getkey = -1
      if (index .eq. -1 ) return
      value%name = key
      value%rank = 0
      value%type = type
      if (type == 'c') then
         charvalue = charactervalues(index)
         value%c0 => charvalue
      elseif (type == 'i') then
         intvalue = integervalues(index)
         value%i0 => intvalue
      elseif (type == 'r') then
         realvalue = realvalues(index)
         value%r0 => realvalue
      end if
      getkey = 0
   end function getkey

   subroutine getnkeys(par, n)
      use params,      only: parameters
      implicit none
      type(parameters), intent(in) :: par
      integer, intent(out) :: n
      include 'getkey.inc'
      n = ncharacterkeys+nintegerkeys+nrealkeys
   end subroutine getnkeys

   subroutine getkeys(par, keys)
      ! This subroutine gives a list of all available keys (parameter names)
      use params,      only: parameters
      implicit none
      type(parameters), intent(in) :: par
      character(slen), dimension(:), allocatable, intent(out) :: keys

      include 'getkey.inc'
      allocate(keys(ncharacterkeys+nintegerkeys+nrealkeys))
      keys(1:ncharacterkeys) = characterkeys(1:ncharacterkeys)
      keys(ncharacterkeys+1:ncharacterkeys+nintegerkeys) = integerkeys(1:nintegerkeys)
      keys(ncharacterkeys+nintegerkeys+1:ncharacterkeys+nintegerkeys+nrealkeys) = realkeys(1:nrealkeys)


   end subroutine getkeys





end module getkey_module