check_para.F90 3.02 KB
Newer Older
1 2 3 4 5
MODULE m_judft_para

CONTAINS
   subroutine juDFT_check_para()
      implicit none
Matthias Redies's avatar
Matthias Redies committed
6 7 8 9 10 11 12 13 14 15
      logical   :: omp_para_loc, omp_root_and
      integer   :: irank, ierr

#ifdef CPP_MPI
      INCLUDE 'mpif.h'

      call MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr)
      omp_para_loc = check_omp_para()

      call MPI_Reduce(omp_para_loc, omp_root_and, 1,&
16
                      MPI_LOGICAL, MPI_LAND, 0, MPI_COMM_WORLD,ierr)
Matthias Redies's avatar
Matthias Redies committed
17 18 19 20 21 22 23 24 25

      if(irank == 0 .and. omp_root_and) then
         write (*,*) "Parallelization OK"
      endif
#else
      omp_para_loc = check_omp_para()
      if(omp_para_loc) write (*,*) "Parallelization OK"
#endif

26 27
   end subroutine juDFT_check_para

28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
   !subroutine check_mpi_para(mpi)
      !use m_judft_string
      !use m_judft_stop
      !implicit none
      !TYPE(t_mpi)    ,INTENT(IN) :: mpi
      !real(8)                    :: summe, summe_seq, t_mpi, t_seq
      !integer(4)                 :: rank, size, ierr
      !integer                    :: i, omp_threads
      !integer, parameter          :: loop_end = 300000000

      !t_mpi = MPI_Wtime()
      !summe = 0.0
      !do i = 1, loop_end*omp_threads
         !summe = summe + 1.0
      !enddo
      !t_mpi = MPI_Wtime() - t_mpi

      !call MPI_Reduce(summe, summe_seq, 1, MPI_REAL8, MPI_SUM, 0, mpi%mpi_comm)

      !if(mpi%irank == 0) then
         !summe = summe / mpi%isize

         !t_seq = MPI_Wtime()
         !summe = 0.0
         !do i = 1, loop_end*omp_threads
            !summe = summe + 1.0
         !enddo
         !t_seq = MPI_Wtime() - t_seq
      !endif

   !end subroutine check_mpi_para

Matthias Redies's avatar
Matthias Redies committed
60
   function check_omp_para() result(parallel_ok)
61 62 63 64
      use omp_lib
      use m_judft_string
      use m_judft_stop
      implicit none
Matthias Redies's avatar
Matthias Redies committed
65
      logical            :: parallel_ok
66 67
      real               :: summe, t_omp, t_seq
      integer            :: rank, size, ierr
Matthias Redies's avatar
Matthias Redies committed
68
      integer            :: i, j, omp_threads
69 70 71
      integer, parameter :: loop_end = 300000000

      summe = 0.0
Matthias Redies's avatar
Matthias Redies committed
72 73 74
      t_omp = 0.0
   
      !$omp parallel reduction(+: t_omp) 
75 76
      omp_threads = OMP_GET_NUM_THREADS()
      t_omp = OMP_GET_WTIME()
Matthias Redies's avatar
Matthias Redies committed
77 78 79 80 81
      !$omp do schedule(static) reduction(+:summe)
      do i = 1, loop_end
         do j = 1, omp_threads
            summe = summe + 1.0
         enddo
82 83 84
      enddo
      !$omp end do
      t_omp = OMP_GET_WTIME() - t_omp
85 86 87 88 89 90 91 92 93 94 95 96
      !$omp end parallel

      t_omp = t_omp / omp_threads
      summe = summe / omp_threads

      t_seq = OMP_GET_WTIME()
      do i = 1, loop_end
         summe = summe - 1.0
      enddo
      t_seq = OMP_GET_WTIME() - t_seq

      if( abs(t_seq/t_omp -1.0) < 0.1)then
Matthias Redies's avatar
Matthias Redies committed
97
         parallel_ok = .True.
98
      else
99
         write (*,*) "number of OMPs = ", omp_threads
100 101 102 103 104
         write (*,*) "t_omp = ", t_omp
         write (*,*) "t_seq = ", t_seq
         write (*,*) "Summe = ", summe

         call juDFT_warn("OMP parallelization underperform with a parallel efficiency of " // &
105
            float2str(t_seq/t_omp), hint="check if your slurm files is set properly")
Matthias Redies's avatar
Matthias Redies committed
106
         parallel_ok = .False.
107
      endif
Matthias Redies's avatar
Matthias Redies committed
108
   end function check_omp_para
109 110

END MODULE m_judft_para