fdbsubs_mod.F90

Go to the documentation of this file.

MODULE fdbsubs_mod
!
!== fdbsubs_mod.F90 ==
!
! A module to encapsulate FDB-calls in order to call Dr.Hook
!
! Author: Sami Saarinen, 22-Mar-2004
!

USE parkind1 , ONLY : jpim,jprb,jprm
USE yomhook  , ONLY : lhook, dr_hook

IMPLICIT NONE

PUBLIC
SAVE

INTEGER(KIND=JPIM), EXTERNAL :: iclosefdb
INTEGER(KIND=JPIM), EXTERNAL :: iflushfdb
INTEGER(KIND=JPIM), EXTERNAL :: iinitfdb
INTEGER(KIND=JPIM), EXTERNAL :: iopenfdb
INTEGER(KIND=JPIM), EXTERNAL :: ireadfdb
INTEGER(KIND=JPIM), EXTERNAL :: isetcommfdb
INTEGER(KIND=JPIM), EXTERNAL :: isetfieldcountfdb
INTEGER(KIND=JPIM), EXTERNAL :: isetrankfdb
INTEGER(KIND=JPIM), EXTERNAL :: isetvalfdb
INTEGER(KIND=JPIM), EXTERNAL :: iset_fdb_root
INTEGER(KIND=JPIM), EXTERNAL :: iwritefdb

CONTAINS

FUNCTION iclosefdbsubs(KFDB) RESULT(IRET)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KFDB
INTEGER(KIND=JPIM) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('ICLOSEFDB',0,zhook_handle)
iret = iclosefdb(kfdb)
IF (lhook) CALL dr_hook('ICLOSEFDB',1,zhook_handle)
END FUNCTION iclosefdbsubs

FUNCTION iflushfdbsubs(KFDB) RESULT(IRET)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KFDB
INTEGER(KIND=JPIM) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('IFLUSHFDB',0,zhook_handle)
iret = iflushfdb(kfdb)
IF (lhook) CALL dr_hook('IFLUSHFDB',1,zhook_handle)
END FUNCTION iflushfdbsubs

FUNCTION iinitfdbsubs() RESULT(IRET)
INTEGER(KIND=JPIM) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('IINITFDB',0,zhook_handle)
iret = iinitfdb()
IF (lhook) CALL dr_hook('IINITFDB',1,zhook_handle)
END FUNCTION iinitfdbsubs

FUNCTION iopenfdbsubs(CDFDB,KFDB,CDMODE) RESULT(IRET)
CHARACTER(LEN=*), INTENT(IN) :: CDFDB, CDMODE
INTEGER(KIND=JPIM),INTENT(INOUT) :: KFDB
INTEGER(KIND=JPIM) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('IOPENFDB',0,zhook_handle)
iret = iopenfdb(cdfdb,kfdb,cdmode)
IF (lhook) CALL dr_hook('IOPENFDB',1,zhook_handle)
END FUNCTION iopenfdbsubs

FUNCTION ireadfdbsubs(KFDB,KGRIB,KLEN) RESULT(IRET)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KFDB,KLEN,KGRIB(:)
INTEGER(KIND=JPIM) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('IREADFDB',0,zhook_handle)
IF (SIZE(kgrib) > 0) THEN
  iret = ireadfdb(kfdb, kgrib(1), klen)
ELSE
  iret = ireadfdb(kfdb, kgrib, klen)
ENDIF
IF (lhook) CALL dr_hook('IREADFDB',1,zhook_handle)
END FUNCTION ireadfdbsubs

FUNCTION isetcommfdbsubs(KCOMM) RESULT(IRET)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KCOMM
INTEGER(KIND=JPIM) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('ISETCOMMFDB',0,zhook_handle)
iret = isetcommfdb(kcomm)
IF (lhook) CALL dr_hook('ISETCOMMFDB',1,zhook_handle)
END FUNCTION isetcommfdbsubs

FUNCTION isetfieldcountfdbsubs(KFDB,KGLOBAL,KLOCAL) RESULT(IRET)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KFDB
INTEGER(KIND=JPIM),INTENT(IN) :: KGLOBAL,KLOCAL
INTEGER(KIND=JPIM) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('ISETFIELDCOUNTFDB',0,zhook_handle)
iret = isetfieldcountfdb(kfdb,kglobal,klocal)
IF (lhook) CALL dr_hook('ISETFIELDCOUNTFDB',1,zhook_handle)
END FUNCTION isetfieldcountfdbsubs

FUNCTION isetrankfdbsubs(KFDB,KLEV) RESULT(IRET)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KFDB,KLEV
INTEGER(KIND=JPIM) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('ISETRANKFDB',0,zhook_handle)
iret = isetrankfdb(kfdb,klev)
IF (lhook) CALL dr_hook('ISETRANKFDB',1,zhook_handle)
END FUNCTION isetrankfdbsubs

FUNCTION isetvalfdbsubs(KFDB,CDNAME,CDKIND) RESULT(IRET)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KFDB
CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDKIND
INTEGER(KIND=JPIM) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('ISETVALFDB',0,zhook_handle)
iret = isetvalfdb(kfdb,cdname,cdkind)
IF (lhook) CALL dr_hook('ISETVALFDB',1,zhook_handle)
END FUNCTION isetvalfdbsubs

FUNCTION iset_fdbsubs_root(KFDB,CDNAME) RESULT(IRET)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KFDB
CHARACTER(LEN=*), INTENT(INOUT) :: CDNAME
INTEGER(KIND=JPIM) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('ISET_FDB_ROOT',0,zhook_handle)
iret = iset_fdb_root(kfdb,cdname)
IF (lhook) CALL dr_hook('ISET_FDB_ROOT',1,zhook_handle)
END FUNCTION iset_fdbsubs_root

FUNCTION iwritefdbsubs(KFDB,KGRIB,KLEN) RESULT(IRET)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KFDB,KLEN,KGRIB(:)
INTEGER(KIND=JPIM) :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('IWRITEFDB',0,zhook_handle)
IF (SIZE(kgrib) > 0) THEN
  iret = iwritefdb(kfdb, kgrib(1), klen)
ELSE
  iret = iwritefdb(kfdb, kgrib, klen)
ENDIF
IF (lhook) CALL dr_hook('IWRITEFDB',1,zhook_handle)
END FUNCTION iwritefdbsubs

END MODULE fdbsubs_mod