SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/modd_surfex

Go to the documentation of this file.
00001 !     ######################
00002       MODULE MODD_SURFEX_OMP
00003 !     ######################
00004 !
00005 !!****  *MODD_SURFEX_OMP
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !
00010 !!
00011 !!**  IMPLICIT ARGUMENTS
00012 !!    ------------------
00013 !!      None 
00014 !!
00015 !!    REFERENCE
00016 !!    ---------
00017 !!
00018 !!    AUTHOR
00019 !!    ------
00020 !!      S. Faroux   *Meteo France*
00021 !!
00022 !!    MODIFICATIONS
00023 !!    -------------
00024 !!      Original       26/06/12
00025 !
00026 !*       0.   DECLARATIONS
00027 !             ------------
00028 !
00029 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00030 USE PARKIND1  ,ONLY : JPRB
00031 !
00032 #ifdef AIX64 
00033 USE OMP_LIB
00034 #endif
00035 !
00036 IMPLICIT NONE
00037 !
00038 #ifndef AIX64
00039 INCLUDE 'omp_lib.h'
00040 #endif
00041 !
00042 INTEGER :: NBLOCKTOT = 1
00043 INTEGER :: NBLOCK = 1
00044 !$OMP THREADPRIVATE(NBLOCK)
00045 INTEGER :: NINDX1 = 1
00046 !$OMP THREADPRIVATE(NINDX1)
00047 INTEGER :: NINDX2 = 1
00048 !$OMP THREADPRIVATE(NINDX2)
00049 INTEGER :: IDC = 0
00050 !
00051 INTEGER, DIMENSION(:), POINTER :: NWORK=>NULL()
00052 REAL, DIMENSION(:), POINTER :: XWORK=>NULL()
00053 REAL, DIMENSION(:,:), POINTER :: XWORK2=>NULL()
00054 !
00055 CONTAINS
00056 !
00057 !*********************************************************
00058 !
00059 SUBROUTINE INIT_DIM(KSIZE_OMP,KBLOCK,KKPROMA,KINDX1,KINDX2)
00060 !
00061 INTEGER, DIMENSION(0:NBLOCKTOT-1), INTENT(IN) :: KSIZE_OMP
00062 INTEGER, INTENT(IN) :: KBLOCK
00063 INTEGER, INTENT(OUT) :: KKPROMA
00064 INTEGER, INTENT(OUT) :: KINDX1
00065 INTEGER, INTENT(OUT) :: KINDX2
00066 !
00067 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00068 !
00069 IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_OMP:INIT_DIM',0,ZHOOK_HANDLE)
00070 !
00071 KKPROMA = KSIZE_OMP(KBLOCK)
00072 KINDX2  = SUM(KSIZE_OMP(0:KBLOCK))
00073 KINDX1   = KINDX2 - KKPROMA + 1
00074 !
00075 IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_OMP:INIT_DIM',1,ZHOOK_HANDLE)
00076 !
00077 END SUBROUTINE INIT_DIM
00078 !
00079 !*********************************************************
00080 !
00081 SUBROUTINE RESET_DIM(KNI,KKPROMA,KINDX1,KINDX2)
00082 !
00083 INTEGER, INTENT(IN) :: KNI
00084 INTEGER, INTENT(OUT) :: KKPROMA
00085 INTEGER, INTENT(OUT) :: KINDX1
00086 INTEGER, INTENT(OUT) :: KINDX2
00087 !
00088 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00089 !
00090 IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_OMP:RESET_DIM',0,ZHOOK_HANDLE)
00091 !
00092 KKPROMA = KNI
00093 KINDX2 = KNI
00094 KINDX1 = 1
00095 !
00096 IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_OMP:RESET_DIM',1,ZHOOK_HANDLE)
00097 !
00098 END SUBROUTINE RESET_DIM
00099 !
00100 !*********************************************************
00101 !
00102 SUBROUTINE PLOG_OMP(HLOG,RLOG,KLOG,KLOG2,OLOG)
00103 !
00104  CHARACTER(LEN=*), INTENT(IN) :: HLOG
00105 REAL, INTENT(IN),OPTIONAL :: RLOG
00106 INTEGER, INTENT(IN), OPTIONAL :: KLOG
00107 INTEGER, INTENT(IN), OPTIONAL :: KLOG2
00108 LOGICAL, INTENT(IN), OPTIONAL :: OLOG
00109 !
00110 INTEGER :: ME
00111 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00112 !
00113 IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_OMP:PLOG_OMP',0,ZHOOK_HANDLE)
00114 !
00115 !$ ME = OMP_GET_THREAD_NUM()
00116 !
00117 IF (PRESENT(OLOG)) THEN
00118   IF (PRESENT(RLOG)) THEN
00119     IF (PRESENT(KLOG)) THEN
00120       IF (PRESENT(KLOG2)) THEN
00121         PRINT*,ME, HLOG, KLOG, KLOG2, RLOG, OLOG
00122       ELSE
00123         PRINT*,ME, HLOG, KLOG, RLOG, OLOG
00124       ENDIF
00125     ELSE
00126       PRINT*,ME, HLOG, RLOG, OLOG
00127     ENDIF
00128   ELSEIF (PRESENT(KLOG)) THEN
00129     IF (PRESENT(KLOG2)) THEN
00130       PRINT*,ME, HLOG, KLOG, KLOG2, OLOG
00131     ELSE
00132       PRINT*,ME, HLOG, KLOG, OLOG
00133     ENDIF
00134   ELSE
00135     PRINT*,ME, HLOG, OLOG
00136   ENDIF
00137 ELSEIF (PRESENT(RLOG)) THEN
00138   IF (PRESENT(KLOG)) THEN
00139     IF (PRESENT(KLOG2)) THEN
00140       PRINT*,ME, HLOG, KLOG, KLOG2, RLOG
00141     ELSE
00142       PRINT*,ME, HLOG, KLOG, RLOG
00143     ENDIF
00144   ELSE
00145     PRINT*,ME, HLOG, RLOG
00146   ENDIF
00147 ELSEIF (PRESENT(KLOG)) THEN
00148   IF (PRESENT(KLOG2)) THEN
00149     PRINT*,ME, HLOG, KLOG, KLOG2
00150   ELSE
00151     PRINT*,ME, HLOG, KLOG
00152   ENDIF
00153 ELSE
00154   PRINT*,ME, HLOG
00155 ENDIF
00156 !
00157 IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_OMP:PLOG_OMP',1,ZHOOK_HANDLE)
00158 !
00159 END SUBROUTINE PLOG_OMP
00160 !
00161 !*********************************************************
00162 !
00163 END MODULE MODD_SURFEX_OMP
00164