Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief Central dispatch for basic hooks
      10             : !> \author Ole Schuett
      11             : ! **************************************************************************************************
      12             : MODULE base_hooks
      13             :    USE kinds,                           ONLY: default_string_length
      14             :    USE machine,                         ONLY: default_output_unit,&
      15             :                                               m_abort,&
      16             :                                               m_flush
      17             : 
      18             :    IMPLICIT NONE
      19             :    PRIVATE
      20             : 
      21             :    !API
      22             :    PUBLIC :: cp_abort, cp_warn, cp_hint, timeset, timestop
      23             :    !API
      24             :    PUBLIC :: cp_abort_hook, cp_warn_hook, cp_hint_hook, timeset_hook, timestop_hook
      25             :    !API
      26             :    PUBLIC :: cp__a, cp__b, cp__w, cp__h, cp__l
      27             : 
      28             :    ! this interface (with subroutines in it) must to be defined right before
      29             :    ! the regular subroutines/functions - otherwise prettify.py will screw up.
      30             :    INTERFACE
      31             :       SUBROUTINE cp_abort_interface(location, message)
      32             :       CHARACTER(len=*), INTENT(in)                       :: location, message
      33             : 
      34             :       END SUBROUTINE cp_abort_interface
      35             : 
      36             :       SUBROUTINE cp_warn_interface(location, message)
      37             :       CHARACTER(len=*), INTENT(in)                       :: location, message
      38             : 
      39             :       END SUBROUTINE cp_warn_interface
      40             : 
      41             :       SUBROUTINE cp_hint_interface(location, message)
      42             :       CHARACTER(len=*), INTENT(in)                       :: location, message
      43             : 
      44             :       END SUBROUTINE cp_hint_interface
      45             : 
      46             :       SUBROUTINE timeset_interface(routineN, handle)
      47             :       CHARACTER(LEN=*), INTENT(IN)                       :: routineN
      48             :       INTEGER, INTENT(OUT)                               :: handle
      49             : 
      50             :       END SUBROUTINE timeset_interface
      51             : 
      52             :       SUBROUTINE timestop_interface(handle)
      53             :       INTEGER, INTENT(IN)                                :: handle
      54             : 
      55             :       END SUBROUTINE timestop_interface
      56             :    END INTERFACE
      57             : 
      58             :    PROCEDURE(cp_abort_interface), POINTER :: cp_abort_hook => Null()
      59             :    PROCEDURE(cp_warn_interface), POINTER :: cp_warn_hook => Null()
      60             :    PROCEDURE(cp_hint_interface), POINTER :: cp_hint_hook => Null()
      61             :    PROCEDURE(timeset_interface), POINTER :: timeset_hook => Null()
      62             :    PROCEDURE(timestop_interface), POINTER :: timestop_hook => Null()
      63             : 
      64             : CONTAINS
      65             : 
      66             : ! **************************************************************************************************
      67             : !> \brief Terminate the program
      68             : !> \param location ...
      69             : !> \param message ...
      70             : !> \author Ole Schuett
      71             : ! **************************************************************************************************
      72           0 :    SUBROUTINE cp_abort(location, message)
      73             :       CHARACTER(len=*), INTENT(in)                       :: location, message
      74             : 
      75           0 :       IF (ASSOCIATED(cp_abort_hook)) THEN
      76           0 :          CALL cp_abort_hook(location, message)
      77             :       ELSE
      78           0 :          WRITE (default_output_unit, *) "ABORT in "//TRIM(location)//" "//TRIM(message)
      79           0 :          CALL m_flush(default_output_unit)
      80           0 :          CALL m_abort()
      81             :       END IF
      82             :       ! compiler hint
      83           0 :       STOP "Never return from here"
      84             :    END SUBROUTINE cp_abort
      85             : 
      86             : ! **************************************************************************************************
      87             : !> \brief Issue a warning
      88             : !> \param location ...
      89             : !> \param message ...
      90             : !> \author Ole Schuett
      91             : ! **************************************************************************************************
      92       20312 :    SUBROUTINE cp_warn(location, message)
      93             :       CHARACTER(len=*), INTENT(in)                       :: location, message
      94             : 
      95       20312 :       IF (ASSOCIATED(cp_warn_hook)) THEN
      96       20312 :          CALL cp_warn_hook(location, message)
      97             :       ELSE
      98           0 :          WRITE (default_output_unit, *) "WARNING in "//TRIM(location)//" "//TRIM(message)
      99           0 :          CALL m_flush(default_output_unit)
     100             :       END IF
     101       20312 :    END SUBROUTINE cp_warn
     102             : 
     103             : ! **************************************************************************************************
     104             : !> \brief Issue a hint
     105             : !> \param location ...
     106             : !> \param message ...
     107             : !> \author Hans Pabst
     108             : ! **************************************************************************************************
     109          56 :    SUBROUTINE cp_hint(location, message)
     110             :       CHARACTER(len=*), INTENT(in)                       :: location, message
     111             : 
     112          56 :       IF (ASSOCIATED(cp_hint_hook)) THEN
     113          56 :          CALL cp_hint_hook(location, message)
     114             :       ELSE
     115           0 :          WRITE (default_output_unit, *) "HINT in "//TRIM(location)//" "//TRIM(message)
     116           0 :          CALL m_flush(default_output_unit)
     117             :       END IF
     118          56 :    END SUBROUTINE cp_hint
     119             : 
     120             : ! **************************************************************************************************
     121             : !> \brief Start timer
     122             : !> \param routineN ...
     123             : !> \param handle ...
     124             : !> \author Ole Schuett
     125             : ! **************************************************************************************************
     126   358952941 :    SUBROUTINE timeset(routineN, handle)
     127             :       CHARACTER(LEN=*), INTENT(IN)                       :: routineN
     128             :       INTEGER, INTENT(OUT)                               :: handle
     129             : 
     130   358952941 :       IF (ASSOCIATED(timeset_hook)) THEN
     131   358933179 :          CALL timeset_hook(routineN, handle)
     132             :       ELSE
     133       19762 :          handle = -1
     134             :       END IF
     135   358952941 :    END SUBROUTINE timeset
     136             : 
     137             : ! **************************************************************************************************
     138             : !> \brief Stop timer
     139             : !> \param handle ...
     140             : !> \author Ole Schuett
     141             : ! **************************************************************************************************
     142   358952941 :    SUBROUTINE timestop(handle)
     143             :       INTEGER, INTENT(IN)                                :: handle
     144             : 
     145   358952941 :       IF (ASSOCIATED(timestop_hook)) THEN
     146   358933179 :          CALL timestop_hook(handle)
     147             :       ELSE
     148       19762 :          IF (handle /= -1) &
     149           0 :             CALL cp_abort(cp__l("base_hooks.F", __LINE__), "Got wrong handle")
     150             :       END IF
     151   358952941 :    END SUBROUTINE timestop
     152             : 
     153             : ! **************************************************************************************************
     154             : !> \brief CPASSERT handler
     155             : !> \param filename ...
     156             : !> \param lineNr ...
     157             : !> \author Ole Schuett
     158             : ! **************************************************************************************************
     159           0 :    SUBROUTINE cp__a(filename, lineNr)
     160             :       CHARACTER(len=*), INTENT(in)                       :: filename
     161             :       INTEGER, INTENT(in)                                :: lineNr
     162             : 
     163           0 :       CALL cp_abort(location=cp__l(filename, lineNr), message="CPASSERT failed")
     164             :       ! compiler hint
     165           0 :       STOP "Never return from here"
     166             :    END SUBROUTINE cp__a
     167             : 
     168             : ! **************************************************************************************************
     169             : !> \brief CPABORT handler
     170             : !> \param filename ...
     171             : !> \param lineNr ...
     172             : !> \param message ...
     173             : !> \author Ole Schuett
     174             : ! **************************************************************************************************
     175           0 :    SUBROUTINE cp__b(filename, lineNr, message)
     176             :       CHARACTER(len=*), INTENT(in)                       :: filename
     177             :       INTEGER, INTENT(in)                                :: lineNr
     178             :       CHARACTER(len=*), INTENT(in)                       :: message
     179             : 
     180           0 :       CALL cp_abort(location=cp__l(filename, lineNr), message=message)
     181             :       ! compiler hint
     182           0 :       STOP "Never return from here"
     183             :    END SUBROUTINE cp__b
     184             : 
     185             : ! **************************************************************************************************
     186             : !> \brief CPWARN handler
     187             : !> \param filename ...
     188             : !> \param lineNr ...
     189             : !> \param message ...
     190             : !> \author Ole Schuett
     191             : ! **************************************************************************************************
     192       13015 :    SUBROUTINE cp__w(filename, lineNr, message)
     193             :       CHARACTER(len=*), INTENT(in)                       :: filename
     194             :       INTEGER, INTENT(in)                                :: lineNr
     195             :       CHARACTER(len=*), INTENT(in)                       :: message
     196             : 
     197       13015 :       CALL cp_warn(location=cp__l(filename, lineNr), message=message)
     198       13015 :    END SUBROUTINE cp__w
     199             : 
     200             : ! **************************************************************************************************
     201             : !> \brief CPHINT handler
     202             : !> \param filename ...
     203             : !> \param lineNr ...
     204             : !> \param message ...
     205             : !> \author Hans Pabst
     206             : ! **************************************************************************************************
     207          56 :    SUBROUTINE cp__h(filename, lineNr, message)
     208             :       CHARACTER(len=*), INTENT(in)                       :: filename
     209             :       INTEGER, INTENT(in)                                :: lineNr
     210             :       CHARACTER(len=*), INTENT(in)                       :: message
     211             : 
     212          56 :       CALL cp_hint(location=cp__l(filename, lineNr), message=message)
     213          56 :    END SUBROUTINE cp__h
     214             : 
     215             : ! **************************************************************************************************
     216             : !> \brief Helper routine to assemble __LOCATION__
     217             : !> \param filename ...
     218             : !> \param lineNr ...
     219             : !> \return ...
     220             : !> \author Ole Schuett
     221             : ! **************************************************************************************************
     222   595751740 :    FUNCTION cp__l(filename, lineNr) RESULT(location)
     223             :       CHARACTER(len=*), INTENT(in)                       :: filename
     224             :       INTEGER, INTENT(in)                                :: lineNr
     225             :       CHARACTER(len=default_string_length)               :: location
     226             : 
     227             :       CHARACTER(len=15)                                  :: lineNr_str
     228             : 
     229   595751740 :       WRITE (lineNr_str, FMT='(I10)') lineNr
     230   595751740 :       location = TRIM(filename)//":"//TRIM(ADJUSTL(lineNr_str))
     231             : 
     232   595751740 :    END FUNCTION cp__l
     233             : 
     234             : END MODULE base_hooks