program deltares_hydro
!----- GPL ---------------------------------------------------------------------
!
! Copyright (C) Stichting Deltares, 2011.
!
! This program is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation version 3.
!
! This program 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 General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program. If not, see .
!
! 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" and "Deltares"
! are registered trademarks of Stichting Deltares, and remain the property of
! Stichting Deltares. All rights reserved.
!
!-------------------------------------------------------------------------------
! $Id$
! $HeadURL$
!!--description-----------------------------------------------------------------
!
!!--pseudo code and references--------------------------------------------------
! NONE
!!--declarations----------------------------------------------------------------
use properties
implicit none
!
! Parameters
!
integer, parameter :: groupNameLen = 20
integer, parameter :: stringLen = 256
integer, parameter :: numGroups = 2
!
! Type defs
!
type group
character(groupNameLen) :: name
integer :: numChilds
type(tree_data), pointer :: ptr
end type group
!
! Local variables
!
integer :: error
integer :: libHandle
integer :: numKeyVal
integer :: mode ! integer flag denoting whether delft3d arguments are in a file (1) or not (0)
integer :: i
integer :: j
integer :: k
integer :: istat
integer :: numCompChilds
integer :: numOlvChilds
integer :: libNameSet
integer, external :: iargc
integer, external :: open_shared_library
integer, external :: close_shared_library
integer, external :: perform_function
logical :: dllIsOpen
logical :: ex
logical :: success
character(stringLen), dimension(:), allocatable :: arguments ! all commandline arguments
character(stringLen), dimension(:), allocatable :: keys ! keys from config file to be passed to shared library
character(stringLen), dimension(:), allocatable :: values ! values from config file to be passed to shared library
character(stringLen) :: message
character(stringLen) :: libName
character(stringLen) :: libFunction
character(stringLen) :: inputFile
character(groupNameLen) :: groupName
character(256) :: version_full ! by calling getfullversionstring_deltares_hydro, the version number is visible with the what command
type(tree_data), pointer :: configPtr
type(group), dimension(numGroups) :: configGroups
!
!! executable statements -------------------------------------------------------
!
call getfullversionstring_deltares_hydro(version_full)
nullify(configPtr)
do i=1, numGroups
configGroups(i)%numChilds = 0
nullify(configGroups(i)%ptr)
enddo
configGroups(1)%name = 'component'
configGroups(2)%name = 'remoteolv'
dllIsOpen = .false.
numKeyVal = 0
!
! iargc is used for allocation array arguments
! check whether it has a realistic value
!
if (iargc() /= 1) then
call printUsage()
call deltaresHydroStop()
endif
allocate(arguments(0:iargc()))
do i=0,iargc()
call getarg(i,arguments(i))
enddo
!
! Check existence of the configuration file, specified in the first argument
!
inquire (file = trim(arguments(1)), exist = ex)
if (.not. ex) then
write(*,'(3a)') 'ERROR: Configuration file "', trim(arguments(1)), '" does not exist.'
call printUsage()
call deltaresHydroStop()
endif
call tree_create('Trunk', configPtr)
call tree_put_data( configPtr, transfer(trim(arguments(1)),node_value), 'STRING' )
!
! Put config-file in input tree
!
call prop_file('ini', trim(arguments(1)), configPtr, istat)
if (istat /= 0) then
select case (istat)
case(1)
write(*,'(3a)') 'ERROR: Configuration file "', trim(arguments(1)), '" not found.'
case(3)
write(*,'(3a)') 'ERROR: Premature EOF in file "', trim(arguments(1)), '".'
case default
write(*,'(3a)') 'ERROR: Read error from file "', trim(arguments(1)), '".'
endselect
call printUsage()
call deltaresHydroStop()
endif
!
! Read config file
!
!
! Search for groups
!
groupName = ' '
do i = 1, size(configPtr%child_nodes)
groupName = tree_get_name(configPtr%child_nodes(i)%node_ptr)
do j = 1, numGroups
if (trim(groupName) == configGroups(j)%name) then
configGroups(j)%ptr => configPtr%child_nodes(i)%node_ptr
configGroups(j)%numChilds = size(configGroups(j)%ptr%child_nodes)
numKeyVal = numKeyVal + configGroups(j)%numChilds
endif
enddo
enddo
!
! group [Component] must exist
!
if (.not.associated(configGroups(1)%ptr)) then
write(*,'(5a)') 'ERROR: in config file "', trim(arguments(1)), '", group "[Component]" not found.'
call printUsage()
call deltaresHydroStop()
endif
!
allocate(keys (numKeyVal))
allocate(values(numKeyVal))
keys = ' '
values = ' '
libName = ' '
libNameSet = 0
libFunction = 'runme'
call upperCase(libFunction)
k = 0
do i = 1, numGroups
do j = 1, configGroups(i)%numChilds
k = k + 1
keys(k) = trim(configGroups(i)%name) // ',' // tree_get_name(configGroups(i)%ptr%child_nodes(j)%node_ptr)
call tree_get_data_string(configGroups(i)%ptr%child_nodes(j)%node_ptr, values(k), success)
if (.not. success) then
write(*,'(4a)') 'ERROR: Can not read value of keyword "', trim(keys(k)), '" in config file "', trim(arguments(1)), '".'
endif
if (keys(k) == trim(configGroups(1)%name) // ',' // 'name' .and. values(k) /= ' ') then
!
! Non-empty library name placed in values(i)
!
libNameSet = k
endif
if (keys(k)/= trim(configGroups(i)%name) // ',' .and. values(k)==' ') then
write(*,'(5a)') 'ERROR: in config file "', trim(arguments(1)), '", keyword "', trim(keys(k)), '" has an empty value.'
call printUsage()
call deltaresHydroStop()
endif
enddo
enddo
!
! Check that libName and LibFunction are specified in inifile
!
if (libNameSet == 0) then
write(*,'(3a)') 'ERROR: Can not find keyword "Name" in config file "', trim(arguments(1)), '".'
call printUsage()
call deltaresHydroStop()
endif
!
! Open shared library
!
! If Windows then .dll, if linux then lib.so
!
#if defined (WIN32)
libName = trim(values(libNameSet)) // '.dll'
#endif
#if defined (HAVE_CONFIG_H)
libName = 'lib' // trim(values(libNameSet)) // '.so'
#endif
!
istat = 0
istat = open_shared_library(libHandle, trim(libName))
if (istat /= 0) then
write(*,'(3a)') 'ERROR: Can not open shared library "', trim(libName), '".'
call printUsage()
call deltaresHydroStop()
endif
dllIsOpen = .true.
!
! Execute the named function in the shared library
!
error = 0
message = ' '
error = perform_function(libHandle, libFunction, &
numKeyVal, keys , values, message)
if (error /= 0) then
write(*,'(4a)') 'ERROR: Cannot find function "',trim(libFunction),'" in dynamic library "',trim(libName),'".'
call deltaresHydroStop()
endif
if (message /= ' ') then
write (*,'(5a)') 'Message from function "',trim(libFunction),'" in dynamic library "',trim(libName),'":'
write (*,'(7x,a)') trim(message)
call deltaresHydroStop()
endif
call deltaresHydroStop()
contains
subroutine deltaresHydroStop()
if (allocated(arguments) ) deallocate(arguments)
if (allocated(keys) ) deallocate(keys)
if (allocated(values) ) deallocate(values)
! TODO: call tree_fold instead of deallocate
if (associated(configPtr)) deallocate(configPtr)
if (dllIsOpen) then
istat = close_shared_library(libHandle)
endif
stop
end subroutine deltaresHydroStop
end program deltares_hydro
subroutine printUsage()
implicit none
write(*,'(a)') "Usage:"
write(*,'(a)') "deltares_hydro.exe "
write(*,'(a)') " : Name of configuration file in ini format"
write(*,'(a)') " Example configuration file:"
write(*,'(a)') " [Component]"
write(*,'(a)') " Name = flow2d3d"
write(*,'(a)') " MdfFile = f34"
end subroutine printUsage
!
! Support functions for string compare
!
subroutine upperCase(string)
! arguments
character(*), intent(inout) :: string ! incoming /resulting (lowercase) string
! locals
integer :: i
integer :: j
! body
do i=1,len(string)
j=ichar(string(i:i))
if (j > 96 .and. j<123) then
string(i:i) = char(j-32)
endif
enddo
end subroutine upperCase
subroutine lowerCase(string)
! arguments
character(*), intent(inout) :: string ! incoming /resulting (lowercase) string
! locals
integer :: i
integer :: j
! body
do i=1,len(string)
j=ichar(string(i:i))
if (j > 64 .and. j<91) then
string(i:i) = char(j+32)
endif
enddo
end subroutine lowerCase