From 9af8b74f4acbefc26ec51f2a6b7a63abe1454ec0 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 26 May 2014 22:40:42 +0200 Subject: [PATCH] Add the possibility to abort cleanly a running Davidson or integrals --- src/BiInts/ao_bi_integrals.irp.f | 26 +++++++++++--- src/BiInts/mo_bi_integrals.irp.f | 38 +++++++++++++++------ src/Dets/H_apply_template.f | 25 +++++++++++--- src/Dets/davidson.irp.f | 9 +++-- src/Perturbation/cisd_selection.irp.f | 3 ++ src/Utils/README.rst | 28 +++++++-------- src/Utils/abort.irp.f | 49 +++++++++++++++++++++++++++ src/Utils/util.irp.f | 9 +++-- 8 files changed, 147 insertions(+), 40 deletions(-) create mode 100644 src/Utils/abort.irp.f diff --git a/src/BiInts/ao_bi_integrals.irp.f b/src/BiInts/ao_bi_integrals.irp.f index c9beb9c3..01bab63d 100644 --- a/src/BiInts/ao_bi_integrals.irp.f +++ b/src/BiInts/ao_bi_integrals.irp.f @@ -196,7 +196,7 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] integer :: i,j,k,l double precision :: ao_bielec_integral,cpu_1,cpu_2, wall_1, wall_2 - double precision :: integral + double precision :: integral, wall_0 double precision :: thresh thresh = ao_integrals_threshold @@ -206,7 +206,7 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] real(integral_kind),allocatable :: buffer_value(:) integer(omp_lock_kind) :: lock - integer :: n_integrals, n_centers + integer :: n_integrals, n_centers, thread_num integer :: jl_pairs(2,ao_num*(ao_num+1)/2), kk, m, j1, i1, lmax PROVIDE gauleg_t2 ao_integrals_map all_utils @@ -235,22 +235,28 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] call omp_init_lock(lock) lmax = ao_num*(ao_num+1)/2 write(output_BiInts,*) 'providing the AO integrals' + call wall_time(wall_0) call wall_time(wall_1) call cpu_time(cpu_1) !$OMP PARALLEL PRIVATE(i,j,k,l,kk, & !$OMP integral,buffer_i,buffer_value,n_integrals, & - !$OMP cpu_2,wall_2,i1,j1) & + !$OMP cpu_2,wall_2,i1,j1,thread_num) & !$OMP DEFAULT(NONE) & !$OMP SHARED (ao_num, jl_pairs, ao_integrals_map,thresh, & !$OMP cpu_1,wall_1,lock, lmax,n_centers,ao_nucl, & - !$OMP ao_overlap_abs,ao_overlap,output_BiInts) + !$OMP ao_overlap_abs,ao_overlap,output_BiInts,abort_here, & + !$OMP wall_0) allocate(buffer_i(size_buffer)) allocate(buffer_value(size_buffer)) n_integrals = 0 +!$ thread_num = omp_get_thread_num() !$OMP DO SCHEDULE(dynamic) do kk=1,lmax + if (abort_here) then + cycle + endif j = jl_pairs(1,kk) l = jl_pairs(2,kk) j1 = j+ishft(l*l-l,-1) @@ -293,7 +299,14 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] enddo enddo call wall_time(wall_2) - write(output_BiInts,*) 100.*float(kk)/float(lmax), '% in ', wall_2-wall_1, 's' + + if (thread_num == 0) then + if (wall_2 - wall_0 > 1.d0) then + wall_0 = wall_2 + write(output_BiInts,*) 100.*float(kk)/float(lmax), '% in ', & + wall_2-wall_1, 's', map_mb(ao_integrals_map) ,'MB' + endif + endif enddo !$OMP END DO NOWAIT call insert_into_ao_integrals_map(n_integrals,buffer_i,buffer_value) @@ -301,6 +314,9 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] deallocate(buffer_value) !$OMP END PARALLEL call omp_destroy_lock(lock) + if (abort_here) then + stop 'Aborting in AO integrals calculation' + endif write(output_BiInts,*) 'Sorting the map' call map_sort(ao_integrals_map) call cpu_time(cpu_2) diff --git a/src/BiInts/mo_bi_integrals.irp.f b/src/BiInts/mo_bi_integrals.irp.f index b781e39a..e7ffde60 100644 --- a/src/BiInts/mo_bi_integrals.irp.f +++ b/src/BiInts/mo_bi_integrals.irp.f @@ -49,7 +49,7 @@ subroutine add_integrals_to_map(mask_ijkl) integer :: i,j,k,l integer :: i0,j0,k0,l0 - double precision :: c, cpu_1, cpu_2, wall_1, wall_2 + double precision :: c, cpu_1, cpu_2, wall_1, wall_2, wall_0 integer, allocatable :: list_ijkl(:,:) integer :: n_i, n_j, n_k, n_l @@ -66,7 +66,7 @@ subroutine add_integrals_to_map(mask_ijkl) real(integral_kind),allocatable :: buffer_value(:) real :: map_mb - integer :: i1,j1,k1,l1, ii1, kmax, l1_global + integer :: i1,j1,k1,l1, ii1, kmax, thread_num integer :: i2,i3,i4 double precision,parameter :: thr_coef = 0.d0 @@ -81,7 +81,6 @@ subroutine add_integrals_to_map(mask_ijkl) call bitstring_to_list( mask_ijkl(1,3), list_ijkl(1,3), n_k, N_int ) call bitstring_to_list( mask_ijkl(1,4), list_ijkl(1,4), n_l, N_int ) - l1_global = 0 size_buffer = min(ao_num*ao_num*ao_num,16000000) write(output_BiInts,*) 'Providing the molecular integrals ' write(output_BiInts,*) 'Buffers : ', 8.*(mo_tot_num_align*(n_j)*(n_k+1) + mo_tot_num_align +& @@ -93,13 +92,14 @@ subroutine add_integrals_to_map(mask_ijkl) !$OMP PARALLEL PRIVATE(l1,k1,j1,i1,i2,i3,i4,i,j,k,l,c, ii1,kmax, & !$OMP bielec_tmp_0_idx, bielec_tmp_0, bielec_tmp_1,bielec_tmp_2,bielec_tmp_3,& - !$OMP buffer_i,buffer_value,n_integrals,wall_2,i0,j0,k0,l0) & + !$OMP buffer_i,buffer_value,n_integrals,wall_2,i0,j0,k0,l0, & + !$OMP wall_0,thread_num) & !$OMP DEFAULT(NONE) & !$OMP SHARED(size_buffer,ao_num,mo_tot_num,n_i,n_j,n_k,n_l,mo_tot_num_align,& !$OMP mo_coef_transp,output_BiInts, & !$OMP mo_coef_transp_is_built, list_ijkl, & - !$OMP mo_coef_is_built, wall_1, & - !$OMP mo_coef,mo_integrals_threshold,l1_global,ao_integrals_map,mo_integrals_map) + !$OMP mo_coef_is_built, wall_1, abort_here, & + !$OMP mo_coef,mo_integrals_threshold,ao_integrals_map,mo_integrals_map) n_integrals = 0 allocate(bielec_tmp_3(mo_tot_num_align, n_j, n_k), & bielec_tmp_1(mo_tot_num_align), & @@ -109,8 +109,12 @@ subroutine add_integrals_to_map(mask_ijkl) buffer_i(size_buffer), & buffer_value(size_buffer) ) +!$ thread_num = omp_get_thread_num() !$OMP DO SCHEDULE(guided) do l1 = 1,ao_num + if (abort_here) then + cycle + endif !DEC$ VECTOR ALIGNED bielec_tmp_3 = 0.d0 do k1 = 1,ao_num @@ -253,11 +257,14 @@ subroutine add_integrals_to_map(mask_ijkl) enddo enddo - !$OMP ATOMIC - l1_global +=1 call wall_time(wall_2) - write(output_BiInts,*) 100.*float(l1_global)/float(ao_num), '% in ',& - wall_2-wall_1, 's', map_mb(mo_integrals_map) ,'MB' + if (thread_num == 0) then + if (wall_2 - wall_0 > 1.d0) then + wall_0 = wall_2 + write(output_BiInts,*) 100.*float(l1)/float(ao_num), '% in ', & + wall_2-wall_1, 's', map_mb(ao_integrals_map) ,'MB' + endif + endif enddo !$OMP END DO NOWAIT deallocate (bielec_tmp_1,bielec_tmp_2,bielec_tmp_3) @@ -266,6 +273,9 @@ subroutine add_integrals_to_map(mask_ijkl) real(mo_integrals_threshold,integral_kind)) deallocate(buffer_i, buffer_value) !$OMP END PARALLEL + if (abort_here) then + stop 'Aborting in MO integrals calculation' + endif call map_unique(mo_integrals_map) call wall_time(wall_2) @@ -327,7 +337,7 @@ end !$OMP PRIVATE (i,j,p,q,r,s,integral,c,n,pp,int_value,int_idx, & !$OMP iqrs, iqsr,iqri,iqis) & !$OMP SHARED(mo_tot_num,mo_coef_transp,mo_tot_num_align,ao_num,& - !$OMP ao_integrals_threshold,do_direct_integrals) & + !$OMP ao_integrals_threshold,do_direct_integrals,abort_here) & !$OMP REDUCTION(+:mo_bielec_integral_jj,mo_bielec_integral_jj_exchange) allocate( int_value(ao_num), int_idx(ao_num), & @@ -336,6 +346,9 @@ end !$OMP DO SCHEDULE (guided) do s=1,ao_num + if (abort_here) then + cycle + endif do q=1,ao_num do j=1,ao_num @@ -421,6 +434,9 @@ end !$OMP END DO NOWAIT deallocate(iqrs,iqsr,int_value,int_idx) !$OMP END PARALLEL + if (abort_here) then + stop 'Aborting in MO integrals calculation' + endif mo_bielec_integral_jj_anti = mo_bielec_integral_jj - mo_bielec_integral_jj_exchange diff --git a/src/Dets/H_apply_template.f b/src/Dets/H_apply_template.f index 855e526e..359ba4fb 100644 --- a/src/Dets/H_apply_template.f +++ b/src/Dets/H_apply_template.f @@ -89,8 +89,14 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2 $parame accu = 0.d0 do ispin=1,2 other_spin = iand(ispin,1)+1 + if (abort_here) then + exit + endif $omp_do do ii=1,ia_ja_pairs(1,0,ispin) + if (abort_here) then + cycle + endif i_a = ia_ja_pairs(1,ii,ispin) ASSERT (i_a > 0) ASSERT (i_a <= mo_tot_num) @@ -152,6 +158,9 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2 $parame endif ! endif enddo + if (abort_here) then + exit + endif enddo endif ! does all the mono excitations of the same spin @@ -186,7 +195,9 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2 $parame $keys_work key_idx = 0 endif - ! endif + if (abort_here) then + exit + endif enddo enddo! kk enddo ! ii @@ -196,7 +207,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2 $parame deallocate (keys_out,ia_ja_pairs) $omp_end_parallel $finalization - + abort_here = abort_all end subroutine $subroutine_monoexc(key_in, hole_1,particl_1 $parameters ) @@ -315,25 +326,29 @@ subroutine $subroutine($params_main) END_DOC $decls_main - + PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map N_det_reference psi_generators integer :: imask do imask=1,N_det_generators - call $subroutine_monoexc(psi_generators(1,1,imask), & + call $subroutine_monoexc(psi_generators(1,1,imask), & generators_bitmask(1,1,s_hole ,i_bitmask_gen), & generators_bitmask(1,1,s_part ,i_bitmask_gen) & $params_post) - call $subroutine_diexc(psi_generators(1,1,imask), & + call $subroutine_diexc(psi_generators(1,1,imask), & generators_bitmask(1,1,d_hole1,i_bitmask_gen), & generators_bitmask(1,1,d_part1,i_bitmask_gen), & generators_bitmask(1,1,d_hole2,i_bitmask_gen), & generators_bitmask(1,1,d_part2,i_bitmask_gen) & $params_post) + if (abort_here) then + exit + endif enddo $copy_buffer $generate_psi_guess + abort_here = abort_all end diff --git a/src/Dets/davidson.irp.f b/src/Dets/davidson.irp.f index ab0aeac3..017b922f 100644 --- a/src/Dets/davidson.irp.f +++ b/src/Dets/davidson.irp.f @@ -1,4 +1,4 @@ -BEGIN_PROVIDER [ integer, davidson_iter_max] +BEGIN_PROVIDER [ integer, davidson_iter_max ] implicit none BEGIN_DOC ! Max number of Davidson iterations @@ -6,7 +6,7 @@ BEGIN_PROVIDER [ integer, davidson_iter_max] davidson_iter_max = 100 END_PROVIDER -BEGIN_PROVIDER [ integer, davidson_sze_max] +BEGIN_PROVIDER [ integer, davidson_sze_max ] implicit none BEGIN_DOC ! Max number of Davidson sizes @@ -322,6 +322,7 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun !END DEBUG enddo + if (.not.converged) then iter = davidson_sze_max-1 endif @@ -340,7 +341,7 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun enddo enddo enddo - + enddo write_buffer = '===== ' @@ -360,6 +361,7 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun y, & lambda & ) + abort_here = abort_all end BEGIN_PROVIDER [ character(64), davidson_criterion ] @@ -397,4 +399,5 @@ subroutine davidson_converged(energy,residual,N_st,converged) else if (davidson_criterion == 'both') then converged = dabs(maxval(residual(1:N_st))) + dabs(maxval(E(1:N_st)) ) < davidson_threshold endif + converged = converged.or.abort_here end diff --git a/src/Perturbation/cisd_selection.irp.f b/src/Perturbation/cisd_selection.irp.f index fa1891e5..b334c0a8 100644 --- a/src/Perturbation/cisd_selection.irp.f +++ b/src/Perturbation/cisd_selection.irp.f @@ -19,6 +19,9 @@ program cisd print *, 'PT2 = ', pt2 print *, 'E = ', E_old print *, 'E+PT2 = ', E_old+pt2 + if (abort_all) then + exit + endif enddo deallocate(pt2,norm_pert) end diff --git a/src/Utils/README.rst b/src/Utils/README.rst index 2eb40829..a93db8dd 100644 --- a/src/Utils/README.rst +++ b/src/Utils/README.rst @@ -124,53 +124,53 @@ Documentation \int_{-infty}^{+infty} (x-A_center)^(power_A) * (x-B_center)^power_B * exp(-alpha(x-A_center)^2) * exp(-beta(x-B_center)^2) dx .br -`align_double `_ +`align_double `_ Compute 1st dimension such that it is aligned for vectorization. `all_utils `_ Dummy provider to provide all utils -`binom `_ +`binom `_ Binomial coefficients -`binom_func `_ +`binom_func `_ .. math :: .br \frac{i!}{j!(i-j)!} .br -`binom_transp `_ +`binom_transp `_ Binomial coefficients -`dble_fact `_ +`dble_fact `_ n!! -`fact `_ +`fact `_ n! -`fact_inv `_ +`fact_inv `_ 1/n! -`inv_int `_ +`inv_int `_ 1/i -`normalize `_ +`normalize `_ Normalizes vector u u is expected to be aligned in memory. -`nproc `_ +`nproc `_ Number of current OpenMP threads -`u_dot_u `_ +`u_dot_u `_ Compute -`u_dot_v `_ +`u_dot_v `_ Compute -`wall_time `_ +`wall_time `_ The equivalent of cpu_time, but for the wall time. -`write_git_log `_ +`write_git_log `_ Write the last git commit in file iunit. diff --git a/src/Utils/abort.irp.f b/src/Utils/abort.irp.f new file mode 100644 index 00000000..30f7bbfe --- /dev/null +++ b/src/Utils/abort.irp.f @@ -0,0 +1,49 @@ +BEGIN_PROVIDER [ logical, abort_all ] + implicit none + BEGIN_DOC + ! If True, all the calculation is aborted + END_DOC + abort_all = .False. + +END_PROVIDER + +BEGIN_PROVIDER [ logical, abort_here ] + implicit none + BEGIN_DOC + ! If True, all the calculation is aborted + END_DOC + abort_here = abort_all +END_PROVIDER + +subroutine trap_signals + use ifport + implicit none + BEGIN_DOC + ! What to do when a signal is caught. Here, trap Ctrl-C and call the control_C subroutine. + END_DOC + integer, external :: control_C + integer :: err, flag + flag = -1 + err = signal (sigint, control_C, flag) + PROVIDE abort_all + PROVIDE abort_here +end subroutine trap_signals + +integer function control_C(signum) + implicit none + integer, intent(in) :: signum + BEGIN_DOC + ! What to do on Ctrl-C. If two Ctrl-C are pressed within 1 sec, the calculation if aborted. + END_DOC + double precision, save :: last_time + double precision :: this_time + control_C = 0 + call wall_time(this_time) + if (this_time - last_time < 1.d0) then + print *, 'Caught Ctrl-C' + abort_all = .True. + endif + last_time = this_time + abort_here = .True. +end subroutine control_C + diff --git a/src/Utils/util.irp.f b/src/Utils/util.irp.f index 4b240a75..b2618a60 100644 --- a/src/Utils/util.irp.f +++ b/src/Utils/util.irp.f @@ -5,11 +5,16 @@ BEGIN_PROVIDER [ logical, all_utils ] END_DOC ! Do not move this : it greps itself BEGIN_SHELL [ /bin/bash ] - for i in $(grep "BEGIN_PROVIDER" $QPACKAGE_ROOT/src/Utils/*.irp.f | cut -d ',' -f 2 | cut -d ']' -f 1 | tail --lines=+3 ) + for i in $(grep "BEGIN_PROVIDER" $QPACKAGE_ROOT/src/Utils/*.irp.f \ + | grep ',' | cut -d ',' -f 2 | cut -d ']' -f 1 | tail --lines=+3 ) do - echo PROVIDE $i + if [[ ! -z $i ]] + then + echo PROVIDE $i + fi done END_SHELL + call trap_signals END_PROVIDER