Fix print statements and remove unnecessary code

src/calce0.f90

@@ -30,7 +30,7 @@ SUBROUTINE calce0(e0)
     e0 = 0.0d+00
     dr = 0.0d+00
     di = 0.0d+00
-    if (rank == 0) print *, iroot, 'iroot'
+    if (rank == 0) print *, 'selectroot = ', selectroot
     Do i = 1, nact
 
         If (realonly%is_realonly()) then
@@ -45,6 +45,5 @@ SUBROUTINE calce0(e0)
 
     if (rank == 0) then
         print *, 'e0 = Siguma_w(w:active) eps(w)Dww is ', e0
-        print *, 'end'
     end if
 end subroutine calce0

src/casci.f90

@@ -30,11 +30,9 @@ SUBROUTINE casci
     ! Create a matrix for CI
     if (realonly%is_realonly()) then
         allocate (mat_real(ndet, ndet)); Call memplus(KIND(mat_real), SIZE(mat_real), 1)
-        if (rank == 0) print *, "end allocate mat_real(ndet,ndet)"
         Call casmat_real(mat_real)
     else
         Allocate (mat_complex(ndet, ndet)); Call memplus(KIND(mat_complex), SIZE(mat_complex), 2)
-        if (rank == 0) print *, "end allocate mat_complex(ndet,ndet)"
         Call casmat_complex(mat_complex)
     end if
     Allocate (ecas(ndet))

src/casmat.f90

@@ -31,7 +31,6 @@ SUBROUTINE casmat_complex(mat)
     if (rank == 0) print *, 'Cas mat enter'
     Allocate (oc(nelec))
     Allocate (vi(nact - nelec))
-    if (rank == 0) print *, 'allocated oc and vi'
     ! MPI parallelization (Distributed loop: static scheduling, per nprocs)
     Do i = rank + 1, ndet, nprocs
 
@@ -214,12 +213,10 @@ SUBROUTINE casmat_complex(mat)
 
     Deallocate (oc)
     Deallocate (vi)
-    if (rank == 0) print *, 'end casmat_complex'
 #ifdef HAVE_MPI
-    if (rank == 0) print *, 'Reduce mat(:,:)'
     call allreduce_wrapper(mat=mat)
-    if (rank == 0) print *, 'end allreduce mat(:,:)'
 #endif
+    if (rank == 0) print *, 'end casmat_complex'
 end subroutine casmat_complex
 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
@@ -253,7 +250,6 @@ SUBROUTINE casmat_real(mat)
     if (rank == 0) print *, 'Cas mat enter'
     Allocate (oc(nelec))
     Allocate (vi(nact - nelec))
-    if (rank == 0) print *, 'allocated oc and vi'
     ! MPI parallelization (Distributed loop: static scheduling, per nprocs)
     Do i = rank + 1, ndet, nprocs
 
@@ -412,10 +408,8 @@ SUBROUTINE casmat_real(mat)
 
     Deallocate (oc)
     Deallocate (vi)
-    if (rank == 0) print *, 'end casmat_real'
 #ifdef HAVE_MPI
-    if (rank == 0) print *, 'Allreduce mat(:,:)'
     call allreduce_wrapper(mat=mat)
-    if (rank == 0) print *, 'end allreduce mat(:,:)'
 #endif
+    if (rank == 0) print *, 'end casmat_real'
 end subroutine casmat_real

src/create_newmdcint.f90

@@ -28,6 +28,7 @@ Subroutine create_newmdcint ! 2 Electorn Integrals In Mdcint
     integer :: unit_mdcint, unit_mdcintnew
     logical :: is_file_exist, is_end_of_file
 
+    if (rank == 0) print *, 'Start create_newmdcint'
     Allocate (kr(-nmo/2:nmo/2))
     kr = 0
     ! Get datex, timex, nkr, and kr from MDCINT becasuse there is no kr information in the MDCINXXX files.
@@ -130,7 +131,6 @@ Subroutine create_newmdcint ! 2 Electorn Integrals In Mdcint
 !           lkr = llkr
 
             if (ikr == 0) then
-                if (rank == 0) print *, ikr, jkr, nz, mdcint_debug
                 exit mdcint_file_read ! End of file
             end if
 
@@ -223,7 +223,7 @@ Subroutine create_newmdcint ! 2 Electorn Integrals In Mdcint
     deallocate (rklr)
     if (allocated(rkli)) deallocate (rkli)
 
-    if (rank == 0) print *, 'end create_binmdcint.'
+    if (rank == 0) print *, 'End create_newmdcint'
     deallocate (kr)
 contains
     logical function should_write_2int_to_disk()

src/cutoff.f90

@@ -19,7 +19,7 @@ SUBROUTINE rcutoff(sr, w, dimn, dimm, threshold, ur, wnew)
     real(8), intent(out)  :: ur(dimn, dimm), wnew(dimm)
     integer :: j0, i0
 
-    print *, 'New dimension becomes ', dimm
+    if (rank == 0) print *, 'New dimension becomes ', dimm
 
     j0 = 0
     do i0 = 1, dimn
@@ -30,12 +30,6 @@ SUBROUTINE rcutoff(sr, w, dimn, dimm, threshold, ur, wnew)
         end if
     end do
 
-    print *, 'Eigenvalue and eigen vector becomes'
-    do i0 = 1, dimm
-        print *, i0, 'th state'
-        print *, wnew(i0)
-    end do
-
 end subroutine rcutoff
 
 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=

src/diag.f90

@@ -90,8 +90,6 @@ SUBROUTINE cdiag(c, dimn, dimm, w, cutoff_threshold)
     complex*16, allocatable  ::  work(:)
     real(8), allocatable      ::  rwork(:)
 
-    if (rank == 0) print *, 'Enter cdiagonal part'
-
     ! Prepare for diagonalization
     w(:) = 0.0d+00
     jobz = 'V' ! calculate eigenvectors
@@ -114,7 +112,6 @@ SUBROUTINE cdiag(c, dimn, dimm, w, cutoff_threshold)
     deallocate (rwork)
 
     ! Error check
-    if (rank == 0) print *, 'Finish zheev info = ', info
     if (info /= 0) then
         if (rank == 0) print *, 'error in diagonalization, info = ', info
         call stop_with_errorcode(info)
@@ -128,7 +125,6 @@ SUBROUTINE cdiag(c, dimn, dimm, w, cutoff_threshold)
         dimm = count(w(1:dimn) >= cutoff_threshold)
     end if
 
-    if (rank == 0) print *, "end cdiag"
 end subroutine cdiag
 
 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
@@ -171,15 +167,12 @@ SUBROUTINE rdiag0(n, n0, n1, fa, w)
 
     ncount(:) = 0
 
-    if (rank == 0) print *, 'nsymrpa', nsymrpa
-
     Do i = n0, n1
         isym = irpamo(i)
         ncount(isym) = ncount(isym) + 1
         ind(ncount(isym), isym) = i
     End do
 
-    if (rank == 0) print *, 'isym,ncount(isym)', (ncount(isym), isym=1, nsymrpa)
     Do isym = 1, nsymrpa
 
         dimn = ncount(isym)
@@ -210,7 +203,7 @@ SUBROUTINE rdiag0(n, n0, n1, fa, w)
     mat = MATMUL(mat, fa)
 
     if (rank == 0) then
-        print *, 'OFF DIAGONAL TERM OF U*FU'
+        print *, 'OFF DIAGONAL TERM OF U*FU (print only abs(diff) > 1.0d-10)'
         do j = n0, n1
             do i = n0, n1
                 if (i /= j .and. (ABS(mat(i, j)) > 1.0d-10)) then
@@ -219,9 +212,11 @@ SUBROUTINE rdiag0(n, n0, n1, fa, w)
             end do
         end do
 
-        print *, 'DIAGONAL TERM OF U*FU, W AND THEIR DIFFERENCE'
+        print *, 'DIAGONAL TERM OF U*FU, W AND THEIR DIFFERENCE (print only abs(diff) > 1.0d-10)'
         do i = n0, n1
-            print '(4E13.5)', mat(i, i), w(i), ABS(mat(i, i) - w(i))
+            if (ABS(mat(i, i) - w(i)) > 1.0d-10) then
+                print '(3E13.5)', mat(i, i), w(i), ABS(mat(i, i) - w(i))
+            end if
         end do
     end if
     deallocate (mat)
@@ -358,15 +353,15 @@ SUBROUTINE cdiag0(n, n0, n1, fac, wc)
 
     ! Check U*FU
     if (rank == 0) then
-        print *, 'OFF DIAGONAL TERM OF U*FU'
+        print *, 'OFF DIAGONAL TERM OF U*FU (print only abs(diff) > 1.0d-10)'
         do j = n0, n1
             do i = n0, n1
                 if ((i /= j) .and. (ABS(matc(i, j)) > 1.0d-10)) then
                     print '(2E13.5,2I3)', matc(i, j), i, j
                 end if
             end do
         end do
-        print *, 'DIAGONAL TERM OF U*FU, W AND THEIR DIFFERENCE'
+        print *, 'DIAGONAL TERM OF U*FU, W AND THEIR DIFFERENCE (print only abs(diff) > 1.0d-10)'
         do i = n0, n1
             if (ABS(matc(i, i) - wc(i)) > 1.0d-10) then
                 print '(4E13.5)', matc(i, i), wc(i), ABS(matc(i, i) - wc(i))

src/fockcasci.f90

@@ -29,7 +29,6 @@ SUBROUTINE fockcasci_complex ! TO MAKE FOCK MATRIX for CASCI state
     dr = 0.0d+00; di = 0.0d+00; dens = 0.0d+00
     fock_cmplx(:, :) = 0.0d+00
 
-    if (rank == 0) print *, 'enter building fock matrix'
 !$OMP parallel private(i,j,k,l,dr,di,dens,kact,lact)
 !$OMP do schedule(dynamic,2)
     do i = rank + 1, global_act_end, nprocs ! MPI parallelization (Distributed loop: static scheduling, per nprocs)
@@ -82,7 +81,6 @@ SUBROUTINE fockcasci_complex ! TO MAKE FOCK MATRIX for CASCI state
     end do
 !$OMP end do
 !$OMP end parallel
-    if (rank == 0) print *, 'fockcasci_complex before fock_cmplx allreduce'
 #ifdef HAVE_MPI
     call allreduce_wrapper(mat=fock_cmplx(1:nmo, 1:nmo))
 #endif
@@ -119,7 +117,6 @@ SUBROUTINE fockcasci_real ! TO MAKE FOCK MATRIX for CASCI state
     dr = 0.0d+00
     fock_real(:, :) = 0.0d+00
 
-    if (rank == 0) print *, 'enter building fock matrix'
 !$OMP parallel private(i,j,k,l,dr,kact,lact)
 !$OMP do schedule(dynamic,2)
     do i = rank + 1, global_act_end, nprocs ! MPI parallelization (Distributed loop: static scheduling, per nprocs)
@@ -171,7 +168,6 @@ SUBROUTINE fockcasci_real ! TO MAKE FOCK MATRIX for CASCI state
     end do
 !$OMP end do
 !$OMP end parallel
-    if (rank == 0) print *, 'fockcasci_real before fock_real allreduce'
 #ifdef HAVE_MPI
     call allreduce_wrapper(mat=fock_real(1:nmo, 1:nmo))
 #endif

src/get_filename.f90

@@ -1,6 +1,6 @@
 subroutine get_mdcint_filename(count)
     ! This subroutine is to get the filename of MDCINT.
-    use module_global_variables, only: rank, nprocs, mdcint_filename, mdcintnew, mdcint_debug, mdcint_int, len_convert_int_to_chr
+    use module_global_variables, only: rank, nprocs, mdcint_filename, mdcintnew, len_convert_int_to_chr
     use module_error, only: stop_with_errorcode
     implicit none
     integer, intent(in)         :: count
@@ -11,8 +11,6 @@ subroutine get_mdcint_filename(count)
     if (rank == 0 .and. count == 0) then
         mdcint_filename = "MDCINT"
         mdcintnew = "MDCINTNEW"
-        mdcint_debug = "MDCINT_debug"
-        mdcint_int = "MDCINT_int"
     else
         filename_idx = count*nprocs + rank
         mdcint_basename = "MDCIN"
@@ -37,14 +35,8 @@ subroutine get_mdcint_filename(count)
         mdcint_filename = TRIM(mdcint_baseName)//TRIM(ADJUSTL(digit_x_padding))//TRIM(ADJUSTL(chr_rank))
         if (count == 0) then
             mdcintnew = "MDCINTNEW"//TRIM(ADJUSTL(chr_rank))
-            mdcint_debug = "MDCINT_debug"//TRIM(ADJUSTL(chr_rank))
-            mdcint_int = "MDCINT_int"//TRIM(ADJUSTL(chr_rank))
         end if
     end if
-    if (rank == 0) then
-        print *, "get filename : ", trim(mdcint_filename), " ", &
-            trim(mdcintnew), " ", trim(mdcint_debug), " ", trim(mdcint_int)
-    end if
 end subroutine get_mdcint_filename
 subroutine get_subspace_filename
     ! This subroutine is to get the filename of [a-h]subspace 2-electron integrals.

src/module_file_manager.f90

@@ -44,7 +44,6 @@ subroutine check_iostat(iostat, file, end_of_file_reached)
         if (iostat == 0) then
             end_of_file_reached = .false.
         else if (iostat < 0) then
-            print *, "END OF FILE: ", file
             end_of_file_reached = .true.
         else
             print *, "ERROR: Error occured while reading a file. file: ", file, " iostat: ", iostat

src/module_global_variables.f90

@@ -133,8 +133,6 @@ MODULE module_global_variables
     ! rank                  : Process number of MPI (0 <= rank <= nprocs-1)
     ! mdcint_filename       : MDCINT filenames for each MPI process
     ! mdcintnew             : MDCINTNEW filenames for each MPI process (e.g. MDCINTNEW8)
-    ! mdcint_debug          : MDCINT_debug filenames for each MPI process (e.g. MDCINT_debug1)
-    ! mdcint_int            : MDCINT_int filenames for each MPI process (e.g. MDCINT_int)
     ! a1int, a2int          : A subspace filenames for each MPI process (e.g. A1int2)
     ! bint                  : B subspace filenames for each MPI process (e.g. Bint10)
     ! c1int, c2int, c3int   : C subspace filenames for each MPI process (e.g. C1int1)
@@ -144,7 +142,7 @@ MODULE module_global_variables
     ! gint                  : G subspace filenames for each MPI process (e.g. Gint11)
     ! hint                  : H subspace filenames for each MPI process (e.g. Hint12)
     integer :: ierr, nprocs, rank
-    character(:), allocatable :: mdcint_filename, mdcintnew, mdcint_debug, mdcint_int
+    character(:), allocatable :: mdcint_filename, mdcintnew
     character(:), allocatable :: a1int, a2int, bint, c1int, c2int, c3int, d1int, d2int, d3int, eint, fint, gint, hint
 
     !! ================

src/r4dcasci.f90

@@ -82,17 +82,13 @@ PROGRAM r4dcasci   ! DO CASCI CALC IN THIS PROGRAM!
     if (skip_mdcint) then
         if (rank == 0) print *, "Skip create_newmdcint (Activated skip_mdcint option by user input file)"
     else
-
-        if (rank == 0) print *, "Start create_newmdcint"
         call timing(date0, tsec0, date1, tsec1)
         date0 = date1; tsec0 = tsec1
-        call create_newmdcint
         ! Create UTChem type MDCINT file from Dirac MDCINT file
-        if (rank == 0) print *, "End create_newmdcint"
+        call create_newmdcint
         call timing(date0, tsec0, date1, tsec1)
         date0 = date1; tsec0 = tsec1
     end if
-    if (rank == 0) print '(a)', 'Before readint2_casci'
 
     ! Read UTChem type MDCINT files and expands the 2-electron integral in memory
     Call readint2_casci(mdcintnew, nuniq)
@@ -143,7 +139,6 @@ PROGRAM r4dcasci   ! DO CASCI CALC IN THIS PROGRAM!
 !! NOW MAKE FOCK MATRIX FOR CASCI STATE
 !! fij = hij + SIGUMA_kl[<0|Ekl|0>{(ij|kl)-(il|kj)}
     if (rank == 0) then
-        print *, 'before building fock'
         call timing(date0, tsec0, date1, tsec1)
         date0 = date1; tsec0 = tsec1
     end if

src/r4dcaspt2_tra.f90

@@ -139,7 +139,6 @@ PROGRAM r4dcaspt2_tra   ! DO CASPT2 CALC WITH MO TRANSFORMATION
     Deallocate (ecas)
 
     ! Read CI coefficients
-    if (rank == 0) print *, ' ENTER READ NEWCICOEFF', ndet
     Allocate (ci(1:ndet))
     ci = 0.0d+00
     call open_unformatted_file(unit=unit_new, file="NEWCICOEFF", status='old', optional_action="read")
@@ -150,7 +149,6 @@ PROGRAM r4dcaspt2_tra   ! DO CASPT2 CALC WITH MO TRANSFORMATION
     cir(1:ndet, selectroot) = DBLE(ci(1:ndet))
     cii(1:ndet, selectroot) = DIMAG(ci(1:ndet))
     deallocate (ci)
-    if (rank == 0) print *, ' EXIT READ NEWCICOEFF'
 
     ! Read epsilons
     call open_unformatted_file(unit=unit_new, file="EPS", status='old', optional_action="read")
@@ -202,7 +200,6 @@ PROGRAM r4dcaspt2_tra   ! DO CASPT2 CALC WITH MO TRANSFORMATION
 &        because the 2nd order energy of A subspace cannot be defined when ninact = 0."
     else
         ! Transform A subspace 2-electron integrals (active, inactive | active, active)
-        if (rank == 0) print *, 'A1int filename : ', trim(a1int), ' rank', rank
         Call intra_3(2, 1, 2, 2, a1int)
         if (rank == 0) print *, 'End intra3 A1int'
         date1 = date0

src/read_mrconee.f90

@@ -178,16 +178,13 @@ subroutine create_multiplication_table
             End do
         end if
         MULTB_DS = transpose(SD)
-        if (rank == 0) print *, "before deallocate SD"
         if (rank == 0) then
             print *, 'MULTB_DS'
             Do i = 1, nsymrpa
                 print '(50I3)', (MULTB_DS(i, j), j=1, nsymrpa)
             End do
         end if
-        if (rank == 0) print *, "before deallocate SD"
         Call memminus(KIND(SD), SIZE(SD), 1); deallocate (SD)
-        if (rank == 0) print *, "deallocate SD"
     end subroutine create_multiplication_table
 
     subroutine create_mo_irrep_conversion_list

src/search_cas_configuration.f90

@@ -129,9 +129,10 @@ logical function is_cas_determinant()
                 End if
             End do
             If (mod(ielec, 2) == 0) isym = isym + nsymrpa ! even number electronic system
-
-            if (rank == 0) print '(a,i20,a,b50,a,i5)', &
-                "current_det:", current_det, "bit(current_det)", current_det, "isym:", isym
+#ifdef DEBUG
+            if (rank == 0) print '(a,i20,1x,a,b50,1x,a,i5)', &
+                "current_det:", current_det, "bit(current_det):", current_det, "isym:", isym
+#endif
             ! Check if the determinant is allowed
             if (isym == totsym) then
                 is_cas_determinant = .true.