diff --git a/Gamma/phcg.f90 b/Gamma/phcg.f90 index 57784d6af..76db31394 100644 --- a/Gamma/phcg.f90 +++ b/Gamma/phcg.f90 @@ -453,7 +453,7 @@ SUBROUTINE newscf USE noncollin_module, ONLY: report ! USE funct, only : USE io_files, ONLY : iunigk, iunwfc, input_drho, output_drho - USE control_flags, ONLY : restart, reduce_io, lscf, istep, iprint, & + USE control_flags, ONLY : restart, io_level, lscf, istep, iprint, & pot_order, wfc_order, david, max_cg_iter, & isolve, tr2, ethr, mixing_beta, nmix, niter ! @@ -466,7 +466,7 @@ SUBROUTINE newscf ! ! dft='Same as Before' restart =.FALSE. - reduce_io=.TRUE. + io_level = 0 lscf=.TRUE. lda_plus_u=.FALSE. doublegrid=.FALSE. diff --git a/Modules/control_flags.f90 b/Modules/control_flags.f90 index baf9b68b7..f447a2ae3 100644 --- a/Modules/control_flags.f90 +++ b/Modules/control_flags.f90 @@ -260,8 +260,8 @@ MODULE control_flags ! ! ... printout control ! - LOGICAL, PUBLIC :: & - reduce_io ! if .TRUE. reduce the I/O to the strict minimum + INTEGER, PUBLIC :: & + io_level ! variable controlling the amount of I/O to file INTEGER, PUBLIC :: & iverbosity ! type of printing ( 0 few, 1 all ) ! @@ -293,7 +293,7 @@ MODULE control_flags ! ... Parameter for plotting Vh average ! LOGICAL, PUBLIC :: tvhmean = .FALSE. - ! if TRUE save Vh averag to file Vh_mean.out + ! if TRUE save Vh average to file Vh_mean.out REAL(DP), PUBLIC :: vhrmin = 0.0d0 ! starting "radius" for plotting REAL(DP), PUBLIC :: vhrmax = 1.0d0 diff --git a/PW/c_bands.f90 b/PW/c_bands.f90 index bae250034..bc0f66228 100644 --- a/PW/c_bands.f90 +++ b/PW/c_bands.f90 @@ -25,7 +25,7 @@ SUBROUTINE c_bands( iter, ik_, dr2 ) USE uspp, ONLY : vkb, nkb USE gvect, ONLY : g, nrxx, nr1, nr2, nr3 USE wvfct, ONLY : et, nbnd, npwx, igk, npw, current_k - USE control_flags, ONLY : ethr, isolve, reduce_io + USE control_flags, ONLY : ethr, isolve, io_level USE ldaU, ONLY : lda_plus_u, swfcatom USE lsda_mod, ONLY : current_spin, lsda, isk USE noncollin_module, ONLY : noncolin, npol @@ -111,7 +111,7 @@ SUBROUTINE c_bands( iter, ik_, dr2 ) ! ! ... read in wavefunctions from the previous iteration ! - IF ( nks > 1 .OR. .NOT. reduce_io .OR. lelfield ) & + IF ( nks > 1 .OR. (io_level > 1) .OR. lelfield ) & CALL get_buffer ( evc, nwordwfc, iunwfc, ik ) ! ! ... Needed for LDA+U @@ -126,7 +126,7 @@ SUBROUTINE c_bands( iter, ik_, dr2 ) ! ... iterative diagonalization of the next scf iteration ! ... and for rho calculation ! - IF ( nks > 1 .OR. .NOT. reduce_io .OR. lelfield ) & + IF ( nks > 1 .OR. (io_level > 1) .OR. lelfield ) & CALL save_buffer ( evc, nwordwfc, iunwfc, ik ) ! ! ... save restart information diff --git a/PW/electrons.f90 b/PW/electrons.f90 index d6f2f15d6..b27a983a0 100644 --- a/PW/electrons.f90 +++ b/PW/electrons.f90 @@ -39,7 +39,7 @@ SUBROUTINE electrons() tauk, taukg, kedtau, kedtaur USE control_flags, ONLY : mixing_beta, tr2, ethr, niter, nmix, & iprint, istep, lscf, lmd, conv_elec, & - restart, reduce_io + restart, io_level USE io_files, ONLY : iunwfc, iunocc, nwordwfc, output_drho, & iunefield USE buffers, ONLY : save_buffer @@ -497,7 +497,7 @@ SUBROUTINE electrons() ! ! ... save converged wfc if they have not been written previously ! - IF ( nks == 1 .AND. reduce_io ) & + IF ( nks == 1 .AND. (io_level < 2) ) & CALL save_buffer ( evc, nwordwfc, iunwfc, nks ) ! ! ... calculate the polarization diff --git a/PW/input.f90 b/PW/input.f90 index 6400074b5..d45369800 100644 --- a/PW/input.f90 +++ b/PW/input.f90 @@ -136,7 +136,7 @@ SUBROUTINE iosys() nosym_ => nosym, & modenum_ => modenum, & lkpoint_dir_ => lkpoint_dir, & - reduce_io, ethr, lscf, lbfgs, lmd, lpath, lneb, & + io_level, ethr, lscf, lbfgs, lmd, lpath, lneb, & lsmd, lphonon, ldamped, lbands, lmetadyn, llang, & lconstrain, lcoarsegrained, restart, twfcollect, & use_para_diago @@ -560,11 +560,11 @@ SUBROUTINE iosys() SELECT CASE( TRIM( disk_io ) ) CASE( 'high' ) ! - reduce_io = .FALSE. + io_level = 2 ! CASE DEFAULT ! - reduce_io = .TRUE. + io_level = 1 restart = .FALSE. ! END SELECT diff --git a/PW/make.depend b/PW/make.depend index d6fe56e50..0f75e0cd7 100644 --- a/PW/make.depend +++ b/PW/make.depend @@ -189,9 +189,11 @@ clean_pw.o : ../Modules/wavefunctions.o clean_pw.o : dynamics_module.o clean_pw.o : noncol.o clean_pw.o : pwcom.o +close_files.o : ../Modules/control_flags.o close_files.o : ../Modules/io_files.o close_files.o : ../Modules/mp.o close_files.o : ../Modules/mp_global.o +close_files.o : buffers.o close_files.o : pwcom.o complex_diis_module.o : ../Modules/constants.o complex_diis_module.o : ../Modules/control_flags.o @@ -721,6 +723,8 @@ paw.o : ../Modules/ions_base.o paw.o : ../Modules/kind.o paw.o : ../Modules/parameters.o paw.o : ../Modules/read_upf.o +paw.o : ../Modules/splinelib.o +paw.o : ../Modules/uspp.o potinit.o : ../Modules/cell_base.o potinit.o : ../Modules/control_flags.o potinit.o : ../Modules/io_files.o @@ -830,6 +834,7 @@ read_file.o : ../Modules/mp_global.o read_file.o : ../Modules/uspp.o read_file.o : ../Modules/wavefunctions.o read_file.o : ../Modules/xml_io_base.o +read_file.o : buffers.o read_file.o : noncol.o read_file.o : pw_restart.o read_file.o : pwcom.o @@ -1143,6 +1148,7 @@ upf_to_internal.o : ../Modules/ions_base.o upf_to_internal.o : ../Modules/parameters.o upf_to_internal.o : ../Modules/pseudo_types.o upf_to_internal.o : ../Modules/uspp.o +upf_to_internal.o : paw.o upf_to_internal.o : pwcom.o usnldiag.o : ../Modules/ions_base.o usnldiag.o : ../Modules/kind.o diff --git a/PW/mix_rho.f90 b/PW/mix_rho.f90 index 1fb7d0e45..26b24b3c0 100644 --- a/PW/mix_rho.f90 +++ b/PW/mix_rho.f90 @@ -27,7 +27,7 @@ SUBROUTINE mix_rho( rhocout, rhocin, taukout, taukin, nsout, nsin, alphamix, & USE ldaU, ONLY : lda_plus_u, Hubbard_lmax USE funct, ONLY : dft_is_meta USE lsda_mod, ONLY : nspin - USE control_flags, ONLY : imix, ngm0, tr2, reduce_io + USE control_flags, ONLY : imix, ngm0, tr2, io_level USE io_files, ONLY : find_free_unit USE cell_base, ONLY : omega ! @@ -119,7 +119,7 @@ SUBROUTINE mix_rho( rhocout, rhocin, taukout, taukin, nsout, nsin, alphamix, & ! IF ( lda_plus_u ) ldim = 2 * Hubbard_lmax + 1 ! - savetofile = .not. reduce_io + savetofile = (io_level > 1) ! rhocout(:,:) = rhocout(:,:) - rhocin(:,:) tmeta = dft_is_meta() diff --git a/PW/non_scf.f90 b/PW/non_scf.f90 index 5f4c11dc8..f93d5abec 100644 --- a/PW/non_scf.f90 +++ b/PW/non_scf.f90 @@ -15,7 +15,7 @@ ! USE kinds, ONLY : DP USE bp, ONLY : lelfield, lberry - USE control_flags, ONLY : lbands, reduce_io + USE control_flags, ONLY : lbands, io_level USE ener, ONLY : ef USE io_global, ONLY : stdout, ionode USE io_files, ONLY : iunwfc, nwordwfc, iunefield @@ -80,7 +80,7 @@ ! ! ... save converged wfc if they have not been written previously ! - IF ( nks == 1 .AND. reduce_io ) & + IF ( nks == 1 .AND. (io_level < 2) ) & CALL save_buffer ( evc, nwordwfc, iunwfc, nks ) ! ! ... do a Berry phase polarization calculation if required diff --git a/PW/save_in_cbands.f90 b/PW/save_in_cbands.f90 index 7749f72fe..2eeb60bd7 100644 --- a/PW/save_in_cbands.f90 +++ b/PW/save_in_cbands.f90 @@ -11,7 +11,7 @@ subroutine save_in_cbands (iter, ik_, dr2) USE kinds, ONLY: DP USE io_files, ONLY: iunres, prefix USE klist, ONLY: nks - USE control_flags, ONLY: reduce_io, tr2, ethr + USE control_flags, ONLY: io_level, tr2, ethr USE wvfct, ONLY: nbnd, et implicit none character :: where * 20 @@ -23,7 +23,7 @@ subroutine save_in_cbands (iter, ik_, dr2) logical :: exst real(DP) :: dr2 - if (reduce_io) return + if ( io_level < 2 ) return ! ! open recover file ! diff --git a/PW/save_in_electrons.f90 b/PW/save_in_electrons.f90 index 93c8aebb5..29a6cf635 100644 --- a/PW/save_in_electrons.f90 +++ b/PW/save_in_electrons.f90 @@ -12,7 +12,7 @@ subroutine save_in_electrons (iter, dr2) USE io_files, ONLY: iunres, prefix USE ener, ONLY: etot USE klist, ONLY: nks - USE control_flags, ONLY: reduce_io, conv_elec, tr2, ethr + USE control_flags, ONLY: io_level, conv_elec, tr2, ethr USE wvfct, ONLY: nbnd, et USE vlocal, ONLY: vnew implicit none @@ -26,7 +26,7 @@ subroutine save_in_electrons (iter, dr2) real(DP) :: dr2 - if (reduce_io) return + if ( io_level < 2 ) return ! ! open recover file ! diff --git a/PW/save_in_ions.f90 b/PW/save_in_ions.f90 index 86a21fc07..e6f843517 100644 --- a/PW/save_in_ions.f90 +++ b/PW/save_in_ions.f90 @@ -11,7 +11,7 @@ subroutine save_in_ions USE kinds, ONLY: DP USE io_files, ONLY: iunres, prefix USE klist, ONLY: nks - USE control_flags, ONLY: reduce_io, lscf, tr2, ethr + USE control_flags, ONLY: io_level, lscf, tr2, ethr USE wvfct, ONLY: nbnd, et implicit none character :: where * 20 @@ -21,10 +21,9 @@ subroutine save_in_ions ! last completed kpoint ! last completed iteration logical :: exst - - real(DP) :: dr2 - if (reduce_io.or..not.lscf) return + ! + if ( io_level < 2 .or. .not.lscf ) return ! ! open recover file ! diff --git a/PW/wfcinit.f90 b/PW/wfcinit.f90 index 4bfd44b6a..02cefe61c 100644 --- a/PW/wfcinit.f90 +++ b/PW/wfcinit.f90 @@ -18,7 +18,7 @@ SUBROUTINE wfcinit() USE basis, ONLY : natomwfc, startingwfc USE bp, ONLY : lelfield USE klist, ONLY : xk, nks, ngk - USE control_flags, ONLY : reduce_io, lscf + USE control_flags, ONLY : io_level, lscf USE ldaU, ONLY : swfcatom, lda_plus_u USE lsda_mod, ONLY : lsda, current_spin, isk USE io_files, ONLY : nwordwfc, nwordatwfc, iunwfc, iunigk, iunsat @@ -80,7 +80,7 @@ SUBROUTINE wfcinit() ! ... memory if c_bands will not do it (for a single k-point); ! ... return and do nothing otherwise (c_bands will read wavefunctions) ! - IF ( nks == 1 .AND. reduce_io ) & + IF ( nks == 1 .AND. (io_level < 2) ) & CALL get_buffer ( evc, nwordwfc, iunwfc, 1 ) ! CALL stop_clock( 'wfcinit' ) @@ -119,7 +119,7 @@ SUBROUTINE wfcinit() ! ! ... write starting wavefunctions to file ! - IF ( nks > 1 .OR. .NOT. reduce_io ) & + IF ( nks > 1 .OR. (io_level > 1) ) & CALL save_buffer ( evc, nwordwfc, iunwfc, ik ) ! END DO diff --git a/VdW/check_v_eff.f90 b/VdW/check_v_eff.f90 index 7a9031e02..c608b0fed 100644 --- a/VdW/check_v_eff.f90 +++ b/VdW/check_v_eff.f90 @@ -35,8 +35,7 @@ SUBROUTINE check_v_eff ( veff, charge ) npw USE gsmooth, ONLY : nls, nlsm, nr1s, nr2s, nr3s, & nrx1s, nrx2s, nrx3s, nrxxs, doublegrid - USE control_flags, ONLY : diis_ndim, ethr, lscf, max_cg_iter, & - isolve, reduce_io + USE control_flags, ONLY : diis_ndim, ethr, lscf, max_cg_iter, isolve USE ldaU, ONLY : lda_plus_u, swfcatom USE scf, ONLY : rho, vltot, vrs, v_of_0 USE lsda_mod, ONLY : nspin, current_spin, lsda, isk diff --git a/VdW/make.depend b/VdW/make.depend index b8bbfd2f2..b930ed623 100644 --- a/VdW/make.depend +++ b/VdW/make.depend @@ -65,7 +65,6 @@ print_clock_vdw.o : ../PH/phcom.o print_clock_vdw.o : ../PH/ramanm.o solve_e.o : ../Modules/cell_base.o solve_e.o : ../Modules/check_stop.o -solve_e.o : ../Modules/control_flags.o solve_e.o : ../Modules/io_files.o solve_e.o : ../Modules/io_global.o solve_e.o : ../Modules/ions_base.o diff --git a/VdW/print_clock_vdw.f90 b/VdW/print_clock_vdw.f90 index b8665802a..7494ef39c 100644 --- a/VdW/print_clock_vdw.f90 +++ b/VdW/print_clock_vdw.f90 @@ -11,7 +11,6 @@ subroutine print_clock_vdw USE io_global, ONLY : stdout USE uspp, only: okvan - USE control_ph USE ramanm, ONLY: lraman, elop USE nlcc_ph, ONLY: nlcc_any implicit none diff --git a/VdW/solve_e.f90 b/VdW/solve_e.f90 index 2ddf9f7f1..5223f1656 100644 --- a/VdW/solve_e.f90 +++ b/VdW/solve_e.f90 @@ -32,7 +32,6 @@ subroutine solve_e_vdw ( iu ) USE becmod, ONLY : becp USE uspp_param, ONLY : nhm use phcom - USE control_flags, ONLY : reduce_io USE phus, ONLY : becp1 USE eff_v, ONLY : nelecr, veff, et_c, dvext, evc => evc_veff, & dpsi_eff