Line data    Source code

       1             : module m_omp_checker
       2             : 
       3             : contains
       4         160 :    subroutine omp_checker()
       5             :       !$ use omp_lib
       6             :       use m_judft
       7             :       USE m_constants
       8             :       use, intrinsic :: iso_c_binding
       9             :       implicit none
      10             :       
      11             : #ifdef CPP_SCHED
      12             :       interface
      13             :          function findmycpu() bind(c)
      14             :             use, intrinsic :: iso_c_binding
      15             :             integer(kind=c_int) :: findmycpu
      16             :          end function findmycpu
      17             :       end interface
      18             : 
      19         160 :       integer(kind=c_int), allocatable :: cpu(:)
      20             :       integer :: me, num_threads, mycpu, i
      21             :       logical :: l_problem
      22             : 
      23             : 
      24         160 :       !$omp parallel shared(cpu) private(me, num_threads, mycpu) 
      25             : !$    if (.false.) then
      26             :       me = 0
      27             :       num_threads = 1
      28             : !$    endif
      29             : !$    me = omp_get_thread_num()
      30             : !$    num_threads = omp_get_num_threads()
      31             :       mycpu = findmycpu()
      32             : 
      33             :       if(me == 0) allocate(cpu(num_threads), source=-1)
      34             : 
      35             :       !$omp barrier
      36             : 
      37             :       cpu(me+1) = mycpu
      38             :       !$omp end parallel
      39             : 
      40         160 :       l_problem = .False.
      41         480 :       do i = 1,size(cpu)
      42        1120 :          if(count(cpu(i) == cpu) /= 1) then
      43           0 :             WRITE(*,*) "The OpenMP parallelism seems to be weird"
      44             :             WRITE(*,*) "Multiple OMPs on one core: There are " // int2str(count(cpu(i) == cpu)) // &
      45           0 :                        " on cpu " // int2str(cpu(i))
      46           0 :             WRITE(oUnit,*) "The OpenMP parallelism seems to be weird"
      47             :             WRITE(oUnit,*) "Multiple OMPs on one core: There are " // int2str(count(cpu(i) == cpu)) // &
      48           0 :                            " on cpu " // int2str(cpu(i))
      49             : 
      50             :             l_problem = .True. 
      51             :             exit
      52             :          endif
      53             :       enddo
      54             : 
      55             :       if(l_problem) then
      56             :          !$omp parallel default(none) private(me, mycpu)
      57             : !$       me = omp_get_thread_num()  
      58             :          mycpu = findmycpu()
      59             :          write (*,*) "me: ", me, "my cpu:", mycpu 
      60             :          !$omp end parallel
      61             :       endif
      62             : 
      63             : #endif
      64             : 
      65         160 :    end subroutine omp_checker
      66             : 
      67             : end module m_omp_checker