base_hooks.F

Go to the documentation of this file.

!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright 2000-2026 CP2K developers group <https://cp2k.org>                                   !
!                                                                                                  !
!   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
!--------------------------------------------------------------------------------------------------!
 
! **************************************************************************************************
!> \brief Central dispatch for basic hooks
!> \author Ole Schuett
! **************************************************************************************************
MODULE base_hooks
   USE kinds,                           ONLY: default_string_length
   USE machine,                         ONLY: default_output_unit,&
                                              m_abort,&
                                              m_flush
 
   IMPLICIT NONE
   PRIVATE
 
   !API
   PUBLIC :: cp_abort, cp_warn, cp_hint, timeset, timestop
   !API
   PUBLIC :: cp_abort_hook, cp_warn_hook, cp_hint_hook, timeset_hook, timestop_hook
   !API
   PUBLIC :: cp__a, cp__b, cp__w, cp__h, cp__l
 
   ! this interface (with subroutines in it) must to be defined right before
   ! the regular subroutines/functions - otherwise prettify.py will screw up.
   INTERFACE
      SUBROUTINE cp_abort_interface(location, message)
      CHARACTER(len=*), INTENT(in)                       :: location, message
 
      END SUBROUTINE cp_abort_interface
 
      SUBROUTINE cp_warn_interface(location, message)
      CHARACTER(len=*), INTENT(in)                       :: location, message
 
      END SUBROUTINE cp_warn_interface
 
      SUBROUTINE cp_hint_interface(location, message)
      CHARACTER(len=*), INTENT(in)                       :: location, message
 
      END SUBROUTINE cp_hint_interface
 
      SUBROUTINE timeset_interface(routineN, handle)
      CHARACTER(LEN=*), INTENT(IN)                       :: routineN
      INTEGER, INTENT(OUT)                               :: handle
 
      END SUBROUTINE timeset_interface
 
      SUBROUTINE timestop_interface(handle)
      INTEGER, INTENT(IN)                                :: handle
 
      END SUBROUTINE timestop_interface
   END INTERFACE
 
   PROCEDURE(cp_abort_interface), POINTER :: cp_abort_hook => null()
   PROCEDURE(cp_warn_interface), POINTER :: cp_warn_hook => null()
   PROCEDURE(cp_hint_interface), POINTER :: cp_hint_hook => null()
   PROCEDURE(timeset_interface), POINTER :: timeset_hook => null()
   PROCEDURE(timestop_interface), POINTER :: timestop_hook => null()
 
CONTAINS
 
! **************************************************************************************************
!> \brief Terminate the program
!> \param location ...
!> \param message ...
!> \author Ole Schuett
! **************************************************************************************************
   SUBROUTINE cp_abort(location, message)
      CHARACTER(len=*), INTENT(in)                       :: location, message
 
      IF (ASSOCIATED(cp_abort_hook)) THEN
         CALL cp_abort_hook(location, message)
      ELSE
         WRITE (default_output_unit, *) "ABORT in "//trim(location)//" "//trim(message)
         CALL m_flush(default_output_unit)
         CALL m_abort()
      END IF
      ! compiler hint
      stop "Never return from here"
   END SUBROUTINE cp_abort
 
! **************************************************************************************************
!> \brief Issue a warning
!> \param location ...
!> \param message ...
!> \author Ole Schuett
! **************************************************************************************************
   SUBROUTINE cp_warn(location, message)
      CHARACTER(len=*), INTENT(in)                       :: location, message
 
      IF (ASSOCIATED(cp_warn_hook)) THEN
         CALL cp_warn_hook(location, message)
      ELSE
         WRITE (default_output_unit, *) "WARNING in "//trim(location)//" "//trim(message)
         CALL m_flush(default_output_unit)
      END IF
   END SUBROUTINE cp_warn
 
! **************************************************************************************************
!> \brief Issue a hint
!> \param location ...
!> \param message ...
!> \author Hans Pabst
! **************************************************************************************************
   SUBROUTINE cp_hint(location, message)
      CHARACTER(len=*), INTENT(in)                       :: location, message
 
      IF (ASSOCIATED(cp_hint_hook)) THEN
         CALL cp_hint_hook(location, message)
      ELSE
         WRITE (default_output_unit, *) "HINT in "//trim(location)//" "//trim(message)
         CALL m_flush(default_output_unit)
      END IF
   END SUBROUTINE cp_hint
 
! **************************************************************************************************
!> \brief Start timer
!> \param routineN ...
!> \param handle ...
!> \author Ole Schuett
! **************************************************************************************************
   SUBROUTINE timeset(routineN, handle)
      CHARACTER(LEN=*), INTENT(IN)                       :: routinen
      INTEGER, INTENT(OUT)                               :: handle
 
      IF (ASSOCIATED(timeset_hook)) THEN
         CALL timeset_hook(routinen, handle)
      ELSE
         handle = -1
      END IF
   END SUBROUTINE timeset
 
! **************************************************************************************************
!> \brief Stop timer
!> \param handle ...
!> \author Ole Schuett
! **************************************************************************************************
   SUBROUTINE timestop(handle)
      INTEGER, INTENT(IN)                                :: handle
 
      IF (ASSOCIATED(timestop_hook)) THEN
         CALL timestop_hook(handle)
      ELSE
         IF (handle /= -1) THEN
            CALL cp_abort(cp__l("base_hooks.F", __line__), "Got wrong handle")
         END IF
      END IF
   END SUBROUTINE timestop
 
! **************************************************************************************************
!> \brief CPASSERT handler
!> \param filename ...
!> \param lineNr ...
!> \author Ole Schuett
! **************************************************************************************************
   SUBROUTINE cp__a(filename, lineNr)
      CHARACTER(len=*), INTENT(in)                       :: filename
      INTEGER, INTENT(in)                                :: linenr
 
      CALL cp_abort(location=cp__l(filename, linenr), message="CPASSERT failed")
      ! compiler hint
      stop "Never return from here"
   END SUBROUTINE cp__a
 
! **************************************************************************************************
!> \brief CPABORT handler
!> \param filename ...
!> \param lineNr ...
!> \param message ...
!> \author Ole Schuett
! **************************************************************************************************
   SUBROUTINE cp__b(filename, lineNr, message)
      CHARACTER(len=*), INTENT(in)                       :: filename
      INTEGER, INTENT(in)                                :: linenr
      CHARACTER(len=*), INTENT(in)                       :: message
 
      CALL cp_abort(location=cp__l(filename, linenr), message=message)
      ! compiler hint
      stop "Never return from here"
   END SUBROUTINE cp__b
 
! **************************************************************************************************
!> \brief CPWARN handler
!> \param filename ...
!> \param lineNr ...
!> \param message ...
!> \author Ole Schuett
! **************************************************************************************************
   SUBROUTINE cp__w(filename, lineNr, message)
      CHARACTER(len=*), INTENT(in)                       :: filename
      INTEGER, INTENT(in)                                :: linenr
      CHARACTER(len=*), INTENT(in)                       :: message
 
      CALL cp_warn(location=cp__l(filename, linenr), message=message)
   END SUBROUTINE cp__w
 
! **************************************************************************************************
!> \brief CPHINT handler
!> \param filename ...
!> \param lineNr ...
!> \param message ...
!> \author Hans Pabst
! **************************************************************************************************
   SUBROUTINE cp__h(filename, lineNr, message)
      CHARACTER(len=*), INTENT(in)                       :: filename
      INTEGER, INTENT(in)                                :: linenr
      CHARACTER(len=*), INTENT(in)                       :: message
 
      CALL cp_hint(location=cp__l(filename, linenr), message=message)
   END SUBROUTINE cp__h
 
! **************************************************************************************************
!> \brief Helper routine to assemble __LOCATION__
!> \param filename ...
!> \param lineNr ...
!> \return ...
!> \author Ole Schuett
! **************************************************************************************************
   FUNCTION cp__l(filename, lineNr) RESULT(location)
      CHARACTER(len=*), INTENT(in)                       :: filename
      INTEGER, INTENT(in)                                :: linenr
      CHARACTER(len=default_string_length)               :: location
 
      CHARACTER(len=15)                                  :: linenr_str
 
      WRITE (linenr_str, fmt='(I10)') linenr
      location = trim(filename)//":"//trim(adjustl(linenr_str))
 
   END FUNCTION cp__l
 
END MODULE base_hooks