Merge pull request #140 from RQC-HU/delete-unnecessary-output-and-cal…

…culation

Delete unnecessary output and calculation

CMakeLists.txt

@@ -32,7 +32,7 @@ if(CMAKE_Fortran_COMPILER_ID STREQUAL Intel OR CMAKE_Fortran_COMPILER_ID STREQUA
   endif()
 
   set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DINTEL -g -traceback -cpp -i8 -I$ENV{MKLROOT}/include -pad -integer-size 64 -unroll -warn nounused -nogen-interface")
-  set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -check -debug extended -debug-parameters -warn")
+  set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -check -debug extended -debug-parameters -warn -DDEBUG")
   set(CMAKE_Fortran_FLAGS_RELEASE "-O3")
   link_libraries(-i8)
 
@@ -54,7 +54,7 @@ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL GNU)
     set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fallow-argument-mismatch")
   endif()
 
-  set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -fcheck=all")
+  set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -fcheck=all -DDEBUG")
   set(CMAKE_Fortran_FLAGS_RELEASE "-O3")
   link_libraries(-fdefault-integer-8 -m64)
 

src/CMakeLists.txt

@@ -63,7 +63,6 @@ add_executable(r4dcaspt2ocoexe
   cutoff.f90
   diag.f90
   density_matrix.f90
-  e0test.f90
   get_filename.f90
   mem.f90
   one_e_exct.f90

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

@@ -12,9 +12,7 @@ SUBROUTINE casci
     use module_global_variables
     use module_realonly, only: realonly
     Implicit NONE
-#ifdef HAVE_MPI
-    include 'mpif.h'
-#endif
+
     integer :: j0, j, i0, irec, unit_cimat
     real(8) :: cutoff_threshold
 
@@ -32,18 +30,15 @@ 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))
     ecas = 0.0d+00
-    datetmp1 = date0; datetmp0 = date0
+    datetmp0 = date0; tsectmp0 = tsec0
     Call timing(date0, tsec0, datetmp0, tsectmp0)
-    tsectmp1 = tsectmp0
 
     ! Diagonalize the CI matrix
     if (rank == 0) then
@@ -57,9 +52,8 @@ SUBROUTINE casci
         Call cdiagx(mat_complex, ndet, nroot, ecas)
     end if
     if (rank == 0) print *, 'End mat diagonalization'
-    Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0)
-    datetmp1 = datetmp0
-    tsectmp1 = tsectmp0
+    call timing(datetmp0, tsectmp0, datetmp1, tsectmp1)
+    datetmp0 = datetmp1; tsectmp0 = tsectmp1
     ! keys and vals are used to store pairs of keys and values in dict_cas_idx
     dict_cas_idx_size = get_size(dict_cas_idx)
     allocate (keys(dict_cas_idx_size), vals(dict_cas_idx_size))
@@ -112,7 +106,7 @@ SUBROUTINE casci
                     if ((ABS(mat_real(j, irec))**2) > 1.0d-02) then
                         i0 = get_val(dict_cas_idx, j)
                         print *, (btest(i0, j0), j0=0, nact - 1)
-                        print '(I4,2(3X,E14.7)," Weights ",E14.7)', &
+                        print '(I4, 3X,E14.7," Weights ",E14.7)', &
                         & j, mat_real(j, irec), &
                         & ABS(mat_real(j, irec))**2
                     end if

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

@@ -7,6 +7,7 @@ Subroutine create_newmdcint ! 2 Electorn Integrals In Mdcint
 
 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
+    use module_error, only: stop_with_errorcode
     use module_file_manager
     use module_realonly, only: realonly
     Use module_global_variables
@@ -27,9 +28,7 @@ Subroutine create_newmdcint ! 2 Electorn Integrals In Mdcint
     integer :: unit_mdcint, unit_mdcintnew
     logical :: is_file_exist, is_end_of_file
 
-    Call timing(date1, tsec1, date0, tsec0)
-    date1 = date0
-    tsec1 = tsec0
+    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.
@@ -46,31 +45,46 @@ Subroutine create_newmdcint ! 2 Electorn Integrals In Mdcint
 #ifdef HAVE_MPI
     ! Broadcast kr and other data that are not included in the MDCINXXX files
     call MPI_Bcast(datex, sizeof(datex), MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr)
+#ifdef DEBUG
     if (rank == 0) then
         print *, "datex broadcast"
         print *, "if ierr == 0, datex broadcast successed. ierr=", ierr
     end if
+#endif
+    if (ierr /= 0) call stop_with_errorcode(ierr)
     call MPI_Bcast(timex, sizeof(timex), MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr)
+#ifdef DEBUG
     if (rank == 0) then
         print *, "timex broadcast"
         print *, "if ierr == 0, timex broadcast successed. ierr=", ierr
     end if
+#endif
+    if (ierr /= 0) call stop_with_errorcode(ierr)
     call MPI_Bcast(nkr, 1, MPI_INTEGER8, 0, MPI_COMM_WORLD, ierr)
+#ifdef DEBUG
     if (rank == 0) then
         print *, "nkr broadcast"
         print *, "if ierr == 0, nkr broadcast successed. ierr=", ierr
     end if
+#endif
+    if (ierr /= 0) call stop_with_errorcode(ierr)
     call MPI_Bcast(kr(-nmo/2), nmo + 1, MPI_INTEGER8, 0, MPI_COMM_WORLD, ierr)
+#ifdef DEBUG
     if (rank == 0) then
         print *, "kr broadcast"
         print *, "if ierr == 0, kr broadcast successed. ierr=", ierr
     end if
+#endif
+    if (ierr /= 0) call stop_with_errorcode(ierr)
     call MPI_Bcast(indmo_dirac_to_cas(1), nmo, MPI_INTEGER8, 0, MPI_COMM_WORLD, ierr)
+#ifdef DEBUG
     if (rank == 0) then
         print *, "datex broadcast"
         print *, "if ierr == 0, datex broadcast successed. ierr=", ierr
     end if
 #endif
+    if (ierr /= 0) call stop_with_errorcode(ierr)
+#endif
 
     cutoff = 0.25D-12
     nnz = 1
@@ -117,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
 
@@ -205,15 +218,12 @@ Subroutine create_newmdcint ! 2 Electorn Integrals In Mdcint
     end do
     write (unit_mdcintnew) 0, 0, 0
     close (unit_mdcintnew)
-    Call timing(date1, tsec1, date0, tsec0)
-    date1 = date0
-    tsec1 = tsec0
     deallocate (indk)
     deallocate (indl)
     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

@@ -199,8 +199,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
@@ -223,7 +221,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)
@@ -237,7 +234,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
 
 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
@@ -280,15 +276,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)
@@ -319,7 +312,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
@@ -328,9 +321,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)
@@ -467,15 +462,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/e0test.f90

@@ -254,7 +254,7 @@ SUBROUTINE e0test ! test to calculate <i|H|i>=Ei i is solution of the CASCI
     energy(iroot, 4) = 0.5d+00*energy(iroot, 4)
 
 #ifdef HAVE_MPI
-    call allreduce_wrapper(mat=energyHF(1:2))
+    call allreduce_wrapper(mat=energy(iroot, :))
 #endif
 
     if (rank == 0) then

src/fock_matrix_of_hf.f90

@@ -171,10 +171,10 @@ SUBROUTINE fock_matrix_of_hf_real ! TO CALCULATE FOCK MATRIX OF HF STATE, A TEST
         print *, ' '
         print *, 'THESE DIAGONAL ELEMENTS SHOULD BE CORESPOND TO HF SPINOR ENERGY '
         print *, ' '
-        print *, '  NO.   Spinor Energy(Re)   Spinor Energy(Im) '&
+        print *, '  NO.   Spinor Energy(Re) '&
         &, 'Spinor Energy (HF)        ERROR'
         do i = 1, global_sec_end
-            print '(I4,4E20.10)', i, fock_real(i, i), caspt2_mo_energy(i), caspt2_mo_energy(i) - dble(fock_real(i, i))
+            print '(I4,3E20.10)', i, fock_real(i, i), caspt2_mo_energy(i), caspt2_mo_energy(i) - dble(fock_real(i, i))
         end do
 
         print *, 'fockhf end'