diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index 2dc7bb1f9..f05e759a0 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -23,7 +23,7 @@ MODULE qexsd_copy qexsd_copy_atomic_species, qexsd_copy_atomic_structure, & qexsd_copy_symmetry, qexsd_copy_algorithmic_info, & qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_band_structure, & - qexsd_copy_efield, qexsd_copy_magnetization + qexsd_copy_efield, qexsd_copy_magnetization, qexsd_copy_kpoints ! CONTAINS !------------------------------------------------------------------------------- @@ -650,4 +650,56 @@ CONTAINS ! END SUBROUTINE qexsd_copy_magnetization !----------------------------------------------------------------------- + ! + !--------------------------------------------------------------------------- + SUBROUTINE qexsd_copy_kpoints ( band_struct_obj, nks_start, xk_start,& + wk_start, nk1, nk2, nk3, k1, k2, k3 ) + !--------------------------------------------------------------------------- + ! + USE qes_types_module, ONLY : band_structure_type + ! + IMPLICIT NONE + ! + TYPE ( band_structure_type ),INTENT(IN) :: band_struct_obj + INTEGER, INTENT(out) :: nks_start, nk1, nk2, nk3, k1, k2, k3 + REAL(dp), ALLOCATABLE, INTENT(inout) :: xk_start(:,:), wk_start(:) + ! + INTEGER :: ik + ! + ! + IF ( band_struct_obj%starting_k_points%monkhorst_pack_ispresent ) THEN + nks_start = 0 + nk1 = band_struct_obj%starting_k_points%monkhorst_pack%nk1 + nk2 = band_struct_obj%starting_k_points%monkhorst_pack%nk2 + nk3 = band_struct_obj%starting_k_points%monkhorst_pack%nk3 + k1 = band_struct_obj%starting_k_points%monkhorst_pack%k1 + k2 = band_struct_obj%starting_k_points%monkhorst_pack%k2 + k3 = band_struct_obj%starting_k_points%monkhorst_pack%k3 + ELSE IF (band_struct_obj%starting_k_points%nk_ispresent ) THEN + nks_start = band_struct_obj%starting_k_points%nk + IF ( nks_start > 0 ) THEN + IF ( .NOT. ALLOCATED(xk_start) ) ALLOCATE (xk_start(3,nks_start)) + IF ( .NOT. ALLOCATED(wk_start) ) ALLOCATE (wk_start(nks_start)) + IF ( nks_start == size( band_struct_obj%starting_k_points%k_point ) ) THEN + DO ik =1, nks_start + xk_start(:,ik) = band_struct_obj%starting_k_points%k_point(ik)%k_point(:) + IF ( band_struct_obj%starting_k_points%k_point(ik)%weight_ispresent) THEN + wk_start(ik) = band_struct_obj%starting_k_points%k_point(ik)%weight + ELSE + wk_start(ik) = 0.d0 + END IF + END DO + ELSE + CALL infomsg ( "qexsd_copy_kp: ", & + "actual number of start kpoint not equal to nks_start, set nks_start=0") + nks_start = 0 + END IF + END IF + ELSE + CALL errore ("qexsd_copy_kp: ", & + " no information found for initializing brillouin zone information", 1) + END IF + ! + END SUBROUTINE qexsd_copy_kpoints + ! END MODULE qexsd_copy diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index 8c334f58c..62a17b0df 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -40,7 +40,7 @@ MODULE pw_restart_new PRIVATE PUBLIC :: pw_write_schema, pw_write_binaries, pw_read_schema, & read_collected_to_evc - PUBLIC :: readschema_ef, readschema_occupations, readschema_brillouin_zone + PUBLIC :: readschema_ef, readschema_occupations ! CONTAINS !------------------------------------------------------------------------ @@ -1003,71 +1003,19 @@ MODULE pw_restart_new ! END SUBROUTINE pw_read_schema ! - ! - !--------------------------------------------------------------------------- - SUBROUTINE readschema_brillouin_zone( band_structure ) - !--------------------------------------------------------------------------- - ! - USE start_k, ONLY : nks_start, xk_start, wk_start, & - nk1, nk2, nk3, k1, k2, k3 - USE qes_types_module, ONLY : band_structure_type - ! - IMPLICIT NONE - ! - TYPE ( band_structure_type ),INTENT(IN) :: band_structure - INTEGER :: ik - ! - ! - IF ( band_structure%starting_k_points%monkhorst_pack_ispresent ) THEN - nks_start = 0 - nk1 = band_structure%starting_k_points%monkhorst_pack%nk1 - nk2 = band_structure%starting_k_points%monkhorst_pack%nk2 - nk3 = band_structure%starting_k_points%monkhorst_pack%nk3 - k1 = band_structure%starting_k_points%monkhorst_pack%k1 - k2 = band_structure%starting_k_points%monkhorst_pack%k2 - k3 = band_structure%starting_k_points%monkhorst_pack%k3 - ELSE IF (band_structure%starting_k_points%nk_ispresent ) THEN - nks_start = band_structure%starting_k_points%nk - IF ( nks_start > 0 ) THEN - IF ( .NOT. ALLOCATED(xk_start) ) ALLOCATE (xk_start(3,nks_start)) - IF ( .NOT. ALLOCATED(wk_start) ) ALLOCATE (wk_start(nks_start)) - IF ( nks_start == size( band_structure%starting_k_points%k_point ) ) THEN - DO ik =1, nks_start - xk_start(:,ik) = band_structure%starting_k_points%k_point(ik)%k_point(:) - IF ( band_structure%starting_k_points%k_point(ik)%weight_ispresent) THEN - wk_start(ik) = band_structure%starting_k_points%k_point(ik)%weight - ELSE - wk_start(ik) = 0.d0 - END IF - END DO - ELSE - 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 ("readschema_bz: ", & - " no information found for initializing brillouin zone information", 1) - END IF - ! - END SUBROUTINE readschema_brillouin_zone !-------------------------------------------------------------------------------------------------- SUBROUTINE readschema_occupations( band_struct_obj ) !------------------------------------------------------------------------------------------------ ! - USE lsda_mod, ONLY : lsda, nspin - USE fixed_occ, ONLY : tfixed_occ, f_inp USE ktetra, ONLY : ntetra, tetra_type USE klist, ONLY : ltetra, lgauss, ngauss, degauss, smearing - USE wvfct, ONLY : nbnd USE input_parameters, ONLY : input_parameters_occupations => occupations - USE qes_types_module, ONLY : input_type, band_structure_type + USE qes_types_module, ONLY : band_structure_type ! IMPLICIT NONE ! TYPE ( band_structure_type ),INTENT(IN) :: band_struct_obj - INTEGER :: ispin, nk1, nk2, nk3, aux_dim1, aux_dim2 + INTEGER :: nk1, nk2, nk3 ! lgauss = .FALSE. ltetra = .FALSE. diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 245e44d42..c264ef641 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -105,6 +105,8 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE force_mod, ONLY : force USE klist, ONLY : nks, nkstot, xk, wk, tot_magnetization, & nelec, nelup, neldw + USE start_k, ONLY : nks_start, xk_start, wk_start, & + nk1, nk2, nk3, k1, k2, k3 USE ener, ONLY : ef, ef_up, ef_dw USE electrons_base, ONLY : nupdwn, set_nelup_neldw USE wvfct, ONLY : npwx, nbnd, et, wg @@ -139,7 +141,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE paw_variables, ONLY : okpaw ! USE pw_restart_new, ONLY : pw_read_schema, & - readschema_occupations, readschema_brillouin_zone + readschema_occupations USE qes_types_module,ONLY : output_type, parallel_info_type, & general_info_type, input_type USE qes_libs_module, ONLY : qes_reset @@ -147,8 +149,8 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) qexsd_copy_algorithmic_info, qexsd_copy_atomic_species, & qexsd_copy_atomic_structure, qexsd_copy_symmetry, & qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_efield, & - qexsd_copy_band_structure, qexsd_copy_magnetization - + qexsd_copy_band_structure, qexsd_copy_magnetization, & + qexsd_copy_kpoints #if defined(__BEOWULF) USE qes_bcast_module,ONLY : qes_bcast USE mp_images, ONLY : intra_image_comm @@ -277,7 +279,9 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) END IF ! CALL readschema_occupations( output_obj%band_structure ) - CALL readschema_brillouin_zone( output_obj%band_structure ) + !! Starting k-òoint information + CALL qexsd_copy_kpoints( output_obj%band_structure, nks_start, & + xk_start, wk_start, nk1, nk2, nk3, k1, k2, k3 ) !! Symmetry section ALLOCATE ( irt(48,nat) ) IF ( lvalid_input ) THEN