mod_phys_lmdz_omp_data.F90

Go to the documentation of this file.

!
!$Id: mod_phys_lmdz_omp_data.F90 2326 2015-07-10 12:24:29Z emillour $
!
MODULE mod_phys_lmdz_omp_data

  INTEGER,SAVE :: omp_size
  INTEGER,SAVE :: omp_rank
  LOGICAL,SAVE :: is_omp_root
  LOGICAL,SAVE :: is_using_omp
  
  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_nb
  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_begin
  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_end    
  
  INTEGER,SAVE :: klon_omp
  INTEGER,SAVE :: klon_omp_begin
  INTEGER,SAVE :: klon_omp_end
!$OMP  THREADPRIVATE(omp_rank,klon_omp,is_omp_root,klon_omp_begin,klon_omp_end)

CONTAINS
  
  SUBROUTINE init_phys_lmdz_omp_data(klon_mpi)
    USE dimphy
    IMPLICIT NONE
    INTEGER, INTENT(in) :: klon_mpi

    INTEGER :: i

    CHARACTER (LEN=20) :: modname='Init_phys_lmdz_omp_data'
    CHARACTER (LEN=80) :: abort_message


#ifdef CPP_OMP    
    INTEGER :: OMP_GET_NUM_THREADS
    EXTERNAL omp_get_num_threads
    INTEGER :: OMP_GET_THREAD_NUM
    EXTERNAL omp_get_thread_num
#endif  

#ifdef CPP_OMP
!$OMP MASTER
        is_using_omp=.true.
        omp_size=omp_get_num_threads()
!$OMP END MASTER
        omp_rank=omp_get_thread_num()    
#else    
    is_using_omp=.false.
    omp_size=1
    omp_rank=0
#endif

   is_omp_root=.false.
!$OMP MASTER
   IF (omp_rank==0) THEN
     is_omp_root=.true.
   ELSE
     abort_message = 'ANORMAL : OMP_MASTER /= 0'
     CALL abort_gcm (modname,abort_message,1)
   ENDIF
!$OMP END MASTER


!$OMP MASTER 
    ALLOCATE(klon_omp_para_nb(0:omp_size-1))
    ALLOCATE(klon_omp_para_begin(0:omp_size-1))
    ALLOCATE(klon_omp_para_end(0:omp_size-1))
    
    DO i=0,omp_size-1
      klon_omp_para_nb(i)=klon_mpi/omp_size
      IF (i<mod(klon_mpi,omp_size)) klon_omp_para_nb(i)=klon_omp_para_nb(i)+1
    ENDDO
    
    klon_omp_para_begin(0) = 1
    klon_omp_para_end(0) = klon_omp_para_nb(0)
    
    DO i=1,omp_size-1
      klon_omp_para_begin(i)=klon_omp_para_end(i-1)+1
      klon_omp_para_end(i)=klon_omp_para_begin(i)+klon_omp_para_nb(i)-1
    ENDDO
!$OMP END MASTER
!$OMP BARRIER
   
    klon_omp=klon_omp_para_nb(omp_rank)
    klon_omp_begin=klon_omp_para_begin(omp_rank)
    klon_omp_end=klon_omp_para_end(omp_rank)
    
    CALL print_module_data
    
  END SUBROUTINE init_phys_lmdz_omp_data

  SUBROUTINE print_module_data
  IMPLICIT NONE
  include "iniprint.h"

!$OMP CRITICAL  
  WRITE(lunout,*)'--------> TASK ',omp_rank
  WRITE(lunout,*)'omp_size =',omp_size
  WRITE(lunout,*)'omp_rank =',omp_rank
  WRITE(lunout,*)'is_omp_root =',is_omp_root
  WRITE(lunout,*)'klon_omp_para_nb =',klon_omp_para_nb
  WRITE(lunout,*)'klon_omp_para_begin =',klon_omp_para_begin
  WRITE(lunout,*)'klon_omp_para_end =',klon_omp_para_end    
  WRITE(lunout,*)'klon_omp =',klon_omp
  WRITE(lunout,*)'klon_omp_begin =',klon_omp_begin
  WRITE(lunout,*)'klon_omp_end =',klon_omp_end    
!$OMP END CRITICAL

  END SUBROUTINE print_module_data
END MODULE mod_phys_lmdz_omp_data