From 9a439a25ac035a4c6d6d5039f56f426cc480aee9 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 2 Oct 2014 01:06:13 +0200 Subject: [PATCH] Added progress bar --- scripts/generate_h_apply.py | 2 + src/BiInts/ao_bi_integrals.irp.f | 9 +++- src/BiInts/mo_bi_integrals.irp.f | 12 ++++- src/Dets/H_apply_template.f | 9 ++++ src/Utils/progress.irp.f | 79 ++++++++++++++++++++++++++++++++ 5 files changed, 108 insertions(+), 3 deletions(-) create mode 100644 src/Utils/progress.irp.f diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index 36338026..1b7e816c 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -197,6 +197,7 @@ class H_apply(object): wall_1-wall_0 pt2_old(k) = pt2(k) enddo + progress_value = norm_psi(1) """ self.data["omp_parallel"] += """& !$OMP SHARED(N_st) PRIVATE(e_2_pert_buffer,coef_pert_buffer) & @@ -238,6 +239,7 @@ class H_apply(object): norm_psi(k) = norm_psi(k) + psi_coef(i_generator,k)*psi_coef(i_generator,k) delta_pt2(k) = 0.d0 pt2_old(k) = 0.d0 + pt2(k) = select_max(i_generator) enddo !$ call omp_unset_lock(lck) cycle diff --git a/src/BiInts/ao_bi_integrals.irp.f b/src/BiInts/ao_bi_integrals.irp.f index 3756bac5..c28e1c30 100644 --- a/src/BiInts/ao_bi_integrals.irp.f +++ b/src/BiInts/ao_bi_integrals.irp.f @@ -379,12 +379,14 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] enddo PROVIDE ao_nucl + PROVIDE progress_bar 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) + call start_progress(lmax,'AO integrals (MB)',0.d0) !$OMP PARALLEL PRIVATE(i,j,k,l,kk, & !$OMP integral,buffer_i,buffer_value,n_integrals, & !$OMP cpu_2,wall_2,i1,j1,thread_num) & @@ -392,7 +394,7 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] !$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,abort_here, & - !$OMP wall_0) + !$OMP wall_0,progress_bar,progress_value) allocate(buffer_i(size_buffer)) allocate(buffer_value(size_buffer)) @@ -409,6 +411,9 @@ IRP_ENDIF if (abort_here) then cycle endif + if (thread_num == 0) then + progress_bar(1) = kk + endif j = jl_pairs(1,kk) l = jl_pairs(2,kk) j1 = j+ishft(l*l-l,-1) @@ -457,6 +462,7 @@ IRP_ENDIF wall_0 = wall_2 write(output_BiInts,*) 100.*float(kk)/float(lmax), '% in ', & wall_2-wall_1, 's', map_mb(ao_integrals_map) ,'MB' + progress_value = dble(map_mb(ao_integrals_map)) endif endif enddo @@ -466,6 +472,7 @@ IRP_ENDIF deallocate(buffer_value) !$OMP END PARALLEL call omp_destroy_lock(lock) + call stop_progress if (abort_here) then stop 'Aborting in AO integrals calculation' endif diff --git a/src/BiInts/mo_bi_integrals.irp.f b/src/BiInts/mo_bi_integrals.irp.f index 39a56977..0d63d5a6 100644 --- a/src/BiInts/mo_bi_integrals.irp.f +++ b/src/BiInts/mo_bi_integrals.irp.f @@ -90,6 +90,8 @@ subroutine add_integrals_to_map(mask_ijkl) call wall_time(wall_1) call cpu_time(cpu_1) + PROVIDE progress_bar + call start_progress(ao_num,'MO integrals (MB)',0.d0) !$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,& @@ -100,7 +102,7 @@ subroutine add_integrals_to_map(mask_ijkl) !$OMP mo_coef_transp,output_BiInts, & !$OMP mo_coef_transp_is_built, list_ijkl, & !$OMP mo_coef_is_built, wall_1, abort_here, & - !$OMP mo_coef,mo_integrals_threshold,ao_integrals_map,mo_integrals_map) + !$OMP mo_coef,mo_integrals_threshold,ao_integrals_map,mo_integrals_map,progress_bar,progress_value) n_integrals = 0 allocate(bielec_tmp_3(mo_tot_num_align, n_j, n_k), & bielec_tmp_1(mo_tot_num_align), & @@ -113,6 +115,9 @@ subroutine add_integrals_to_map(mask_ijkl) !$ thread_num = omp_get_thread_num() !$OMP DO SCHEDULE(guided) do l1 = 1,ao_num + if (thread_num == 0) then + progress_bar(1) = l1 + endif IRP_IF COARRAY if (mod(l1-this_image(),num_images()) /= 0 ) then cycle @@ -268,7 +273,9 @@ IRP_ENDIF 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' + wall_2-wall_1, 's', map_mb(mo_integrals_map) ,'MB' + progress_value = dble(map_mb(mo_integrals_map)) + endif endif enddo @@ -279,6 +286,7 @@ IRP_ENDIF real(mo_integrals_threshold,integral_kind)) deallocate(buffer_i, buffer_value) !$OMP END PARALLEL + call stop_progress if (abort_here) then stop 'Aborting in MO integrals calculation' endif diff --git a/src/Dets/H_apply_template.f b/src/Dets/H_apply_template.f index f70f69bf..07c45891 100644 --- a/src/Dets/H_apply_template.f +++ b/src/Dets/H_apply_template.f @@ -387,6 +387,9 @@ subroutine $subroutine($params_main) call wall_time(wall_1) + PROVIDE progress_bar + call start_progress(N_det_generators,'Selection (norm)',0.d0) + !$ call omp_init_lock(lck) !$OMP PARALLEL DEFAULT(SHARED) & !$OMP PRIVATE(i_generator,wall_2,ispin,k,mask,iproc) @@ -395,6 +398,9 @@ subroutine $subroutine($params_main) allocate( mask(N_int,2,6) ) !$OMP DO SCHEDULE(dynamic,4) do i_generator=1,nmax + if (iproc == 0) then + progress_bar(1) = i_generator + endif if (abort_here) then cycle endif @@ -449,10 +455,12 @@ subroutine $subroutine($params_main) !$OMP END PARALLEL !$ call omp_destroy_lock(lck) + 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 @@ -500,6 +508,7 @@ subroutine $subroutine($params_main) $printout_now endif enddo + call stop_progress $copy_buffer $generate_psi_guess diff --git a/src/Utils/progress.irp.f b/src/Utils/progress.irp.f new file mode 100644 index 00000000..bdbdae0b --- /dev/null +++ b/src/Utils/progress.irp.f @@ -0,0 +1,79 @@ +subroutine start_progress(max,title,progress_init) + implicit none + integer, intent(in) :: max + double precision, intent(in) :: progress_init + character*(*), intent(in) :: title + BEGIN_DOC +! Starts the progress bar + END_DOC + + progress_bar(1) = 0 + progress_bar(2) = max + progress_title = title + progress_active = .True. + progress_value = progress_init + call run_progress() + +end + +subroutine stop_progress + implicit none + BEGIN_DOC +! Stop the progress bar + END_DOC + progress_active = .False. +end + + BEGIN_PROVIDER [ real, progress_bar, (2) ] +&BEGIN_PROVIDER [ integer, progress_timeout ] +&BEGIN_PROVIDER [ logical, progress_active ] +&BEGIN_PROVIDER [ double precision, progress_value ] +&BEGIN_PROVIDER [ character*(20) , progress_title ] + implicit none + BEGIN_DOC + ! Current status for displaying progress bars. Global variable. + END_DOC + progress_bar = 0 + progress_value = 0.d0 + progress_title = '' + progress_active = .False. + progress_timeout = 1 + open (unit=0, carriagecontrol='fortran') + +END_PROVIDER + +recursive subroutine run_progress + use ifport + implicit none + BEGIN_DOC +! Display a progress bar with documentation of what is happening + END_DOC + character(75), parameter :: bar0= & + ' --- : --- | | ---%' + character(75) :: bar + integer :: prog + + + bar = bar0 + if (.not.progress_active) then + call stop_progress + write(unit=0,fmt="(a1,a1,a70)") '+',char(13), bar + else + prog = int( progress_bar(1)*100./progress_bar(2) ) + write(bar(1:25),'(A)'),progress_title + write(bar(29:47),'(G17.10)'),progress_value + write(bar(72:74),'(i3)') prog + + integer :: k,j + j = int( progress_bar(1)*20./progress_bar(2) ) + do k=1, j + bar(49+k:49+k)="=" + enddo + write(unit=0,fmt="(a1,a1,a75)") '+',char(13), bar + integer :: istat + istat = alarm(progress_timeout,run_progress) + endif + +end + +