From 30ef9426cd00c3756bacacd0b54fa174d50a9e34 Mon Sep 17 00:00:00 2001 From: Kohei Noda Date: Sun, 14 Jan 2024 14:14:36 +0900 Subject: [PATCH] Fix print statements and remove unnecessary code --- src/calce0.f90 | 3 +-- src/casci.f90 | 2 -- src/casmat.f90 | 10 ++-------- src/create_newmdcint.f90 | 4 ++-- src/cutoff.f90 | 8 +------- src/diag.f90 | 19 +++++++------------ src/fockcasci.f90 | 4 ---- src/get_filename.f90 | 10 +--------- src/module_file_manager.f90 | 1 - src/module_global_variables.f90 | 4 +--- src/r4dcasci.f90 | 7 +------ src/r4dcaspt2_tra.f90 | 3 --- src/read_mrconee.f90 | 3 --- src/search_cas_configuration.f90 | 7 ++++--- src/solve_A_subspace.f90 | 15 ++------------- src/solve_B_subspace.f90 | 9 +++------ src/solve_C_subspace.f90 | 4 ---- src/solve_D_subspace.f90 | 23 ++--------------------- src/solve_E_subspace.f90 | 6 ++---- src/solve_F_subspace.f90 | 8 ++------ src/solve_G_subspace.f90 | 6 ++---- src/solve_H_subspace.f90 | 14 ++++---------- 22 files changed, 37 insertions(+), 133 deletions(-) diff --git a/src/calce0.f90 b/src/calce0.f90 index 242bcddf..ec50c9f6 100644 --- a/src/calce0.f90 +++ b/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 diff --git a/src/casci.f90 b/src/casci.f90 index 44ed3508..620ea1d9 100644 --- a/src/casci.f90 +++ b/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)) diff --git a/src/casmat.f90 b/src/casmat.f90 index fb6d808c..d6e2f508 100644 --- a/src/casmat.f90 +++ b/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 diff --git a/src/create_newmdcint.f90 b/src/create_newmdcint.f90 index c7589d4e..5872d643 100644 --- a/src/create_newmdcint.f90 +++ b/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() diff --git a/src/cutoff.f90 b/src/cutoff.f90 index 7332a50e..44f83603 100644 --- a/src/cutoff.f90 +++ b/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 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= diff --git a/src/diag.f90 b/src/diag.f90 index 4a91e3fd..e6ee1f4e 100644 --- a/src/diag.f90 +++ b/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,7 +353,7 @@ 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 @@ -366,7 +361,7 @@ SUBROUTINE cdiag0(n, n0, n1, fac, wc) 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)) diff --git a/src/fockcasci.f90 b/src/fockcasci.f90 index 35470650..29638f19 100644 --- a/src/fockcasci.f90 +++ b/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 diff --git a/src/get_filename.f90 b/src/get_filename.f90 index 68167163..1dbcff3c 100644 --- a/src/get_filename.f90 +++ b/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. diff --git a/src/module_file_manager.f90 b/src/module_file_manager.f90 index ac0ac337..ba8b1d1a 100644 --- a/src/module_file_manager.f90 +++ b/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 diff --git a/src/module_global_variables.f90 b/src/module_global_variables.f90 index 7232c923..e4fc120d 100644 --- a/src/module_global_variables.f90 +++ b/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 !! ================ diff --git a/src/r4dcasci.f90 b/src/r4dcasci.f90 index a8b1c91b..29033622 100644 --- a/src/r4dcasci.f90 +++ b/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 diff --git a/src/r4dcaspt2_tra.f90 b/src/r4dcaspt2_tra.f90 index 72766b46..22fda934 100644 --- a/src/r4dcaspt2_tra.f90 +++ b/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 diff --git a/src/read_mrconee.f90 b/src/read_mrconee.f90 index 4cb32719..d7320b25 100644 --- a/src/read_mrconee.f90 +++ b/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 diff --git a/src/search_cas_configuration.f90 b/src/search_cas_configuration.f90 index e63793a6..1a9fc018 100644 --- a/src/search_cas_configuration.f90 +++ b/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. diff --git a/src/solve_A_subspace.f90 b/src/solve_A_subspace.f90 index 21a3cb6e..4a388454 100644 --- a/src/solve_A_subspace.f90 +++ b/src/solve_A_subspace.f90 @@ -8,7 +8,6 @@ SUBROUTINE solve_A_subspace(e0, e2a) real(8), intent(out):: e2a if (realonly%is_realonly()) then - if (rank == 0) print *, "NODA SOLVEA REALONLY START" call solve_A_subspace_real() else call solve_A_subspace_complex() @@ -260,7 +259,6 @@ SUBROUTINE solve_A_subspace_complex() Call memminus(KIND(indsym), SIZE(indsym), 2); Deallocate (indsym) e2a = e2a + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' End do if (rank == 0) then @@ -537,9 +535,6 @@ SUBROUTINE vAmat_complex(v) End do !$OMP end parallel do - Do isym = 1, nsymrpa - if (rank == 0) print '(2I4)', dim2(isym), isym - End do !$OMP parallel do private(ji,it,jt,cint1) Do ii = rank + 1, ninact, nprocs ji = ii @@ -560,7 +555,6 @@ SUBROUTINE vAmat_complex(v) !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ call open_unformatted_file(unit=unit_int2, file=a1int, status='old', optional_action='read') - if (rank == 0) print *, 'open A1int' do read (unit_int2, iostat=iostat) i, j, k, l, cint2 ! (ij|kl) call check_iostat(iostat=iostat, file=a1int, end_of_file_reached=is_end_of_file) @@ -608,6 +602,7 @@ SUBROUTINE vAmat_complex(v) end do close (unit_int2) + if (rank == 0) print *, 'reading A1int2 is over' call open_unformatted_file(unit=unit_int2, file=a2int, status='old', optional_action='read') ! TYPE 2 integrals do @@ -671,7 +666,6 @@ SUBROUTINE vAmat_complex(v) #ifdef HAVE_MPI call allreduce_wrapper(mat=v) - if (rank == 0) print *, 'end allreduce vAmat' #endif if (rank == 0) print *, 'A subspace V matrix is obtained normally' end subroutine vAmat_complex @@ -909,7 +903,6 @@ SUBROUTINE solve_A_subspace_real() Call memminus(KIND(indsym), SIZE(indsym), 2); Deallocate (indsym) e2a = e2a + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' End do if (rank == 0) then @@ -1186,9 +1179,6 @@ SUBROUTINE vAmat_real(v) End do !$OMP end parallel do - Do isym = 1, nsymrpa - if (rank == 0) print '(2I4)', dim2(isym), isym - End do !$OMP parallel do private(ji,it,jt,cint1) Do ii = rank + 1, ninact, nprocs ji = ii @@ -1209,7 +1199,6 @@ SUBROUTINE vAmat_real(v) !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ call open_unformatted_file(unit=unit_int2, file=a1int, status='old', optional_action='read') - if (rank == 0) print *, 'open A1int' do read (unit_int2, iostat=iostat) i, j, k, l, cint2 ! (ij|kl) call check_iostat(iostat=iostat, file=a1int, end_of_file_reached=is_end_of_file) @@ -1257,6 +1246,7 @@ SUBROUTINE vAmat_real(v) end do close (unit_int2) + if (rank == 0) print *, 'reading A1int2 is over' call open_unformatted_file(unit=unit_int2, file=a2int, status='old', optional_action='read') ! TYPE 2 integrals do @@ -1320,7 +1310,6 @@ SUBROUTINE vAmat_real(v) #ifdef HAVE_MPI call allreduce_wrapper(mat=v) - if (rank == 0) print *, 'end allreduce vAmat' #endif if (rank == 0) print *, 'A subspace V matrix is obtained normally' end subroutine vAmat_real diff --git a/src/solve_B_subspace.f90 b/src/solve_B_subspace.f90 index eadb406f..cf8f48b6 100644 --- a/src/solve_B_subspace.f90 +++ b/src/solve_B_subspace.f90 @@ -138,7 +138,6 @@ SUBROUTINE solve_B_subspace_complex() Allocate (sc(dimn, dimn)); Call memplus(KIND(sc), SIZE(sc), 2) sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sBmat' Call sBmat_complex(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -267,8 +266,6 @@ SUBROUTINE solve_B_subspace_complex() Call memminus(KIND(indsym), SIZE(indsym), 2); Deallocate (indsym) e2b = e2b + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' - End do if (rank == 0) then @@ -580,11 +577,12 @@ SUBROUTINE vBmat_complex(nij, iij, v) end do close (unit_int2) - if (rank == 0) print *, 'B subspace V matrix is obtained normally' + if (rank == 0) print *, 'reading Bint2 is over' #ifdef HAVE_MPI call allreduce_wrapper(mat=v) #endif + if (rank == 0) print *, 'B subspace V matrix is obtained normally' end subroutine vBmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -709,7 +707,6 @@ SUBROUTINE solve_B_subspace_real() Allocate (sc(dimn, dimn)); Call memplus(KIND(sc), SIZE(sc), 2) sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sBmat' Call sBmat_real(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -826,7 +823,6 @@ SUBROUTINE solve_B_subspace_real() Call memminus(KIND(indsym), SIZE(indsym), 2); Deallocate (indsym) e2b = e2b + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' End do if (rank == 0) then @@ -1138,6 +1134,7 @@ SUBROUTINE vBmat_real(nij, iij, v) end do close (unit_int2) + if (rank == 0) print *, 'reading Bint2 is over' #ifdef HAVE_MPI call allreduce_wrapper(mat=v) diff --git a/src/solve_C_subspace.f90 b/src/solve_C_subspace.f90 index b98c7723..e4aefd5e 100644 --- a/src/solve_C_subspace.f90 +++ b/src/solve_C_subspace.f90 @@ -258,7 +258,6 @@ SUBROUTINE solve_C_subspace_complex() Deallocate (wb) e2c = e2c + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' End do if (rank == 0) then @@ -645,7 +644,6 @@ SUBROUTINE vCmat_complex(v) #ifdef HAVE_MPI call allreduce_wrapper(mat=v) - if (rank == 0) print *, 'end Allreduce vCmat' #endif if (rank == 0) print *, 'C subspace V matrix is obtained normally' end subroutine vCmat_complex @@ -882,7 +880,6 @@ SUBROUTINE solve_C_subspace_real() Deallocate (wb) e2c = e2c + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' End do if (rank == 0) then @@ -1269,7 +1266,6 @@ SUBROUTINE vCmat_real(v) #ifdef HAVE_MPI call allreduce_wrapper(mat=v) - if (rank == 0) print *, 'end Allreduce vCmat' #endif if (rank == 0) print *, 'C subspace V matrix is obtained normally' end subroutine vCmat_real diff --git a/src/solve_D_subspace.f90 b/src/solve_D_subspace.f90 index 49adf416..22924b57 100644 --- a/src/solve_D_subspace.f90 +++ b/src/solve_D_subspace.f90 @@ -277,7 +277,6 @@ SUBROUTINE solve_D_subspace_complex() if (rank == 0) print '("e2d(",I3,") = ",E20.10," a.u.")', isym, e2(isym) e2d = e2d + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' End do if (rank == 0) then @@ -484,8 +483,6 @@ SUBROUTINE vDmat_complex(nai, iai, v) ! !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'before d1int' - call open_unformatted_file(unit=unit_int2, file=d1int, status='old', optional_action='read') do read (unit_int2, iostat=iostat) i, j, k, l, cint2 ! (ij|kl) @@ -528,8 +525,6 @@ SUBROUTINE vDmat_complex(nai, iai, v) ! !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'before d2int' - call open_unformatted_file(unit=unit_int2, file=d2int, status='old', optional_action='read') do read (unit_int2, iostat=iostat) i, j, k, l, cint2 ! (ij|kl) @@ -556,10 +551,7 @@ SUBROUTINE vDmat_complex(nai, iai, v) end do close (unit_int2) - if (rank == 0) then - print *, 'reading D2int2 is over' - print *, 'before d3int' - end if + if (rank == 0) print *, 'reading D2int2 is over' call open_unformatted_file(unit=unit_int2, file=d3int, status='old', optional_action='read') ! (ai|jk) is stored do @@ -606,7 +598,6 @@ SUBROUTINE vDmat_complex(nai, iai, v) #ifdef HAVE_MPI call allreduce_wrapper(mat=v) - if (rank == 0) print *, 'end Allreduce vDmat' #endif if (rank == 0) print *, 'D subspace V matrix is obtained normally' end subroutine vDmat_complex @@ -862,7 +853,6 @@ SUBROUTINE solve_D_subspace_real() if (rank == 0) print '("e2d(",I3,") = ",E20.10," a.u.")', isym, e2(isym) e2d = e2d + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' End do if (rank == 0) then @@ -1069,8 +1059,6 @@ SUBROUTINE vDmat_real(nai, iai, v) ! !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'before d1int' - call open_unformatted_file(unit=unit_int2, file=d1int, status='old', optional_action='read') do read (unit_int2, iostat=iostat) i, j, k, l, cint2 ! (ij|kl) @@ -1113,8 +1101,6 @@ SUBROUTINE vDmat_real(nai, iai, v) ! !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'before d2int' - call open_unformatted_file(unit=unit_int2, file=d2int, status='old', optional_action='read') do read (unit_int2, iostat=iostat) i, j, k, l, cint2 ! (ij|kl) @@ -1141,10 +1127,7 @@ SUBROUTINE vDmat_real(nai, iai, v) end do close (unit_int2) - if (rank == 0) then - print *, 'reading D2int2 is over' - print *, 'before d3int' - end if + if (rank == 0) print *, 'reading D2int2 is over' call open_unformatted_file(unit=unit_int2, file=d3int, status='old', optional_action='read') ! (ai|jk) is stored do @@ -1171,7 +1154,6 @@ SUBROUTINE vDmat_real(nai, iai, v) #ifdef HAVE_MPI call allreduce_wrapper(mat=effh) #endif - if (rank == 0) print *, 'end allreduce effh' !$OMP parallel do schedule(dynamic,1) private(ia,ja,ii,ji,tai,it,jt,iu,ju,dr,di,d) Do ia = rank + 1, nsec, nprocs @@ -1192,7 +1174,6 @@ SUBROUTINE vDmat_real(nai, iai, v) #ifdef HAVE_MPI call allreduce_wrapper(mat=v) - if (rank == 0) print *, 'end Allreduce vDmat' #endif if (rank == 0) print *, 'D subspace V matrix is obtained normally' end subroutine vDmat_real diff --git a/src/solve_E_subspace.f90 b/src/solve_E_subspace.f90 index 72b4ed41..19114ffa 100644 --- a/src/solve_E_subspace.f90 +++ b/src/solve_E_subspace.f90 @@ -252,7 +252,6 @@ SUBROUTINE solve_E_subspace_complex() if (rank == 0) print '("e2e(",I3,") = ",E20.10," a.u.")', isym, e2(isym) e2e = e2e + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' End do if (rank == 0) then @@ -463,10 +462,10 @@ SUBROUTINE vEmat_complex(naij, iaij, v) end do close (unit_int2) + if (rank == 0) print *, 'reading Eint2 is over' #ifdef HAVE_MPI call allreduce_wrapper(mat=v) - if (rank == 0) print *, 'end Allreduce vEmat' #endif if (rank == 0) print *, 'E subspace V matrix is obtained normally' end subroutine vEmat_complex @@ -695,7 +694,6 @@ SUBROUTINE solve_E_subspace_real() if (rank == 0) print '("e2e(",I3,") = ",E20.10," a.u.")', isym, e2(isym) e2e = e2e + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' End do if (rank == 0) then @@ -906,10 +904,10 @@ SUBROUTINE vEmat_real(naij, iaij, v) end do close (unit_int2) + if (rank == 0) print *, 'reading Eint2 is over' #ifdef HAVE_MPI call allreduce_wrapper(mat=v) - if (rank == 0) print *, 'end Allreduce vEmat' #endif if (rank == 0) print *, 'E subspace V matrix is obtained normally' end subroutine vEmat_real diff --git a/src/solve_F_subspace.f90 b/src/solve_F_subspace.f90 index 376e5c1b..340784c1 100644 --- a/src/solve_F_subspace.f90 +++ b/src/solve_F_subspace.f90 @@ -143,7 +143,6 @@ SUBROUTINE solve_F_subspace_complex() Allocate (sc(dimn, dimn)) sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sFmat' Call sFmat_complex(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -278,7 +277,6 @@ SUBROUTINE solve_F_subspace_complex() if (rank == 0) print '("e2f(",I3,") = ",E20.10," a.u.")', isym, e2(isym) e2f = e2f + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' End do if (rank == 0) then @@ -531,10 +529,10 @@ SUBROUTINE vFmat_complex(nab, iab, v) end do close (unit_int2) + if (rank == 0) print *, 'reading Fint2 is over' #ifdef HAVE_MPI call allreduce_wrapper(mat=v) - if (rank == 0) print *, 'end allreduce vFmat' #endif if (rank == 0) print *, 'F subspace V matrix is obtained normally' @@ -668,7 +666,6 @@ SUBROUTINE solve_F_subspace_real() Allocate (sc(dimn, dimn)) sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sFmat' Call sFmat_real(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -788,7 +785,6 @@ SUBROUTINE solve_F_subspace_real() if (rank == 0) print '("e2f(",I3,") = ",E20.10," a.u.")', isym, e2(isym) e2f = e2f + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' End do if (rank == 0) then @@ -1041,10 +1037,10 @@ SUBROUTINE vFmat_real(nab, iab, v) end do close (unit_int2) + if (rank == 0) print *, 'reading Fint2 is over' #ifdef HAVE_MPI call allreduce_wrapper(mat=v) - if (rank == 0) print *, 'end allreduce vFmat' #endif if (rank == 0) print *, 'F subspace V matrix is obtained normally' diff --git a/src/solve_G_subspace.f90 b/src/solve_G_subspace.f90 index 120e8cc4..b9804f63 100644 --- a/src/solve_G_subspace.f90 +++ b/src/solve_G_subspace.f90 @@ -267,7 +267,6 @@ SUBROUTINE solve_G_subspace_complex() if (rank == 0) print '("e2g(",I3,") = ",E20.10," a.u.")', isym, e2(isym) e2g = e2g + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' End do if (rank == 0) then @@ -457,10 +456,10 @@ SUBROUTINE vGmat_complex(nabi, iabi, v) end do close (unit_int2) + if (rank == 0) print *, 'reading Gint2 is over' #ifdef HAVE_MPI call allreduce_wrapper(mat=v) - if (rank == 0) print *, 'end allreduce vGmat' #endif if (rank == 0) print *, 'G subspace V matrix is obtained normally' end subroutine vGmat_complex @@ -700,7 +699,6 @@ SUBROUTINE solve_G_subspace_real() if (rank == 0) print '("e2g(",I3,") = ",E20.10," a.u.")', isym, e2(isym) e2g = e2g + e2(isym) - if (rank == 0) print *, 'End e2(isym) add' End do if (rank == 0) then @@ -890,10 +888,10 @@ SUBROUTINE vGmat_real(nabi, iabi, v) end do close (unit_int2) + if (rank == 0) print *, 'reading Gint2 is over' #ifdef HAVE_MPI call allreduce_wrapper(mat=v) - if (rank == 0) print *, 'end allreduce vGmat' #endif if (rank == 0) print *, 'G subspace V matrix is obtained normally' end subroutine vGmat_real diff --git a/src/solve_H_subspace.f90 b/src/solve_H_subspace.f90 index d385b160..efc947fa 100644 --- a/src/solve_H_subspace.f90 +++ b/src/solve_H_subspace.f90 @@ -54,10 +54,7 @@ SUBROUTINE solve_H_subspace_complex() ! V(aibj) = (ai|bj) - (aj|bi) ! ! E2h = V(aibj)/e(a,b,i,j) - if (rank == 0) then - print *, 'ENTER solve H part' - print *, 'nsymrpa', nsymrpa - end if + if (rank == 0) print *, 'ENTER solve H part' e2h = 0.0d+00 e = 0.0d+00 @@ -141,11 +138,11 @@ SUBROUTINE solve_H_subspace_complex() end do close (unit_int2) + if (rank == 0) print *, 'reading Hint is over' #ifdef HAVE_MPI call allreduce_wrapper(mat=v) #endif - if (rank == 0) print *, 'reading Hint is over' Do i0 = 1, nab ia = ia0(i0) @@ -229,10 +226,7 @@ SUBROUTINE solve_H_subspace_real() ! V(aibj) = (ai|bj) - (aj|bi) ! ! E2h = V(aibj)/e(a,b,i,j) - if (rank == 0) then - print *, 'ENTER solve H part' - print *, 'nsymrpa', nsymrpa - end if + if (rank == 0) print *, 'ENTER solve H part' e2h = 0.0d+00 e = 0.0d+00 @@ -316,11 +310,11 @@ SUBROUTINE solve_H_subspace_real() end do close (unit_int2) + if (rank == 0) print *, 'reading Hint is over' #ifdef HAVE_MPI call allreduce_wrapper(mat=v) #endif - if (rank == 0) print *, 'reading Hint is over' Do i0 = 1, nab ia = ia0(i0)