MODULE YOMOML !-- the following system specific omp_lib-module is not always available (e.g. pgf90) !! use omp_lib USE PARKIND1 ,ONLY : JPIM, JPIB !**SS/18-Feb-2005 !--Dr.Hook references removed, because these locks may also be ! called from within drhook.c itself !! !--Also, there could be considerable & unjustified overhead ! when using Dr.Hook in such a low level !**SS/15-Dec-2005 !--The size of lock-variables are now OMP_LOCK_KIND as of in OMP_LIB, ! and OMP_LOCK_KIND is aliased to OML_LOCK_KIND ! OMP_LOCK_KIND is usually 4 in 32-bit addressing mode ! 8 in 64-bit addressing mode !--M_OML_LOCK changed to M_EVENT and kept as 32-bit int !--OML_FUNCT changed to OML_TEST_EVENT !--M_LOCK initialized to -1 !--M_EVENT initialized to 0 !--Added intent(s) !--Support for omp_lib (but not always available) !--Locks can now also be set/unset OUTSIDE the parallel regions !--Added routine OML_TEST_LOCK (attempts to set lock, but if *un*successful, does NOT block) !--Buffer-zone for M_LOCK; now a vector of 2 elements in case problems/inconsistencies with OMP_LOCK_KIND 4/8 !**SS/22-Feb-2006 !--Locking routines are doing nothing unless OMP_GET_MAX_THREADS() > 1 ! This is to avoid unacceptable deadlocks/timeouts with signal handlers when ! the only thread receives signal while inside locked region !--Affected routines: OML_TEST_LOCK() --> always receives .TRUE. ! OML_SET_LOCK() --> sets nothing ! OML_UNSET_LOCK() --> unsets nothing ! OML_INIT_LOCK() --> inits nothing !**SS/11-Sep-2006 !--Added OML_DEBUG feature IMPLICIT NONE SAVE PRIVATE LOGICAL :: OML_DEBUG = .FALSE. !$OMP THREADPRIVATE(OML_DEBUG) PUBLIC OML_WAIT_EVENT, OML_SET_EVENT, OML_INCR_EVENT, & & OML_MY_THREAD, OML_MAX_THREADS , OML_OMP, & & OML_IN_PARALLEL, OML_TEST_EVENT, & & OML_UNSET_LOCK, OML_INIT_LOCK, OML_SET_LOCK, OML_DESTROY_LOCK, & & OML_LOCK_KIND, OML_TEST_LOCK, OML_DEBUG !-- The following should normally be 4 in 32-bit addressing mode ! 8 in 64-bit addressing mode ! Since system specific omp_lib-module is not always available (e.g. pgf90) ! we hardcode OML_LOCK_KIND to JPIB (usually 8) for now !!INTEGER(KIND=JPIM), PARAMETER :: OML_LOCK_KIND = OMP_LOCK_KIND INTEGER(KIND=JPIM), PARAMETER :: OML_LOCK_KIND = JPIB !-- Note: Still JPIM !! INTEGER(KIND=JPIM) :: M_EVENT = 0 !$OMP THREADPRIVATE(M_EVENT) !-- Note: OML_LOCK_KIND, not JPIM !! INTEGER(KIND=OML_LOCK_KIND) :: M_LOCK(2) = (/-1, -1/) !$OMP THREADPRIVATE(M_LOCK) CONTAINS FUNCTION OML_OMP() LOGICAL :: OML_OMP OML_OMP=.FALSE. !$ OML_OMP=.TRUE. END FUNCTION OML_OMP FUNCTION OML_IN_PARALLEL() LOGICAL :: OML_IN_PARALLEL !$ LOGICAL :: OMP_IN_PARALLEL !$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS OML_IN_PARALLEL=.FALSE. !$ OML_IN_PARALLEL=((OMP_GET_MAX_THREADS() > 1).AND.OMP_IN_PARALLEL()) END FUNCTION OML_IN_PARALLEL FUNCTION OML_TEST_LOCK(MYLOCK) INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK LOGICAL :: OML_TEST_LOCK !$ LOGICAL :: OMP_TEST_LOCK !$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS OML_TEST_LOCK = .TRUE. !$ IF(OMP_GET_MAX_THREADS() > 1) THEN !$ IF(PRESENT(MYLOCK))THEN !$ OML_TEST_LOCK = OMP_TEST_LOCK(MYLOCK) !$ ELSE !$ OML_TEST_LOCK = OMP_TEST_LOCK(M_LOCK(1)) !$ ENDIF !$ ENDIF END FUNCTION OML_TEST_LOCK SUBROUTINE OML_UNSET_LOCK(MYLOCK) INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK !$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS !$ IF(OMP_GET_MAX_THREADS() > 1) THEN !$ IF(PRESENT(MYLOCK))THEN !$ CALL OMP_UNSET_LOCK(MYLOCK) !$ ELSE !$ CALL OMP_UNSET_LOCK(M_LOCK(1)) !$ ENDIF !$ ENDIF END SUBROUTINE OML_UNSET_LOCK SUBROUTINE OML_SET_LOCK(MYLOCK) INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK !$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS !$ IF(OMP_GET_MAX_THREADS() > 1) THEN !$ IF(PRESENT(MYLOCK))THEN !$ CALL OMP_SET_LOCK(MYLOCK) !$ ELSE !$ CALL OMP_SET_LOCK(M_LOCK(1)) !$ ENDIF !$ ENDIF END SUBROUTINE OML_SET_LOCK SUBROUTINE OML_INIT_LOCK(MYLOCK) INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK !$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS !$ IF(OMP_GET_MAX_THREADS() > 1) THEN !$ IF(PRESENT(MYLOCK))THEN !$ CALL OMP_INIT_LOCK(MYLOCK) !$ ELSE !$ CALL OMP_INIT_LOCK(M_LOCK(1)) !$ ENDIF !$ ENDIF END SUBROUTINE OML_INIT_LOCK SUBROUTINE OML_DESTROY_LOCK(MYLOCK) INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK !$ IF(PRESENT(MYLOCK))THEN !$ CALL OMP_DESTROY_LOCK(MYLOCK) !$ ELSE !$ CALL OMP_DESTROY_LOCK(M_LOCK(1)) !$ ENDIF END SUBROUTINE OML_DESTROY_LOCK FUNCTION OML_TEST_EVENT(K,MYEVENT) LOGICAL :: OML_TEST_EVENT INTEGER(KIND=JPIM),intent(in) :: K,MYEVENT IF(K.EQ.MYEVENT) THEN OML_TEST_EVENT =.TRUE. ELSE OML_TEST_EVENT=.FALSE. ENDIF END FUNCTION OML_TEST_EVENT SUBROUTINE OML_WAIT_EVENT(K,MYEVENT) INTEGER(KIND=JPIM),intent(in) :: K INTEGER(KIND=JPIM),intent(in),OPTIONAL :: MYEVENT IF(PRESENT(MYEVENT))THEN DO IF(OML_TEST_EVENT(K,MYEVENT)) EXIT ENDDO ELSE DO IF(OML_TEST_EVENT(K,M_EVENT)) EXIT ENDDO ENDIF END SUBROUTINE OML_WAIT_EVENT SUBROUTINE OML_SET_EVENT(K,MYEVENT) INTEGER(KIND=JPIM),intent(in) :: K INTEGER(KIND=JPIM),intent(out),OPTIONAL :: MYEVENT IF(PRESENT(MYEVENT))THEN MYEVENT=K ELSE M_EVENT=K ENDIF END SUBROUTINE OML_SET_EVENT SUBROUTINE OML_INCR_EVENT(K,MYEVENT) INTEGER(KIND=JPIM) :: K INTEGER(KIND=JPIM),intent(inout),OPTIONAL :: MYEVENT IF(PRESENT(MYEVENT))THEN MYEVENT=MYEVENT+K ELSE M_EVENT=M_EVENT+K ENDIF END SUBROUTINE OML_INCR_EVENT FUNCTION OML_MY_THREAD() INTEGER(KIND=JPIM) :: OML_MY_THREAD !$ INTEGER(KIND=JPIM) OMP_GET_THREAD_NUM OML_MY_THREAD = 1 !$ OML_MY_THREAD = OMP_GET_THREAD_NUM() + 1 END FUNCTION OML_MY_THREAD FUNCTION OML_MAX_THREADS() INTEGER(KIND=JPIM) :: OML_MAX_THREADS !$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS OML_MAX_THREADS = 1 !$ OML_MAX_THREADS = OMP_GET_MAX_THREADS() END FUNCTION OML_MAX_THREADS END MODULE YOMOML