Added progress bar

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

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

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

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

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
+
+