! (C) Copyright 2005- ECMWF.
! (C) Copyright 2013- Meteo-France.
! 
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.
!

MODULE DR_HOOK_WATCH_MOD

USE EC_PARKIND  ,ONLY : JPRD, JPIM, JPIB, JPRM

!-- Watch point creation interface for Dr.Hook
IMPLICIT NONE
SAVE
PRIVATE

INTEGER, PUBLIC, PARAMETER :: KEYNONE =  0
INTEGER, PUBLIC, PARAMETER :: KEYLOG  =  1
INTEGER, PUBLIC, PARAMETER :: KEYCHAR =  2
INTEGER, PUBLIC, PARAMETER :: KEY_I4  =  4
INTEGER, PUBLIC, PARAMETER :: KEY_I8  =  8
INTEGER, PUBLIC, PARAMETER :: KEY_R4  = 16
INTEGER, PUBLIC, PARAMETER :: KEY_R8  = 32

INTERFACE DR_HOOK_WATCH
MODULE PROCEDURE &
  DR_HOOK_WATCH_CHARACTER, &
  DR_HOOK_WATCH_LOGICAL_SCALAR, &
  DR_HOOK_WATCH_LOGICAL_VEC, &
  DR_HOOK_WATCH_I4_SCALAR, &
  DR_HOOK_WATCH_I4_VEC, &
  DR_HOOK_WATCH_I8_SCALAR, &
  DR_HOOK_WATCH_I8_VEC, &
  DR_HOOK_WATCH_R4_SCALAR, &
  DR_HOOK_WATCH_R4_VEC, &
  DR_HOOK_WATCH_R8_SCALAR, &
  DR_HOOK_WATCH_R8_VEC
END INTERFACE 

PUBLIC :: DR_HOOK_WATCH
PUBLIC :: DR_HOOK_CHECK_WATCH

CONTAINS

SUBROUTINE CHECK_ARGS(LLABORT, LLACTIVE, LLPRINT, LLTRBK, &
     &                IABORT, IACTIVE, IPRINT, ITRBK, IPRTKEY, &
     &                LDABORT, LDACTIVE, LDPRINT, LDTRBK)
LOGICAL, INTENT(INOUT) :: LLABORT, LLACTIVE, LLPRINT, LLTRBK
INTEGER(KIND=JPIM), INTENT(OUT) :: IABORT, IACTIVE, IPRINT, ITRBK
INTEGER(KIND=JPIM), INTENT(IN) :: IPRTKEY
LOGICAL, INTENT(IN), OPTIONAL :: LDABORT, LDACTIVE, LDPRINT, LDTRBK
IABORT = 0
LLABORT = .TRUE.
IF (PRESENT(LDABORT)) LLABORT = LDABORT
IF (LLABORT) IABORT = 1

IACTIVE = 0
LLACTIVE = .TRUE.
IF (PRESENT(LDACTIVE)) LLACTIVE = LDACTIVE
IF (LLACTIVE) IACTIVE = 1

IPRINT = KEYNONE
LLPRINT = .TRUE.
IF (PRESENT(LDPRINT)) LLPRINT = LDPRINT
IF (LLPRINT) IPRINT = IPRTKEY

ITRBK = 0
LLTRBK = .FALSE.
IF (PRESENT(LDTRBK)) LLTRBK = LDTRBK
IF (LLTRBK) ITRBK = 1
END SUBROUTINE CHECK_ARGS

SUBROUTINE DR_HOOK_WATCH_CHARACTER(CDNAME, PTR, &
          &                        LDABORT, LDACTIVE, LDPRINT, LDTRBK)
INTEGER(KIND=JPIM), PARAMETER :: JP_BYTES_PER_ELEM = 1
CHARACTER(LEN=*), INTENT(IN) :: CDNAME
CHARACTER(LEN=*), INTENT(IN) :: PTR
LOGICAL, INTENT(IN), OPTIONAL :: LDABORT, LDACTIVE, LDPRINT, LDTRBK
LOGICAL :: LLABORT, LLACTIVE, LLPRINT, LLTRBK
INTEGER(KIND=JPIM) :: IBYTES, IABORT, IACTIVE, IPRINT, ITRBK
IBYTES = LEN(PTR) * JP_BYTES_PER_ELEM
IF (IBYTES <= 0) RETURN
CALL CHECK_ARGS(LLABORT, LLACTIVE, LLPRINT, LLTRBK, &
     &          IABORT, IACTIVE, IPRINT, ITRBK, KEYCHAR, &
     &          LDABORT, LDACTIVE, LDPRINT, LDTRBK)
CALL C_DRHOOK_WATCH(IACTIVE, CDNAME, PTR(1:1), IBYTES, IABORT, IPRINT, LEN(PTR), ITRBK)
END SUBROUTINE DR_HOOK_WATCH_CHARACTER

SUBROUTINE DR_HOOK_WATCH_LOGICAL_SCALAR(CDNAME, PTR, &
          &                             LDABORT, LDACTIVE, LDPRINT, LDTRBK)
INTEGER(KIND=JPIM), PARAMETER :: JP_BYTES_PER_ELEM = 4
CHARACTER(LEN=*), INTENT(IN) :: CDNAME
LOGICAL, INTENT(IN) :: PTR
LOGICAL, INTENT(IN), OPTIONAL :: LDABORT, LDACTIVE, LDPRINT, LDTRBK
LOGICAL :: LLABORT, LLACTIVE, LLPRINT, LLTRBK
INTEGER(KIND=JPIM) :: IBYTES, IABORT, IACTIVE, IPRINT, ITRBK
IBYTES = JP_BYTES_PER_ELEM
CALL CHECK_ARGS(LLABORT, LLACTIVE, LLPRINT, LLTRBK, &
     &          IABORT, IACTIVE, IPRINT, ITRBK, KEYLOG, &
     &          LDABORT, LDACTIVE, LDPRINT, LDTRBK)
CALL C_DRHOOK_WATCH(IACTIVE, CDNAME, PTR, IBYTES, IABORT, IPRINT, 1, ITRBK)
END SUBROUTINE DR_HOOK_WATCH_LOGICAL_SCALAR

SUBROUTINE DR_HOOK_WATCH_LOGICAL_VEC(CDNAME, PTR, &
          &                         LDABORT, LDACTIVE, LDPRINT, LDTRBK)
INTEGER(KIND=JPIM), PARAMETER :: JP_BYTES_PER_ELEM = 4
CHARACTER(LEN=*), INTENT(IN) :: CDNAME
LOGICAL, INTENT(IN) :: PTR(:)
LOGICAL, INTENT(IN), OPTIONAL :: LDABORT, LDACTIVE, LDPRINT, LDTRBK
LOGICAL :: LLABORT, LLACTIVE, LLPRINT, LLTRBK
INTEGER(KIND=JPIM) :: IBYTES, IABORT, IACTIVE, IPRINT, ITRBK
IBYTES = SIZE(PTR) * JP_BYTES_PER_ELEM
IF (IBYTES <= 0) RETURN
CALL C_DRHOOK_WATCH(IACTIVE, CDNAME, PTR(1), IBYTES, IABORT, IPRINT, SIZE(PTR), ITRBK)
END SUBROUTINE DR_HOOK_WATCH_LOGICAL_VEC

SUBROUTINE DR_HOOK_WATCH_I4_SCALAR(CDNAME, PTR, &
          &                        LDABORT, LDACTIVE, LDPRINT, LDTRBK)
INTEGER(KIND=JPIM), PARAMETER :: JP_BYTES_PER_ELEM = 4
CHARACTER(LEN=*), INTENT(IN) :: CDNAME
INTEGER(KIND=JPIM), INTENT(IN) :: PTR
LOGICAL, INTENT(IN), OPTIONAL :: LDABORT, LDACTIVE, LDPRINT, LDTRBK
LOGICAL :: LLABORT, LLACTIVE, LLPRINT, LLTRBK
INTEGER(KIND=JPIM) :: IBYTES, IABORT, IACTIVE, IPRINT, ITRBK
IBYTES = JP_BYTES_PER_ELEM
CALL CHECK_ARGS(LLABORT, LLACTIVE, LLPRINT, LLTRBK, &
     &          IABORT, IACTIVE, IPRINT, ITRBK, KEY_I4, &
     &          LDABORT, LDACTIVE, LDPRINT, LDTRBK)
CALL C_DRHOOK_WATCH(IACTIVE, CDNAME, PTR, IBYTES, IABORT, IPRINT, 1, ITRBK)
END SUBROUTINE DR_HOOK_WATCH_I4_SCALAR

SUBROUTINE DR_HOOK_WATCH_I4_VEC(CDNAME, PTR, &
          &                    LDABORT, LDACTIVE, LDPRINT, LDTRBK)
INTEGER(KIND=JPIM), PARAMETER :: JP_BYTES_PER_ELEM = 4
CHARACTER(LEN=*), INTENT(IN) :: CDNAME
INTEGER(KIND=JPIM), INTENT(IN) :: PTR(:)
LOGICAL, INTENT(IN), OPTIONAL :: LDABORT, LDACTIVE, LDPRINT, LDTRBK
LOGICAL :: LLABORT, LLACTIVE, LLPRINT, LLTRBK
INTEGER(KIND=JPIM) :: IBYTES, IABORT, IACTIVE, IPRINT, ITRBK
IBYTES = SIZE(PTR) * JP_BYTES_PER_ELEM
IF (IBYTES <= 0) RETURN
CALL CHECK_ARGS(LLABORT, LLACTIVE, LLPRINT, LLTRBK, &
     &          IABORT, IACTIVE, IPRINT, ITRBK, KEY_I4, &
     &          LDABORT, LDACTIVE, LDPRINT, LDTRBK)
CALL C_DRHOOK_WATCH(IACTIVE, CDNAME, PTR(1), IBYTES, IABORT, IPRINT, SIZE(PTR), ITRBK)
END SUBROUTINE DR_HOOK_WATCH_I4_VEC

SUBROUTINE DR_HOOK_WATCH_I8_SCALAR(CDNAME, PTR, &
          &                        LDABORT, LDACTIVE, LDPRINT, LDTRBK)
INTEGER(KIND=JPIM), PARAMETER :: JP_BYTES_PER_ELEM = 8
CHARACTER(LEN=*), INTENT(IN) :: CDNAME
INTEGER(KIND=JPIB), INTENT(IN) :: PTR
LOGICAL, INTENT(IN), OPTIONAL :: LDABORT, LDACTIVE, LDPRINT, LDTRBK
LOGICAL :: LLABORT, LLACTIVE, LLPRINT, LLTRBK
INTEGER(KIND=JPIM) :: IBYTES, IABORT, IACTIVE, IPRINT, ITRBK
IBYTES = JP_BYTES_PER_ELEM
CALL CHECK_ARGS(LLABORT, LLACTIVE, LLPRINT, LLTRBK, &
     &          IABORT, IACTIVE, IPRINT, ITRBK, KEY_I8, &
     &          LDABORT, LDACTIVE, LDPRINT, LDTRBK)
CALL C_DRHOOK_WATCH(IACTIVE, CDNAME, PTR, IBYTES, IABORT, IPRINT, 1, ITRBK)
END SUBROUTINE DR_HOOK_WATCH_I8_SCALAR

SUBROUTINE DR_HOOK_WATCH_I8_VEC(CDNAME, PTR, &
          &                    LDABORT, LDACTIVE, LDPRINT, LDTRBK)
INTEGER(KIND=JPIM), PARAMETER :: JP_BYTES_PER_ELEM = 8
CHARACTER(LEN=*), INTENT(IN) :: CDNAME
INTEGER(KIND=JPIB), INTENT(IN) :: PTR(:)
LOGICAL, INTENT(IN), OPTIONAL :: LDABORT, LDACTIVE, LDPRINT, LDTRBK
LOGICAL :: LLABORT, LLACTIVE, LLPRINT, LLTRBK
INTEGER(KIND=JPIM) :: IBYTES, IABORT, IACTIVE, IPRINT, ITRBK
IBYTES = SIZE(PTR) * JP_BYTES_PER_ELEM
IF (IBYTES <= 0) RETURN
CALL CHECK_ARGS(LLABORT, LLACTIVE, LLPRINT, LLTRBK, &
     &          IABORT, IACTIVE, IPRINT, ITRBK, KEY_I8, &
     &          LDABORT, LDACTIVE, LDPRINT, LDTRBK)
CALL C_DRHOOK_WATCH(IACTIVE, CDNAME, PTR(1), IBYTES, IABORT, IPRINT, SIZE(PTR), ITRBK)
END SUBROUTINE DR_HOOK_WATCH_I8_VEC

SUBROUTINE DR_HOOK_WATCH_R4_SCALAR(CDNAME, PTR, &
          &                        LDABORT, LDACTIVE, LDPRINT, LDTRBK)
INTEGER(KIND=JPIM), PARAMETER :: JP_BYTES_PER_ELEM = 4
CHARACTER(LEN=*), INTENT(IN) :: CDNAME
REAL(KIND=JPRM), INTENT(IN) :: PTR
LOGICAL, INTENT(IN), OPTIONAL :: LDABORT, LDACTIVE, LDPRINT, LDTRBK
LOGICAL :: LLABORT, LLACTIVE, LLPRINT, LLTRBK
INTEGER(KIND=JPIM) :: IBYTES, IABORT, IACTIVE, IPRINT, ITRBK
IBYTES = JP_BYTES_PER_ELEM
CALL CHECK_ARGS(LLABORT, LLACTIVE, LLPRINT, LLTRBK, &
     &          IABORT, IACTIVE, IPRINT, ITRBK, KEY_R4, &
     &          LDABORT, LDACTIVE, LDPRINT, LDTRBK)
CALL C_DRHOOK_WATCH(IACTIVE, CDNAME, PTR, IBYTES, IABORT, IPRINT, 1, ITRBK)
END SUBROUTINE DR_HOOK_WATCH_R4_SCALAR

SUBROUTINE DR_HOOK_WATCH_R4_VEC(CDNAME, PTR, &
          &                    LDABORT, LDACTIVE, LDPRINT, LDTRBK)
INTEGER(KIND=JPIM), PARAMETER :: JP_BYTES_PER_ELEM = 4
CHARACTER(LEN=*), INTENT(IN) :: CDNAME
REAL(KIND=JPRM), INTENT(IN) :: PTR(:)
LOGICAL, INTENT(IN), OPTIONAL :: LDABORT, LDACTIVE, LDPRINT, LDTRBK
LOGICAL :: LLABORT, LLACTIVE, LLPRINT, LLTRBK
INTEGER(KIND=JPIM) :: IBYTES, IABORT, IACTIVE, IPRINT, ITRBK
IBYTES = SIZE(PTR) * JP_BYTES_PER_ELEM
IF (IBYTES <= 0) RETURN
CALL CHECK_ARGS(LLABORT, LLACTIVE, LLPRINT, LLTRBK, &
     &          IABORT, IACTIVE, IPRINT, ITRBK, KEY_R4, &
     &          LDABORT, LDACTIVE, LDPRINT, LDTRBK)
CALL C_DRHOOK_WATCH(IACTIVE, CDNAME, PTR(1), IBYTES, IABORT, IPRINT, SIZE(PTR), ITRBK)
END SUBROUTINE DR_HOOK_WATCH_R4_VEC

SUBROUTINE DR_HOOK_WATCH_R8_SCALAR(CDNAME, PTR, &
          &                        LDABORT, LDACTIVE, LDPRINT, LDTRBK)
INTEGER(KIND=JPIM), PARAMETER :: JP_BYTES_PER_ELEM = 8
CHARACTER(LEN=*), INTENT(IN) :: CDNAME
REAL(KIND=JPRD), INTENT(IN) :: PTR
LOGICAL, INTENT(IN), OPTIONAL :: LDABORT, LDACTIVE, LDPRINT, LDTRBK
LOGICAL :: LLABORT, LLACTIVE, LLPRINT, LLTRBK
INTEGER(KIND=JPIM) :: IBYTES, IABORT, IACTIVE, IPRINT, ITRBK
IBYTES = JP_BYTES_PER_ELEM
CALL CHECK_ARGS(LLABORT, LLACTIVE, LLPRINT, LLTRBK, &
     &          IABORT, IACTIVE, IPRINT, ITRBK, KEY_R8, &
     &          LDABORT, LDACTIVE, LDPRINT, LDTRBK)
CALL C_DRHOOK_WATCH(IACTIVE, CDNAME, PTR, IBYTES, IABORT, IPRINT, 1, ITRBK)
END SUBROUTINE DR_HOOK_WATCH_R8_SCALAR

SUBROUTINE DR_HOOK_WATCH_R8_VEC(CDNAME, PTR, &
          &                    LDABORT, LDACTIVE, LDPRINT, LDTRBK)
INTEGER(KIND=JPIM), PARAMETER :: JP_BYTES_PER_ELEM = 8
CHARACTER(LEN=*), INTENT(IN) :: CDNAME
REAL(KIND=JPRD), INTENT(IN) :: PTR(:)
LOGICAL, INTENT(IN), OPTIONAL :: LDABORT, LDACTIVE, LDPRINT, LDTRBK
LOGICAL :: LLABORT, LLACTIVE, LLPRINT, LLTRBK
INTEGER(KIND=JPIM) :: IBYTES, IABORT, IACTIVE, IPRINT, ITRBK
IBYTES = SIZE(PTR) * JP_BYTES_PER_ELEM
IF (IBYTES <= 0) RETURN
CALL CHECK_ARGS(LLABORT, LLACTIVE, LLPRINT, LLTRBK, &
     &          IABORT, IACTIVE, IPRINT, ITRBK, KEY_R8, &
     &          LDABORT, LDACTIVE, LDPRINT, LDTRBK)
CALL C_DRHOOK_WATCH(IACTIVE, CDNAME, PTR(1), IBYTES, IABORT, IPRINT, SIZE(PTR), ITRBK)
END SUBROUTINE DR_HOOK_WATCH_R8_VEC

SUBROUTINE DR_HOOK_CHECK_WATCH(CDWHERE, LDABORT)
CHARACTER(LEN=*), INTENT(IN) :: CDWHERE
LOGICAL, INTENT(IN), OPTIONAL :: LDABORT
LOGICAL :: LLABORT
INTEGER(KIND=JPIM) :: IABORT
IABORT = 0
LLABORT = .FALSE.
IF (PRESENT(LDABORT)) LLABORT = LDABORT
IF (LLABORT) IABORT = 1
CALL C_DRHOOK_CHECK_WATCH(CDWHERE, IABORT)
END SUBROUTINE DR_HOOK_CHECK_WATCH

END MODULE DR_HOOK_WATCH_MOD
