diff --git a/CPV/src/cp_restart_new.f90 b/CPV/src/cp_restart_new.f90 index 40a9b71b3..e0462f8f9 100644 --- a/CPV/src/cp_restart_new.f90 +++ b/CPV/src/cp_restart_new.f90 @@ -1073,7 +1073,7 @@ MODULE cp_restart_new Hubbard_l(isp ) = 3 CASE default IF (Hubbard_U(isp)/=0) & - CALL errore ("pw_readschema:", "unrecognized label for Hubbard "//label, 1 ) + CALL errore ("qexsd_copy_dft:", "unrecognized label for Hubbard "//label, 1 ) END SELECT EXIT loop_on_speciesU END IF diff --git a/PP/src/vasp_xml_module.f90 b/PP/src/vasp_xml_module.f90 index 1c6a02774..21af5d90b 100644 --- a/PP/src/vasp_xml_module.f90 +++ b/PP/src/vasp_xml_module.f90 @@ -119,7 +119,6 @@ SUBROUTINE readxmlfile_vasp(iexch,icorr,igcx,igcc,inlc,ierr) USE io_files, ONLY : tmp_dir, prefix, iunpun, nwordwfc, iunwfc USE io_global, ONLY : stdout USE noncollin_module, ONLY : noncolin, npol, nspin_lsda, nspin_mag, nspin_gga - USE pw_restart_new, ONLY : pw_readschema_file, init_vars_from_schema USE qes_types_module, ONLY : output_type, parallel_info_type, general_info_type, input_type USE qes_libs_module, ONLY : qes_reset USE io_rho_xml, ONLY : read_scf diff --git a/PW/src/punch.f90 b/PW/src/punch.f90 index d16c84cb3..f84f9bac1 100644 --- a/PW/src/punch.f90 +++ b/PW/src/punch.f90 @@ -17,7 +17,8 @@ SUBROUTINE punch( what ) ! for nks=1, wavefunctions in plain binary format ! (see why in comments below) ! ... (for intermediate or incomplete results) - ! ... what = 'init-config' write xml data file only excluding final results + ! ... what = 'config-nowf' write xml data file iand charge density only + ! ... what = 'config-init' write xml data file only excluding final results ! ... (for dry run, can be called at early stages) ! USE io_global, ONLY : stdout, ionode @@ -43,7 +44,7 @@ SUBROUTINE punch( what ) ! CHARACTER(LEN=*), INTENT(IN) :: what ! - LOGICAL :: exst, wf_collect + LOGICAL :: exst, only_init, wf_collect CHARACTER(LEN=320) :: cp_source, cp_dest INTEGER :: cp_status, nt, inlc ! @@ -63,7 +64,8 @@ SUBROUTINE punch( what ) ! ... wf_collect keeps track whether wfcs are written in portable format ! wf_collect = ( TRIM(what) == 'all' ) - CALL pw_write_schema( what, wf_collect ) + only_init = ( TRIM(what) == 'config-init' ) + CALL pw_write_schema( only_init, wf_collect ) ! ! ... charge density - also writes rho%ns if lda+U and rho%bec if PAW ! ... do not overwrite the scf charge density with a non-scf one diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index d8c37f67f..ed98c2548 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -39,15 +39,16 @@ MODULE pw_restart_new CHARACTER(LEN=6), EXTERNAL :: int_to_char PRIVATE PUBLIC :: pw_write_schema, pw_write_binaries, & - pw_readschema_file, init_vars_from_schema, read_collected_to_evc + pw_read_schema, init_vars_from_schema, read_collected_to_evc ! CONTAINS !------------------------------------------------------------------------ - SUBROUTINE pw_write_schema( what, wf_collect ) + SUBROUTINE pw_write_schema( only_init, wf_collect ) !------------------------------------------------------------------------ ! - ! what = 'init-config': write only variables that are known after the - ! initial steps of initialization (e.g. structure) + ! only_init = T write only variables that are known after the + ! initial steps of initialization (e.g. structure) + ! = F write the complete xml file ! wf_collect = T if final wavefunctions in portable format are written, ! F if wavefunctions are either not written or are written ! in binary non-portable form (for checkpointing) @@ -139,8 +140,7 @@ MODULE pw_restart_new ! IMPLICIT NONE ! - CHARACTER(LEN=*), INTENT(IN) :: what - LOGICAL, INTENT(IN) :: wf_collect + LOGICAL, INTENT(IN) :: only_init, wf_collect ! CHARACTER(LEN=20) :: dft_name CHARACTER(LEN=256) :: dirname @@ -489,7 +489,7 @@ MODULE pw_restart_new ! ! skip if not yet computed ! - IF ( TRIM(what) == "init-config" ) GO TO 10 + IF ( only_init ) GO TO 10 ! IF ( .NOT. ( lgauss .OR. ltetra )) THEN occupations_are_fixed = .TRUE. @@ -904,7 +904,7 @@ MODULE pw_restart_new END SUBROUTINE gk_l2gmap_kdip !------------------------------------------------------------------------ - SUBROUTINE pw_readschema_file(ierr, restart_output, restart_parallel_info, restart_general_info, & + SUBROUTINE pw_read_schema(ierr, restart_output, restart_parallel_info, restart_general_info, & prev_input) !------------------------------------------------------------------------ USE qes_types_module, ONLY : input_type, output_type, general_info_type, parallel_info_type @@ -988,7 +988,7 @@ MODULE pw_restart_new ierr = 5 END IF IF ( ierr /= 0 ) THEN - CALL infomsg ('pw_readschema_file',& + CALL infomsg ('pw_read_schema',& 'failed retrieving input info from xml file, please check it') IF ( TRIM(prev_input%tagname) == 'input' ) CALL qes_reset (prev_input) ierr = 0 @@ -997,9 +997,9 @@ MODULE pw_restart_new ! CALL destroy(root) - 100 CALL errore('pw_readschemafile',TRIM(errmsg),ierr) + 100 CALL errore('pw_read_schema',TRIM(errmsg),ierr) ! - END SUBROUTINE pw_readschema_file + END SUBROUTINE pw_read_schema ! !------------------------------------------------------------------------ SUBROUTINE init_vars_from_schema( what, ierr, output_obj, par_info, gen_info, input_obj ) @@ -1657,7 +1657,7 @@ MODULE pw_restart_new Hubbard_l(isp ) = 3 CASE default IF (Hubbard_U(isp)/=0) & - CALL errore ("pw_readschema:", "unrecognized label for Hubbard "//label, 1 ) + CALL errore ("readschema_xc:", "unrecognized label for Hubbard "//label, 1 ) END SELECT EXIT loop_on_speciesU END IF @@ -1871,13 +1871,13 @@ MODULE pw_restart_new END IF END DO ELSE - CALL infomsg ( "pw_readschema: ", & + CALL infomsg ( "readschema_bz: ", & "actual number of start kpoint not equal to nks_start, set nks_start=0") nks_start = 0 END IF END IF ELSE - CALL errore ("pw_readschema: ", & + CALL errore ("readschema_bz: ", & " no information found for initializing brillouin zone information", 1) END IF ! diff --git a/PW/src/read_conf_from_file.f90 b/PW/src/read_conf_from_file.f90 index 73360ddd5..e8dd235ff 100644 --- a/PW/src/read_conf_from_file.f90 +++ b/PW/src/read_conf_from_file.f90 @@ -14,7 +14,7 @@ FUNCTION read_config_from_file(nat, at_old, omega_old, lmovecell, at, bg, & USE kinds, ONLY : DP USE io_global, ONLY : stdout USE io_files, ONLY : tmp_dir, prefix, postfix - USE pw_restart_new, ONLY : pw_readschema_file, init_vars_from_schema + USE pw_restart_new, ONLY : pw_read_schema, init_vars_from_schema USE qes_types_module, ONLY : output_type, parallel_info_type, general_info_type USE qes_libs_module, ONLY : qes_reset ! @@ -37,7 +37,7 @@ FUNCTION read_config_from_file(nat, at_old, omega_old, lmovecell, at, bg, & ! ! ... check if restart file is present, if yes read config parameters ! - CALL pw_readschema_file ( ierr, output_obj, parinfo_obj, geninfo_obj) + CALL pw_read_schema ( ierr, output_obj, parinfo_obj, geninfo_obj) IF (ierr == 0 ) THEN CALL init_vars_from_schema ( 'config', ierr, output_obj, parinfo_obj, geninfo_obj ) CALL qes_reset (output_obj) diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 5b90c703e..9e9c5136e 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -117,7 +117,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE scf, ONLY : rho, rho_core, rhog_core, v USE vlocal, ONLY : strf USE io_files, ONLY : tmp_dir, prefix, iunpun, nwordwfc, iunwfc - USE pw_restart_new, ONLY : pw_readschema_file, init_vars_from_schema + USE pw_restart_new, ONLY : pw_read_schema, init_vars_from_schema USE qes_types_module, ONLY : output_type, parallel_info_type, & general_info_type, input_type USE qes_libs_module, ONLY : qes_reset @@ -159,7 +159,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) ! #if defined(__BEOWULF) IF (ionode) THEN - CALL pw_readschema_file ( ierr, output_obj, parinfo_obj, geninfo_obj, input_obj) + CALL pw_read_schema ( ierr, output_obj, parinfo_obj, geninfo_obj, input_obj) IF ( ierr /= 0 ) CALL errore ( 'read_schema', 'unable to read xml file', ierr ) END IF CALL qes_bcast(output_obj, ionode_id, intra_image_comm) @@ -167,7 +167,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) CALL qes_bcast(geninfo_obj, ionode_id, intra_image_comm) CALL qes_bcast(input_obj, ionode_id, intra_image_comm) #else - CALL pw_readschema_file ( ierr, output_obj, parinfo_obj, geninfo_obj, input_obj) + CALL pw_read_schema ( ierr, output_obj, parinfo_obj, geninfo_obj, input_obj) IF ( ierr /= 0 ) CALL errore ( 'read_schema', 'unable to read xml file', ierr ) #endif wfc_is_collected = output_obj%band_structure%wf_collected diff --git a/PW/src/run_pwscf.f90 b/PW/src/run_pwscf.f90 index a8ec4f5f7..b759c0697 100644 --- a/PW/src/run_pwscf.f90 +++ b/PW/src/run_pwscf.f90 @@ -108,7 +108,7 @@ SUBROUTINE run_pwscf ( exit_status ) CALL summary() CALL memory_report() CALL qexsd_set_status(255) - CALL punch( 'init-config' ) + CALL punch( 'config-init' ) exit_status = 255 RETURN ENDIF @@ -185,7 +185,7 @@ SUBROUTINE run_pwscf ( exit_status ) ! IF ( idone <= nstep .AND. .NOT. conv_ions ) THEN CALL qexsd_set_status(255) - CALL punch( 'config' ) + CALL punch( 'config-nowf' ) END IF ! IF (dft_is_hybrid() ) CALL stop_exx() diff --git a/PW/src/setup.f90 b/PW/src/setup.f90 index 38604518b..b5d151f12 100644 --- a/PW/src/setup.f90 +++ b/PW/src/setup.f90 @@ -77,7 +77,7 @@ SUBROUTINE setup() USE noncollin_module, ONLY : noncolin, npol, m_loc, i_cons, & angle1, angle2, bfield, ux, nspin_lsda, & nspin_gga, nspin_mag - USE pw_restart_new, ONLY : pw_readschema_file, init_vars_from_schema + USE pw_restart_new, ONLY : pw_read_schema, init_vars_from_schema USE qes_libs_module, ONLY : qes_reset USE qes_types_module, ONLY : output_type, parallel_info_type, general_info_type USE exx, ONLY : ecutfock, nbndproj @@ -162,12 +162,19 @@ SUBROUTINE setup() nelec = ionic_charge - tot_charge ! IF ( lbands .OR. ( (lfcpopt .OR. lfcpdyn ) .AND. restart )) THEN - CALL pw_readschema_file( ierr , output_obj, parinfo_obj, geninfo_obj ) - END IF - ! - ! + ! + ! ... in these cases, we need to read the Fermi energy + ! + CALL pw_read_schema( ierr , output_obj, parinfo_obj, geninfo_obj ) + CALL init_vars_from_schema( 'ef', ierr , output_obj, parinfo_obj, geninfo_obj) + CALL errore( 'setup ', 'problem reading ef from file ' // & + & TRIM( tmp_dir ) // TRIM( prefix ) // '.save', ierr ) + CALL qes_reset ( output_obj ) + CALL qes_reset ( parinfo_obj ) + CALL qes_reset ( geninfo_obj ) + ! + END IF IF ( (lfcpopt .OR. lfcpdyn) .AND. restart ) THEN - CALL init_vars_from_schema( 'ef', ierr, output_obj, parinfo_obj, geninfo_obj) tot_charge = ionic_charge - nelec END IF ! @@ -548,15 +555,7 @@ SUBROUTINE setup() .AND. .NOT. ( calc == 'mm' .OR. calc == 'nm' ) ) & CALL infomsg( 'setup', 'Dynamics, you should have no symmetries' ) ! - IF ( lbands ) THEN - ! - ! ... if calculating bands, we read the Fermi energy - ! - CALL init_vars_from_schema( 'ef', ierr , output_obj, parinfo_obj, geninfo_obj) - CALL errore( 'setup ', 'problem reading ef from file ' // & - & TRIM( tmp_dir ) // TRIM( prefix ) // '.save', ierr ) - ! - ELSE IF ( ltetra ) THEN + IF ( ltetra ) THEN ! ! ... Calculate quantities used in tetrahedra method ! @@ -571,12 +570,6 @@ SUBROUTINE setup() END IF ! END IF - IF ( lbands .OR. ( (lfcpopt .OR. lfcpdyn ) .AND. restart ) ) THEN - CALL qes_reset ( output_obj ) - CALL qes_reset ( parinfo_obj ) - CALL qes_reset ( geninfo_obj ) - END IF - ! ! IF ( lsda ) THEN ! diff --git a/PW/src/wfcinit.f90 b/PW/src/wfcinit.f90 index 4922ff6a9..7753b4887 100644 --- a/PW/src/wfcinit.f90 +++ b/PW/src/wfcinit.f90 @@ -29,7 +29,7 @@ SUBROUTINE wfcinit() USE wavefunctions, ONLY : evc USE wvfct, ONLY : nbnd, npwx, current_k USE wannier_new, ONLY : use_wannier - USE pw_restart_new, ONLY : pw_readschema_file, read_collected_to_evc + USE pw_restart_new, ONLY : pw_read_schema, read_collected_to_evc USE qes_types_module, ONLY : output_type USE qes_libs_module, ONLY : qes_reset ! @@ -54,7 +54,7 @@ SUBROUTINE wfcinit() CALL open_buffer( iunwfc, 'wfc', nwordwfc, io_level, exst_mem, exst_file ) ! IF ( TRIM(starting_wfc) == 'file') THEN - CALL pw_readschema_file(IERR = ierr, RESTART_OUTPUT = output_obj ) + CALL pw_read_schema(IERR = ierr, RESTART_OUTPUT = output_obj ) IF ( ierr == 0 ) THEN twfcollect_file = output_obj%band_structure%wf_collected dirname = TRIM( tmp_dir ) // TRIM( prefix ) // postfix