# tem_abortCriteria_module.f90 Source File

## Source Code

! Copyright (c) 2013-2014, 2019-2021 Harald Klimach <harald.klimach@uni-siegen.de>
! Copyright (c) 2014 Peter Vitt <peter.vitt2@uni-siegen.de>
! Copyright (c) 2014 Simon Zimny <s.zimny@grs-sim.de>
! Copyright (c) 2014 Jiaxing Qi <jiaxing.qi@uni-siegen.de>
! Copyright (c) 2015, 2017, 2021 Kannan Masilamani <kannan.masilamani@uni-siegen.de>
! Copyright (c) 2016 Tobias Schneider <tobias1.schneider@student.uni-siegen.de>
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice, this
! list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
! **************************************************************************** !
!> This module provides the definition of various abort criteria upon which
!! a simulation should be stopped.
!! Note that solvers may extend this table and have their own set of
!! addititonal abort parameters to be set in this table.
!!
!! There are two primary options that may be set:
!!
!! * stop_file this denotes a file that will be checked for existence in the
!!   current working directory. If it exists the simulation will be stopped (if
!!   restarts are active, a restart will be written).
!!   If the file is empty the file will be deleted upon completion of the
!!   application. Otherwise, if the file is not empty it will be kept around.
!! * steady_state this is a boolean to indicate whether the simulation is to
!!   halt when a steady state is reached. If this is true a convergence table,
!!   where the condition for a steady state may be defined, is read. See
!!   [[tem_convergence_module]] for details.
!!
!! If the abort criteria table is not provided, the defaults for both settings
!! will be used, which is equivalent to the following definition:
!!
!!lua
!!  abort_criteria = {stop_file = '', steady_state = false}
!!
!!
!! That is, no stop files to look for, and no check whether a steady state is
!! reached.
!!
!! A more complete example with a check for steady state and a convergence
!! table (more details in [[tem_convergence_module]] could look like this:
!!
!!lua
!!  abort_criteria = {
!!    stop_file = 'stop',
!!    convergence = {
!!      variable = {'pressure', 'velocity'},
!!      shape = {kind = 'all'},
!!      time_control = {
!!        min = {iter = 0},
!!        max = {iter = tmax},
!!        interval = {iter = 10}
!!      },
!!      reduction = { 'average', 'average' },
!!      norm = 'average',
!!      nvals = 100,
!!      absolute = true,
!!      condition = {
!!         { threshold = 1.e-15, operator = '<=' },
!!         { threshold = 1.e-12, operator = '<=' }
!!      }
!!    }
!!  }
!!
!!
!! This results in the application to look for a file named stop in the
!! working directory and will abort the run if it is found to exist.
!! The application will check for a steady state, where a steady state is
!! assumed when the average of pressure and velocity across the complete
!! domain does not deviate by more of 1.e-15 for pressure and not more than
!! 1.e-12 for the velocity.
!!
module tem_abortCriteria_module
use env_module,             only: rk, labelLen, newunit

use aotus_module, only: flu_State, aot_get_val
use aot_table_module, only: aot_table_open, &
&                         aot_table_close

use aot_out_general_module, only: aot_out_type,        &
&                               aot_out_close_table, &
&                               aot_out_open_table

use aot_out_module, only: aot_out_val

implicit none

private

public :: tem_abortCriteria_type
public :: tem_abortCriteria_new
public :: tem_abortCriteria_out
public :: tem_abortCriteria_dump
public :: tem_stop_file_exists

!> Abstract type to describe solver specific abort criteria.
!!
!! Solvers may extend this type and pass it to load additional,
!! solver specific criteria.
type, abstract, public :: tem_solverAborts_type
contains
end type tem_solverAborts_type

abstract interface

!! from the configuration file.
use aotus_module, only: flu_State
import tem_solverAborts_type

!> The solver specific type to hold additional abort parameters.
class(tem_solverAborts_type), intent(inout) :: me

!> Handle to Lua configuration file to load parameters from.
type(flu_state), intent(in) :: conf

!> Handle to the abort criteria table to read from.
integer, intent(in) :: abort_table

end interface

!> Definition of the various abort criteria.
!!
!! Currently we only have two in addition to the time controlled and
!! erroneous aborts.
!! Solvers may pass an additional type to load extra parameters for
!! aborts from the abortcriteria table.
type tem_abortCriteria_type
!> A file which should cause the simulation to stop.
!! Default: ''.
!!
!! If this is a non empty string, the solver will stop at the next
!! opportunity if it detects a file with the name provided here in the
!! current working directory. Thus the simulation could be stopped by
!! doing a "touch stop" in the working directory of the application.
!! Such an empty file will be deleted, after it is detected.
!! If you want the stop file to stay on the file system, there has to
!! be something in it, which can be achieved by "echo keep > stop"
!! for example.
character(len=labelLen) :: stop_file

!> Should the simulation be checked for a steady state convergence and
!! stop if it is detected? Default: .false.

!> Convergence conditions for steady state check.
!! Filled only when steady_state is True
type(tem_convergence_type), allocatable :: convergence(:)

end type tem_abortCriteria_type

contains

! ************************************************************************ !
!> Define new abortCriteria.
!!
!! A new abortCriteria object will be filled according to the parameters
!! passed into the function.
! -------------------------------------------------------------------- !
!> Name of the stop file to react on. Default=''.
!!
!! Any non-empty string activates this criterion.
character(len=*), optional, intent(in) :: stop_file

!> Flag to indicate if the simulation should stop upon reaching a steady
!! state. What a steady state exactly is has to be defined in the solver.
!! Default: .false.

!> A new variable of abortCriteria filled with the values provided as
!! arguments.
type(tem_abortCriteria_type) :: ac
! -------------------------------------------------------------------- !
! -------------------------------------------------------------------- !

if (present(stop_file)) then
ac%stop_file = trim(stop_file)
else
ac%stop_file = ''
end if

else
end if

allocate(ac%convergence(0))

end function tem_abortCriteria_new
! ************************************************************************ !

! ************************************************************************ !
!> Load the abortCriteria from a given configuration.
!!
!! The abort_critera are defined in a table as follows:
!!
!!lua
!!
!!
!! stop_file indicates, which file should be checked for
!! to stop the execution. A typical setting would for example
!! be stop_file = 'stop'. If the string is empty, no checks
!! are performed. The default is an empty string.
!! Empty stop files will be deleted after they are encountered.
!! Non-empty ones are kept.
!!
!! steady_state indicates if the simulation should stop when
!! a steady_state solution is found. Default ist false.
!!
!! If steady_state is True then load convergence table for condition to
!!
!! Solvers may pass an additional solverAborts for specific abort parameters
!! to be filled from the abort_criteria table.
subroutine tem_abortCriteria_load(me, conf, parent, key, solverAborts)
! -------------------------------------------------------------------- !
!> Abort criteria to load from the Lua table.
type(tem_abortCriteria_type), intent(out) :: me

!> Handle for the Lua script.
type(flu_state) :: conf

!> Parent table to read from.
integer, intent(in), optional :: parent

!> Name of the time control table. Default: 'time_control'
character(len=*), intent(in), optional :: key

!> Solver specific abort criteria to load.
class(tem_solverAborts_type), intent(inout), optional :: solverAborts
! -------------------------------------------------------------------- !
character(len=labelLen) :: loc_key
integer :: thandle
integer :: iErr
! -------------------------------------------------------------------- !

loc_key = 'abort_criteria'
if (present(key)) loc_key = key

call aot_table_open( L       = conf,    &
&                  parent  = parent,  &
&                  thandle = thandle, &
&                  key     = loc_key  )

if (thandle /= 0) then

call aot_get_val( L       = conf,         &
&               thandle = thandle,      &
&               val     = me%stop_file, &
&               key     = 'stop_file',  &
&               default = '',           &
&               ErrCode = iErr          )

call aot_get_val( L       = conf,            &
&               thandle = thandle,         &
&               default = .false.,         &
&               ErrCode = iErr             )

call tem_convergence_load( me           = me%convergence, &
&                        conf         = conf,           &
&                        parent       = thandle,        &
end if

if (present(solverAborts)) then
call solverAborts%load( conf        = conf,   &
&                     abort_table = thandle )
end if

else

me%stop_file = ''

end if

! If no steady state is defined

call aot_table_close( L       = conf,   &
&                   thandle = thandle )

! ************************************************************************ !

! ************************************************************************ !
!> Saves the abortCriteria to a given configuration.
!!
!! For further information, see TEM_abortCriteria_load()
subroutine tem_abortCriteria_out(me, conf, key)
! -------------------------------------------------------------------- !
!> The abortCriteria to write out as a Lua table.
type(tem_abortCriteria_type), intent(in) :: me

!> Handle for the Lua script to write to.
type(aot_out_type), intent(inout) :: conf

!> A name for the table to write the abortCriteria to.
!! Default: 'abort_criteria'.
character(len=*), optional :: key
! -------------------------------------------------------------------- !
character(len=labelLen) :: loc_key
! -------------------------------------------------------------------- !

loc_key = 'abort_criteria'
if (present(key)) loc_key = key

call aot_out_open_table( put_conf = conf,   &
&                      tname    = loc_key )

call aot_out_val( put_conf = conf,   &
&              val = me%stop_file, &
&              vname = 'stop_file' )

call aot_out_val( put_conf = conf,       &

call aot_out_close_table(put_conf = conf)

end subroutine tem_abortCriteria_out
! ************************************************************************ !

! ************************************************************************ !
!> Dump abort criteria information to the specified outUnit.
subroutine tem_abortCriteria_dump(me, outUnit)
! -------------------------------------------------------------------- !
!> Abort criteria settings to write on outUnit.
type(tem_abortCriteria_type), intent(in) :: me

!> File unit to write the settings to.
integer, intent(in) :: outUnit
! -------------------------------------------------------------------- !
! -------------------------------------------------------------------- !

write(outUnit,*) ' stop_file: '//trim(me%stop_file)

end subroutine tem_abortCriteria_dump
! ************************************************************************ !

! ************************************************************************ !
!> Check if the stop file exists.
!!
!! The check is only done by the root process and only if the stop_file
!! setting is not empty.
!! If the stop file exists, but is empty it is deleted after probing its
!! existence. Non-empty files are kept.
!! Thus, you can create a stop file that is to be deleted upon
!! encountering with: touch stop
!! While one, that should be kept can be created by:
!! echo keep > stop
function tem_stop_file_exists(abortCriteria, rank) result(sf_exists)
! -------------------------------------------------------------------- !
!> Abort criteria settings to use in this check for a stop file.
type(tem_abortCriteria_type), intent(in) :: abortCriteria

!> Rank of the probing process, only rank==0 actually checks for the file.
integer, intent(in) :: rank

!> Result that indicates, if the stop files exists.
logical :: sf_exists
! -------------------------------------------------------------------- !
integer :: fu
integer :: ios
character(len=labelLen) :: probe
! -------------------------------------------------------------------- !

sf_exists = .false.

if (trim(abortCriteria%stop_file) /= '') then
if (rank == 0) then
inquire( file  = trim(abortCriteria%stop_file), &
&      exist = sf_exists                      )

if (sf_exists) then
fu = newunit()
open( unit   = fu,                            &
&   file   = trim(abortCriteria%stop_File), &
&   status = 'old'                          )

if (ios < 0) then
close( unit   = fu,      &
&    status = 'DELETE' )
else
close(fu)
end if

end if
end if
end if

end function tem_stop_file_exists
! ************************************************************************ !

end module tem_abortCriteria_module