More I/O cleanup: starting k-points

This commit is contained in:
Paolo Giannozzi 2019-07-11 22:32:55 +02:00
parent 2334e9c23a
commit 2207c16db9
3 changed files with 64 additions and 60 deletions

View File

@ -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

View File

@ -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.

View File

@ -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