LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-21 20:52:18 +02:00
Code Issues Releases Wiki Activity

Accelerated openmp selection

Browse Source
This commit is contained in:
Anthony Scemama 2014-10-14 17:30:30 +02:00
parent f18f96e76e
commit 5119450119
2 changed files with 60 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

117
src/Dets/H_apply_template.f
View File

@ -379,11 +379,67 @@ subroutine $subroutine($params_main)
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map
nmax = ( N_det_generators/nproc ) *nproc
nmax = mod( N_det_generators,nproc )
call start_progress(N_det_generators,'Selection (norm)',0.d0)
call wall_time(wall_0)
allocate( mask(N_int,2,6) )
do i_generator=1,nmax
progress_bar(1) = i_generator
if (abort_here) then
exit
endif
$skip
! Create bit masks for holes and particles
do ispin=1,2
do k=1,N_int
mask(k,ispin,s_hole) = &
iand(generators_bitmask(k,ispin,s_hole,i_bitmask_gen), &
psi_generators(k,ispin,i_generator) )
mask(k,ispin,s_part) = &
iand(generators_bitmask(k,ispin,s_part,i_bitmask_gen), &
not(psi_generators(k,ispin,i_generator)) )
mask(k,ispin,d_hole1) = &
iand(generators_bitmask(k,ispin,d_hole1,i_bitmask_gen), &
psi_generators(k,ispin,i_generator) )
mask(k,ispin,d_part1) = &
iand(generators_bitmask(k,ispin,d_part1,i_bitmask_gen), &
not(psi_generators(k,ispin,i_generator)) )
mask(k,ispin,d_hole2) = &
iand(generators_bitmask(k,ispin,d_hole2,i_bitmask_gen), &
psi_generators(k,ispin,i_generator) )
mask(k,ispin,d_part2) = &
iand(generators_bitmask(k,ispin,d_part2,i_bitmask_gen), &
not(psi_generators(k,ispin,i_generator)) )
enddo
enddo
if($do_double_excitations)then
call $subroutine_diexc(psi_generators(1,1,i_generator), &
mask(1,1,d_hole1), mask(1,1,d_part1), &
mask(1,1,d_hole2), mask(1,1,d_part2), &
i_generator, 0 $params_post)
endif
if($do_mono_excitations)then
call $subroutine_monoexc(psi_generators(1,1,i_generator), &
mask(1,1,s_hole ), mask(1,1,s_part ), &
i_generator, 0 $params_post)
endif
call wall_time(wall_1)
$printout_always
if (wall_1 - wall_0 > 2.d0) then
$printout_now
wall_0 = wall_1
endif
enddo
deallocate( mask )
!$ call omp_init_lock(lck)
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP PRIVATE(i_generator,wall_1,wall_0,ispin,k,mask,iproc)
@ -391,8 +447,8 @@ subroutine $subroutine($params_main)
iproc = 0
!$ iproc = omp_get_thread_num()
allocate( mask(N_int,2,6) )
!$OMP DO SCHEDULE(dynamic,4)
do i_generator=1,nmax
!$OMP DO SCHEDULE(dynamic,1)
do i_generator=nmax+1,N_det_generators
if (iproc == 0) then
progress_bar(1) = i_generator
endif
@ -449,67 +505,12 @@ subroutine $subroutine($params_main)
deallocate( mask )
!$OMP END PARALLEL
!$ call omp_destroy_lock(lck)
call wall_time(wall_0)
allocate( mask(N_int,2,6) )
! do i_generator=1,N_det_generators
do i_generator=nmax+1,N_det_generators
progress_bar(1) = i_generator
if (abort_here) then
exit
endif
$skip
! Create bit masks for holes and particles
do ispin=1,2
do k=1,N_int
mask(k,ispin,s_hole) = &
iand(generators_bitmask(k,ispin,s_hole,i_bitmask_gen), &
psi_generators(k,ispin,i_generator) )
mask(k,ispin,s_part) = &
iand(generators_bitmask(k,ispin,s_part,i_bitmask_gen), &
not(psi_generators(k,ispin,i_generator)) )
mask(k,ispin,d_hole1) = &
iand(generators_bitmask(k,ispin,d_hole1,i_bitmask_gen), &
psi_generators(k,ispin,i_generator) )
mask(k,ispin,d_part1) = &
iand(generators_bitmask(k,ispin,d_part1,i_bitmask_gen), &
not(psi_generators(k,ispin,i_generator)) )
mask(k,ispin,d_hole2) = &
iand(generators_bitmask(k,ispin,d_hole2,i_bitmask_gen), &
psi_generators(k,ispin,i_generator) )
mask(k,ispin,d_part2) = &
iand(generators_bitmask(k,ispin,d_part2,i_bitmask_gen), &
not(psi_generators(k,ispin,i_generator)) )
enddo
enddo
if($do_double_excitations)then
call $subroutine_diexc(psi_generators(1,1,i_generator), &
mask(1,1,d_hole1), mask(1,1,d_part1), &
mask(1,1,d_hole2), mask(1,1,d_part2), &
i_generator, 0 $params_post)
endif
if($do_mono_excitations)then
call $subroutine_monoexc(psi_generators(1,1,i_generator), &
mask(1,1,s_hole ), mask(1,1,s_part ), &
i_generator, 0 $params_post)
endif
call wall_time(wall_1)
$printout_always
if (wall_1 - wall_0 > 2.d0) then
$printout_now
wall_0 = wall_1
endif
enddo
call stop_progress
$copy_buffer
$generate_psi_guess
abort_here = abort_all
deallocate( mask )
end

3
src/Utils/abort.irp.f
View File

@ -3,6 +3,7 @@ BEGIN_PROVIDER [ logical, abort_all ]
BEGIN_DOC
! If True, all the calculation is aborted
END_DOC
call trap_signals
abort_all = .False.
END_PROVIDER
@ -26,8 +27,6 @@ subroutine trap_signals
integer, parameter :: sigusr2 = 12
flag = -1
err = signal (sigusr2, catch_signal, flag)
PROVIDE abort_all
PROVIDE abort_here
end subroutine trap_signals
integer function catch_signal(signum)