[3880] | 1 | ! (C) Copyright 2014- ECMWF. |
---|
| 2 | ! |
---|
| 3 | ! This software is licensed under the terms of the Apache Licence Version 2.0 |
---|
| 4 | ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. |
---|
| 5 | ! |
---|
| 6 | ! In applying this licence, ECMWF does not waive the privileges and immunities |
---|
| 7 | ! granted to it by virtue of its status as an intergovernmental organisation |
---|
| 8 | ! nor does it submit to any jurisdiction. |
---|
| 9 | |
---|
| 10 | MODULE YOMHOOK |
---|
| 11 | |
---|
| 12 | USE PARKIND1 ,ONLY : JPIM, JPRB, JPRM, JPRD |
---|
| 13 | |
---|
| 14 | IMPLICIT NONE |
---|
| 15 | |
---|
| 16 | ! Used by "hook" function |
---|
| 17 | ! LHOOK = true implies "hook" function will be called |
---|
| 18 | ! Altough initialized to TRUE it will be reset by first call to |
---|
| 19 | ! DR_HOOK unless we really want to use the hook function |
---|
| 20 | |
---|
| 21 | SAVE |
---|
| 22 | PUBLIC |
---|
| 23 | |
---|
| 24 | LOGICAL :: LHOOK=.TRUE. |
---|
| 25 | |
---|
| 26 | #include "dr_hook_util.h" |
---|
| 27 | #include "dr_hook_util_multi.h" |
---|
| 28 | |
---|
| 29 | INTERFACE DR_HOOK |
---|
| 30 | |
---|
| 31 | MODULE PROCEDURE & |
---|
| 32 | DR_HOOK_DEFAULT4, & |
---|
| 33 | DR_HOOK_DEFAULT8, & |
---|
| 34 | DR_HOOK_FILE, & |
---|
| 35 | DR_HOOK_SIZE, & |
---|
| 36 | DR_HOOK_FILE_SIZE, & |
---|
| 37 | DR_HOOK_MULTI_DEFAULT, & |
---|
| 38 | DR_HOOK_MULTI_FILE, & |
---|
| 39 | DR_HOOK_MULTI_SIZE, & |
---|
| 40 | DR_HOOK_MULTI_FILE_SIZE |
---|
| 41 | END INTERFACE |
---|
| 42 | |
---|
| 43 | CONTAINS |
---|
| 44 | |
---|
| 45 | SUBROUTINE DR_HOOK_DEFAULT4(CDNAME,KSWITCH,PKEY) |
---|
| 46 | CHARACTER(LEN=*), INTENT(IN) :: CDNAME |
---|
| 47 | INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH |
---|
| 48 | REAL(KIND=JPRM), INTENT(INOUT) :: PKEY |
---|
| 49 | REAL(KIND=JPRB) :: ZKEY |
---|
| 50 | ZKEY = TRANSFER(PKEY,ZKEY) |
---|
| 51 | CALL DR_HOOK_UTIL(LHOOK,CDNAME,KSWITCH,ZKEY,'',0_JPIM) |
---|
| 52 | PKEY = TRANSFER(ZKEY,PKEY) |
---|
| 53 | END SUBROUTINE DR_HOOK_DEFAULT4 |
---|
| 54 | |
---|
| 55 | SUBROUTINE DR_HOOK_DEFAULT8(CDNAME,KSWITCH,PKEY) |
---|
| 56 | CHARACTER(LEN=*), INTENT(IN) :: CDNAME |
---|
| 57 | INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH |
---|
| 58 | REAL(KIND=JPRD), INTENT(INOUT) :: PKEY |
---|
| 59 | REAL(KIND=JPRB) :: ZKEY |
---|
| 60 | ZKEY = TRANSFER(PKEY,ZKEY) |
---|
| 61 | CALL DR_HOOK_UTIL(LHOOK,CDNAME,KSWITCH,ZKEY,'',0_JPIM) |
---|
| 62 | PKEY = TRANSFER(ZKEY,PKEY) |
---|
| 63 | END SUBROUTINE DR_HOOK_DEFAULT8 |
---|
| 64 | |
---|
| 65 | SUBROUTINE DR_HOOK_MULTI_DEFAULT(CDNAME,KSWITCH,PKEY) |
---|
| 66 | CHARACTER(LEN=*), INTENT(IN) :: CDNAME |
---|
| 67 | INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH |
---|
| 68 | REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:) |
---|
| 69 | CALL DR_HOOK_UTIL_MULTI(LHOOK,CDNAME,KSWITCH,PKEY,INT(SIZE(PKEY)),'',0_JPIM) |
---|
| 70 | END SUBROUTINE DR_HOOK_MULTI_DEFAULT |
---|
| 71 | |
---|
| 72 | SUBROUTINE DR_HOOK_FILE(CDNAME,KSWITCH,PKEY,CDFILE) |
---|
| 73 | CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE |
---|
| 74 | INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH |
---|
| 75 | REAL(KIND=JPRB), INTENT(INOUT) :: PKEY |
---|
| 76 | CALL DR_HOOK_UTIL(LHOOK,CDNAME,KSWITCH,PKEY,CDFILE,0_JPIM) |
---|
| 77 | END SUBROUTINE DR_HOOK_FILE |
---|
| 78 | |
---|
| 79 | SUBROUTINE DR_HOOK_MULTI_FILE(CDNAME,KSWITCH,PKEY,CDFILE) |
---|
| 80 | CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE |
---|
| 81 | INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH |
---|
| 82 | REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:) |
---|
| 83 | CALL DR_HOOK_UTIL_MULTI(LHOOK,CDNAME,KSWITCH,PKEY,INT(SIZE(PKEY)),CDFILE,0_JPIM) |
---|
| 84 | END SUBROUTINE DR_HOOK_MULTI_FILE |
---|
| 85 | |
---|
| 86 | SUBROUTINE DR_HOOK_SIZE(CDNAME,KSWITCH,PKEY,KSIZEINFO) |
---|
| 87 | CHARACTER(LEN=*), INTENT(IN) :: CDNAME |
---|
| 88 | INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO |
---|
| 89 | REAL(KIND=JPRB), INTENT(INOUT) :: PKEY |
---|
| 90 | CALL DR_HOOK_UTIL(LHOOK,CDNAME,KSWITCH,PKEY,'',KSIZEINFO) |
---|
| 91 | END SUBROUTINE DR_HOOK_SIZE |
---|
| 92 | |
---|
| 93 | SUBROUTINE DR_HOOK_MULTI_SIZE(CDNAME,KSWITCH,PKEY,KSIZEINFO) |
---|
| 94 | CHARACTER(LEN=*), INTENT(IN) :: CDNAME |
---|
| 95 | INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO |
---|
| 96 | REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:) |
---|
| 97 | CALL DR_HOOK_UTIL_MULTI(LHOOK,CDNAME,KSWITCH,PKEY,INT(SIZE(PKEY)),'',KSIZEINFO) |
---|
| 98 | END SUBROUTINE DR_HOOK_MULTI_SIZE |
---|
| 99 | |
---|
| 100 | SUBROUTINE DR_HOOK_FILE_SIZE(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO) |
---|
| 101 | CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE |
---|
| 102 | INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO |
---|
| 103 | REAL(KIND=JPRB), INTENT(INOUT) :: PKEY |
---|
| 104 | CALL DR_HOOK_UTIL(LHOOK,CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO) |
---|
| 105 | END SUBROUTINE DR_HOOK_FILE_SIZE |
---|
| 106 | |
---|
| 107 | SUBROUTINE DR_HOOK_MULTI_FILE_SIZE(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO) |
---|
| 108 | CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE |
---|
| 109 | INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO |
---|
| 110 | REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:) |
---|
| 111 | CALL DR_HOOK_UTIL_MULTI(LHOOK,CDNAME,KSWITCH,PKEY,INT(SIZE(PKEY)),CDFILE,KSIZEINFO) |
---|
| 112 | END SUBROUTINE DR_HOOK_MULTI_FILE_SIZE |
---|
| 113 | |
---|
| 114 | END MODULE YOMHOOK |
---|