modd_surfex_omp.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     ######################
      MODULE modd_surfex_omp
!     ######################
!
!!****  *MODD_SURFEX_OMP
!!
!!    PURPOSE
!!    -------
!
!!
!!**  IMPLICIT ARGUMENTS
!!    ------------------
!!      None 
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!      S. Faroux   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original       26/06/12
!!      Modified    11/2013 by J.Escobar :add !$ to inhibit completly omp
!!                                 dependency
!
!*       0.   DECLARATIONS
!             ------------
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
#ifdef AIX64 
 USE omp_lib
#endif
!
IMPLICIT NONE
!
#ifndef AIX64
  include 'omp_lib.h'
#endif
!
!RJ: this broke non openmp version before
!RJ: OMP_GET_THREAD_NUM() returns 0 for first omp thread
!RJ: OMP_GET_NUM_THREADS() returns 1 for omp thread count
#ifdef RJ_OFIX
INTEGER :: NBLOCKTOT = 1
INTEGER :: NBLOCK = 0
#else
INTEGER :: NBLOCKTOT = 1
INTEGER :: NBLOCK = 1
#endif
!$OMP THREADPRIVATE(NBLOCK)
INTEGER :: NINDX1SFX = 1
!$OMP THREADPRIVATE(NINDX1SFX)
INTEGER :: NINDX2SFX = 1
!$OMP THREADPRIVATE(NINDX2SFX)
INTEGER :: IDC = 0
!
 CHARACTER(LEN=100) :: CWORK0, CWORKB
LOGICAL :: LWORK0
LOGICAL, DIMENSION(:), POINTER :: LWORKD
INTEGER :: NWORK0, NWORKVAR, NWORKB, NWORKDIMS
INTEGER, DIMENSION(4) :: NWORKLEN
INTEGER, DIMENSION(4) :: NWORKIDS
INTEGER, DIMENSION(:), POINTER :: NWORK_FULL
INTEGER, DIMENSION(:), POINTER :: NWORKD
INTEGER, DIMENSION(:), POINTER :: NWORK
INTEGER, DIMENSION(:,:), POINTER :: NWORK2_FULL
INTEGER, DIMENSION(:,:), POINTER :: NWORKD2
INTEGER, DIMENSION(:,:), POINTER :: NWORK2
INTEGER, DIMENSION(:,:,:), POINTER :: NWORKD3
REAL :: XWORK0
REAL, DIMENSION(:), POINTER :: XWORK_FULL
REAL, DIMENSION(:), POINTER :: XWORKD
REAL, DIMENSION(:), POINTER :: XWORK
REAL, DIMENSION(:,:), POINTER :: XWORK2_FULL
REAL, DIMENSION(:,:), POINTER :: XWORKD2
REAL, DIMENSION(:,:), POINTER :: XWORK2
REAL, DIMENSION(:,:,:), POINTER :: XWORKD3
REAL, DIMENSION(:,:,:), POINTER :: XWORK3
!
 CONTAINS
!
!*********************************************************
!
SUBROUTINE init_dim(KSIZE_OMP,KBLOCK,KKPROMA,KINDX1,KINDX2)
!
!RJ: work around to detect serial regions
!RJ INTEGER, DIMENSION(0:NBLOCKTOT-1), INTENT(IN) :: KSIZE_OMP
INTEGER, DIMENSION(0:), INTENT(IN) :: ksize_omp
INTEGER, INTENT(IN) :: kblock
INTEGER, INTENT(OUT) :: kkproma
INTEGER, INTENT(OUT) :: kindx1
INTEGER, INTENT(OUT) :: kindx2
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODD_SURFEX_OMP:INIT_DIM',0,zhook_handle)
!
IF((kblock<SIZE(ksize_omp)).AND.(kblock<nblocktot)) THEN
kkproma = ksize_omp(kblock)
kindx2  = sum(ksize_omp(0:kblock))
kindx1   = kindx2 - kkproma + 1
ELSE
write(0,*) "Warning[OMP]: dummy dim init for KBLOCK=",kblock
kkproma=0
kindx2=-666
kindx1=-666
ENDIF
!
IF (lhook) CALL dr_hook('MODD_SURFEX_OMP:INIT_DIM',1,zhook_handle)
!
END SUBROUTINE init_dim
!
!*********************************************************
!
SUBROUTINE reset_dim(KNI,KKPROMA,KINDX1,KINDX2)
!
INTEGER, INTENT(IN) :: kni
INTEGER, INTENT(OUT) :: kkproma
INTEGER, INTENT(OUT) :: kindx1
INTEGER, INTENT(OUT) :: kindx2
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODD_SURFEX_OMP:RESET_DIM',0,zhook_handle)
!
kkproma = kni
kindx2 = kni
kindx1 = 1
!
IF (lhook) CALL dr_hook('MODD_SURFEX_OMP:RESET_DIM',1,zhook_handle)
!
END SUBROUTINE reset_dim
!
!*********************************************************
!
SUBROUTINE plog_omp(HLOG,RLOG,KLOG,KLOG2,OLOG)
!
 CHARACTER(LEN=*), INTENT(IN) :: hlog
REAL, INTENT(IN),OPTIONAL :: rlog
INTEGER, INTENT(IN), OPTIONAL :: klog
INTEGER, INTENT(IN), OPTIONAL :: klog2
LOGICAL, INTENT(IN), OPTIONAL :: olog
!
INTEGER :: me
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODD_SURFEX_OMP:PLOG_OMP',0,zhook_handle)
!
!$ ME = OMP_GET_THREAD_NUM()
!
IF (present(olog)) THEN
  IF (present(rlog)) THEN
    IF (present(klog)) THEN
      IF (present(klog2)) THEN
        print*,me, hlog, klog, klog2, rlog, olog
      ELSE
        print*,me, hlog, klog, rlog, olog
      ENDIF
    ELSE
      print*,me, hlog, rlog, olog
    ENDIF
  ELSEIF (present(klog)) THEN
    IF (present(klog2)) THEN
      print*,me, hlog, klog, klog2, olog
    ELSE
      print*,me, hlog, klog, olog
    ENDIF
  ELSE
    print*,me, hlog, olog
  ENDIF
ELSEIF (present(rlog)) THEN
  IF (present(klog)) THEN
    IF (present(klog2)) THEN
      print*,me, hlog, klog, klog2, rlog
    ELSE
      print*,me, hlog, klog, rlog
    ENDIF
  ELSE
    print*,me, hlog, rlog
  ENDIF
ELSEIF (present(klog)) THEN
  IF (present(klog2)) THEN
    print*,me, hlog, klog, klog2
  ELSE
    print*,me, hlog, klog
  ENDIF
ELSE
  print*,me, hlog
ENDIF
!
IF (lhook) CALL dr_hook('MODD_SURFEX_OMP:PLOG_OMP',1,zhook_handle)
!
END SUBROUTINE plog_omp
!
!*********************************************************
!
END MODULE modd_surfex_omp