LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-30 15:15:38 +01:00
Code Releases Activity

add a test to check if omp works on multiple levels

Browse Source
This commit is contained in:
Yann Damour 2021-11-19 09:57:04 +01:00
parent 243315ae7c
commit 612f5a5e9c
5 changed files with 259 additions and 136 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

242
src/fci/check_omp.irp.f Normal file
View File

@ -0,0 +1,242 @@
program check_omp
use omp_lib
implicit none
integer :: i,j,k,l,m,n,x,z,setting
double precision :: w1,w2,c1,c2
double precision, allocatable :: accu(:,:,:,:)
logical :: must_exit, verbose, is_working
x = 4
allocate(accu(x,x,x,x))
verbose = .False.
accu = 0d0
must_exit = .False.
!$OMP PARALLEL
if (OMP_GET_NUM_THREADS() == 1) then
print*,''
print*,'1 thread, no parallelization possible'
print*,''
must_exit=.True.
endif
!$OMP END PARALLEL
if (must_exit) then
call abort
endif
! reset the number of max active levels
!call omp_set_max_active_levels(1)
!print*,'omp_get_max_active_levels:',omp_get_max_active_levels()
!call intel_check_omp()
!print*,'omp_get_max_active_levels:',omp_get_max_active_levels()
! set the number of threads
call omp_set_num_threads(2)
do z = 1, 4
if (must_exit) then
exit
endif
call omp_set_max_active_levels(1)
call omp_set_nested(.False.)
if (z==1) then
call test_set_multiple_levels_omp()
!call test_set_multiple_levels_omp
elseif (z==2) then
call omp_set_max_active_levels(5)
elseif (z==3) then
call omp_set_nested(.True.)
else
call omp_set_nested(.True.)
call omp_set_max_active_levels(5)
endif
setting = z-1
!$OMP PARALLEL &
!$OMP PRIVATE(i,j,k,l,m,n) &
!$OMP SHARED(accu)
if (verbose) then
print*,'Nb threads level 1:', omp_get_num_threads()
endif
!$OMP MASTER
if (omp_get_num_threads()==1) then
print*,'Setting',setting,"error at level 1"
setting = -1
endif
!$OMP END MASTER
! !$OMP DO
! do l = 1, x
! do k = 1, x
! do j = 1, x
! do i = 1, x
! accu(i,j,k,l) = accu(i,j,k,l) + 1d0
! enddo
! enddo
! enddo
! enddo
! !$OMP END DO
!$OMP PARALLEL &
!$OMP PRIVATE(i,j,k,l,m,n) &
!$OMP SHARED(accu)
if (verbose) then
print*,'Nb threads level 2:', omp_get_num_threads()
endif
!$OMP MASTER
if (omp_get_num_threads()==1 .and. setting >= 0) then
print*,'Setting',setting,"error at level 2"
setting = -1
endif
!$OMP END MASTER
! !$OMP DO
! do l = 1, x
! do k = 1, x
! do j = 1, x
! do i = 1, x
! accu(i,j,k,l) = accu(i,j,k,l)+ 1d0
! enddo
! enddo
! enddo
! enddo
! !$OMP END DO
!$OMP PARALLEL &
!$OMP PRIVATE(i,j,k,l,m,n) &
!$OMP SHARED(accu)
if (verbose) then
print*,'Nb threads level 3:', omp_get_num_threads()
endif
!$OMP MASTER
if (omp_get_num_threads()==1 .and. setting >= 0) then
print*,'Setting',setting,"error at level 3"
setting = -1
endif
!$OMP END MASTER
! !$OMP DO
! do l = 1, x
! do k = 1, x
! do j = 1, x
! do i = 1, x
! accu(i,j,k,l) = accu(i,j,k,l)+ 1d0
! enddo
! enddo
! enddo
! enddo
! !$OMP END DO
!$OMP PARALLEL &
!$OMP PRIVATE(i,j,k,l,m,n) &
!$OMP SHARED(accu)
if (verbose) then
print*,'Nb threads level 4:', omp_get_num_threads()
endif
!$OMP MASTER
if (omp_get_num_threads()==1 .and. setting >= 0) then
print*,'Setting',setting,"error at level 4"
elseif(omp_get_num_threads()==1 .or. setting == 0) then
else
must_exit = .True.
endif
if ( z == 1 .and. setting == 0) then
is_working = .True.
elseif (z == 1 .and. setting == -1) then
is_working = .False.
else
endif
!$OMP END MASTER
! !$OMP DO
! do l = 1, x
! do k = 1, x
! do j = 1, x
! do i = 1, x
! accu(i,j,k,l) = accu(i,j,k,l)+ 1d0
! enddo
! enddo
! enddo
! enddo
! !$OMP END DO
!$OMP END PARALLEL
!$OMP END PARALLEL
!$OMP END PARALLEL
!$OMP END PARALLEL
enddo
print*,''
if (setting == 1) then
print*,'The parallelization works on 4 levels with:'
print*,'call omp_set_max_active_levels(5)'
print*,''
print*,'Please use the irpf90 flags -DSET_MAX_ACT in qp2/config/${compiler_name}.cfg'
elseif (setting == 2) then
print*,'The parallelization works on 4 levels with:'
print*,'call omp_set_nested(.True.)'
print*,''
print*,'Please use the irpf90 flag -DSET_NESTED in qp2/config/${compiler_name}.cfg'
elseif (setting == 3) then
print*,'The parallelization works on 4 levels with:'
print*,'call omp_set_nested(.True.)'
print*,'+'
print*,'call omp_set_max_active_levels(5)'
print*,''
print*,'Please use the irpf90 flags -DSET_NESTED -DSET_MAX_ACT in qp2/config/${compiler_name}.cfg'
else
print*,'The parallelization on multiple levels does not work with:'
print*,'call omp_set_max_active_levels(5)'
print*,'or'
print*,'call omp_set_nested(.True.)'
print*,'or'
print*,'call omp_set_nested(.True.)'
print*,'+'
print*,'call omp_set_max_active_levels(5)'
print*,''
print*,'Good luck...'
endif
if (is_working) then
print*,''
print*,'=========================================================='
print*,'Your actual set up works for parallelization with 4 levels'
print*,'=========================================================='
print*,''
else
print*,''
print*,'==================================================================='
print*,'Your actual set up works for parallelization with 4 levels'
print*,'Please look at the previous messages to understand the requirements'
print*,'If it does not work even with the right irpf90 flags, clean and'
print*,'recompile your code at ${QP_ROOT}'
print*,'==================================================================='
print*,''
endif
end

115
src/fci/test_intel_check_omp.irp.f
View File

@ -1,115 +0,0 @@
program test_intel_check_omp
use omp_lib
implicit none
integer :: i,j,k,l,m,n,x
double precision :: w1,w2,c1,c2
double precision, allocatable :: accu(:,:,:,:)
x = 4
allocate(accu(x,x,x,x))
accu = 0d0
!$OMP PARALLEL
print*, 'Hello1 from:', OMP_GET_THREAD_NUM()
!$OMP END PARALLEL
print*,'omp_get_max_active_levels:',omp_get_max_active_levels()
call intel_check_omp()
print*,'omp_get_max_active_levels:',omp_get_max_active_levels()
!call omp_set_max_active_levels(20000)
!$OMP PARALLEL
print*, 'Hello2 from:', OMP_GET_THREAD_NUM()
!$OMP END PARALLEL
call wall_time(w1)
call cpu_time(c1)
!$OMP PARALLEL &
!$OMP PRIVATE(i,j,k,l,m,n) &
!$OMP SHARED(accu)
print*,'level 1',omp_get_num_threads()
!$OMP DO
do l = 1, x
do k = 1, x
do j = 1, x
do i = 1, x
accu(i,j,k,l) = accu(i,j,k,l) + 1d0
enddo
enddo
enddo
enddo
!$OMP END DO
!$OMP PARALLEL &
!$OMP PRIVATE(i,j,k,l,m,n) &
!$OMP SHARED(accu)
print*,'level 2',omp_get_num_threads()
!$OMP DO
do l = 1, x
do k = 1, x
do j = 1, x
do i = 1, x
accu(i,j,k,l) = accu(i,j,k,l)+ 1d0
enddo
enddo
enddo
enddo
!$OMP END DO
!$OMP PARALLEL &
!$OMP PRIVATE(i,j,k,l,m,n) &
!$OMP SHARED(accu)
print*,'level 3',omp_get_num_threads()
!$OMP DO
do l = 1, x
do k = 1, x
do j = 1, x
do i = 1, x
accu(i,j,k,l) = accu(i,j,k,l)+ 1d0
enddo
enddo
enddo
enddo
!$OMP END DO
!$OMP PARALLEL &
!$OMP PRIVATE(i,j,k,l,m,n) &
!$OMP SHARED(accu)
print*,'level 4',omp_get_num_threads()
!$OMP DO
do l = 1, x
do k = 1, x
do j = 1, x
do i = 1, x
accu(i,j,k,l) = accu(i,j,k,l)+ 1d0
enddo
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
!$OMP END PARALLEL
!$OMP END PARALLEL
!$OMP END PARALLEL
call wall_time(w2)
call cpu_time(c2)
print*,accu(1,1,1,1)
print*,'wall time:', w2-w1
print*,'cpu time:', c2-c1
print*,'ration',(c2-c1)/(w2-w1)
end

20
src/utils/intel_check_omp.irp.f
View File

@ -1,20 +0,0 @@
subroutine intel_check_omp()
! Doc : idk
implicit none
IRP_IF INTEL2021_CHECK_OMP
call omp_set_max_active_levels(5)
print*,'INTEL2021_CHECK_OMP: true'
IRP_ENDIF
IRP_IF INTEL2019_CHECK_OMP
call omp_set_nested(.True.)
print*,'INTEL2019_CHECK_OMP: true'
IRP_ENDIF
IRP_IF GNU_CHECK_OMP
call omp_set_nested(.True.)
print*,'GNU_CHECK_OMP: true'
IRP_ENDIF
end

16
src/utils/test_set_multiple_levels_omp.irp.f Normal file
View File

@ -0,0 +1,16 @@
subroutine test_set_multiple_levels_omp()
! Doc : idk
implicit none
IRP_IF SET_MAX_ACT
print*,'SET_MAX_ACT: True, call omp_set_max_active_levels(5)'
call omp_set_max_active_levels(5)
IRP_ENDIF
IRP_IF SET_NESTED
print*,'SET_NESTED: True, call omp_set_nested(.True.)'
call omp_set_nested(.True.)
IRP_ENDIF
end