scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity
quantum-espresso/GWW/gww/read_data_pw.f90

1628 lines
50 KiB
Fortran
Raw Permalink Blame History

!
! Copyright (C) 2001-2013 Quantum ESPRESSO group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
!these subroutines read in the data from PW calculations
SUBROUTINE read_data_pw_u(wu,prefix)
!this subroutine reads in the energies and the inversewannier transformation matrix
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures
USE mp, ONLY : mp_bcast, mp_barrier
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(wannier_u) :: wu!structure to be read and initialized
CHARACTER(LEN=256) :: prefix!to designate the PW files
INTEGER :: iunu
INTEGER :: iw,is
if(ionode) then
iunu = find_free_unit()
open( unit=iunu, file=trim(tmp_dir)//trim(prefix)//'.wannier', status='old',form='unformatted')
!read in basis length
read(iunu) wu%nspin
read(iunu) wu%nums
endif
call mp_bcast(wu%nspin, ionode_id, world_comm)
call mp_bcast(wu%nums, ionode_id, world_comm)
!allocate arrays
allocate(wu%ene(wu%nums,wu%nspin))
allocate(wu%ene_xc(wu%nums,wu%nspin))
allocate(wu%ene_lda_h(wu%nums,wu%nspin))
allocate(wu%umat(wu%nums,wu%nums,wu%nspin))
do is=1,wu%nspin
if(ionode) read(iunu) wu%nums_occ(is)
!write(stdout,*) 'DEBUG:', wu%nspin,wu%nums,wu%nums_occ(is)
!FLUSH(stdout)
call mp_bcast(wu%nums_occ(is), ionode_id, world_comm)
if(ionode) then
!read in energies
read(iunu) wu%ene(1:wu%nums,is)
!read in DFT exchange and correlation energies
read(iunu) wu%ene_xc(1:wu%nums,is)
read(iunu) wu%ene_lda_h(1:wu%nums,is)
!read in transformation matrix
do iw=1,wu%nums
read(iunu) wu%umat(1:wu%nums,iw,is)
enddo
endif
call mp_bcast(wu%ene(:,is), ionode_id, world_comm)
call mp_bcast(wu%ene_xc(:,is), ionode_id, world_comm)
call mp_bcast(wu%ene_lda_h(:,is), ionode_id, world_comm)
do iw=1,wu%nums
call mp_barrier( world_comm )
call mp_bcast(wu%umat(:,iw,is), ionode_id, world_comm)
enddo
enddo
if(ionode) close(iunu)
return
END
SUBROUTINE read_data_pw_v(vp,prefix,debug,ort,l_zero)
!read from file and initialize coulomb potential on the basis of products of wanniers
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE constants, ONLY : eps8
USE basic_structures
USE mp, ONLY : mp_bcast,mp_barrier
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(v_pot) :: vp!structure to be read and initialized
CHARACTER(LEN=256) :: prefix!to designate the PW files
LOGICAL :: debug!if true check for simmetry
INTEGER :: ort!if ort==0, open non orthogonal file, if ort == 1 open orthogonal file
!if ort==2 open non orthogonal symmetric file
LOGICAL :: l_zero!if true open file with head put to zero
INTEGER :: iunv
INTEGER :: iw,jw
if(ionode) then
iunv=find_free_unit()
if(ort==1) then
open( unit=iunv, file=trim(tmp_dir)//trim(prefix)//'.vpot', status='old',form='unformatted')
else if (ort==0) then
if(.not.l_zero) then
open( unit=iunv, file=trim(tmp_dir)//trim(prefix)//'.vpot_no', status='old',form='unformatted')
else
open( unit=iunv, file=trim(tmp_dir)//trim(prefix)//'.vpot_no_zero', status='old',form='unformatted')
endif
else if (ort==2) then
if(.not.l_zero) then
open( unit=iunv, file=trim(tmp_dir)//trim(prefix)//'.vpot_no_sym', status='old',form='unformatted')
else
open( unit=iunv, file=trim(tmp_dir)//trim(prefix)//'.vpot_no_sym_zero', status='old',form='unformatted')
endif
endif
!read in basis length
read(iunv) vp%numpw
endif
call mp_bcast(vp%numpw, ionode_id, world_comm)
!allocate array
allocate(vp%vmat(vp%numpw,vp%numpw))
!read in potential matrix
if(ionode) then
do iw=1,vp%numpw
read(iunv) vp%vmat(1:vp%numpw,iw)
enddo
endif
do iw=1,vp%numpw
call mp_barrier( world_comm )
call mp_bcast(vp%vmat(:,iw), ionode_id, world_comm)
enddo
!check
if(debug) then
do iw=1,vp%numpw
do jw=1,iw
if(abs(vp%vmat(iw,jw)-vp%vmat(jw,iw)) >= eps8) then
write(stdout,*) 'Proble vmat not simmetric:',iw,jw,vp%vmat(iw,jw)-vp%vmat(jw,iw)
endif
enddo
enddo
endif
if(ionode) close(iunv)
return
END SUBROUTINE
SUBROUTINE read_data_pw_q(qm,prefix,l_v_products)
!this subroutine reads in and allocate the arrays for the
!description of overlaps of (orthonormalized) products of wanniers
!with products of wannier
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures
USE mp, ONLY : mp_bcast, mp_barrier
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(q_mat) :: qm!structure to be read and initialized
CHARACTER(LEN=256) :: prefix!to designate the PW files
LOGICAL :: l_v_products!if true read the wp_v file for the products \tilde{w}_i(r)\tilde{w}_j(r)v(r,r')w^P_red_k(r')
INTEGER :: iunq
INTEGER :: iw
if(ionode) then
iunq=find_free_unit()
if(.not.l_v_products) then
open( unit=iunq, file=trim(tmp_dir)//trim(prefix)//'.wp', status='old',form='unformatted')
else
open( unit=iunq, file=trim(tmp_dir)//trim(prefix)//'.wp_v', status='old',form='unformatted')
endif
!read in basis length
read(iunq) qm%numpw
endif
call mp_bcast(qm%numpw, ionode_id, world_comm)
! allocate array of descriptors
allocate (qm%wp(qm%numpw))
do iw=1,qm%numpw
if(ionode) read(iunq) qm%wp(iw)%numij
call mp_bcast(qm%wp(iw)%numij, ionode_id, world_comm)
!for each descriptor allocates arrays
allocate(qm%wp(iw)%ij(2,qm%wp(iw)%numij))
allocate(qm%wp(iw)%o(qm%wp(iw)%numij))
!read data
if(ionode) then
read(iunq) qm%wp(iw)%ij(1,1:qm%wp(iw)%numij)
read(iunq) qm%wp(iw)%ij(2,1:qm%wp(iw)%numij)
read(iunq) qm%wp(iw)%o(1:qm%wp(iw)%numij)
end if
call mp_bcast(qm%wp(iw)%ij(:,:), ionode_id, world_comm)
call mp_bcast(qm%wp(iw)%o(:), ionode_id, world_comm)
enddo
qm%is_parallel=.false.
qm%numpw_para=qm%numpw
qm%first_para=1
if(ionode) close(iunq)
return
END SUBROUTINE
SUBROUTINE read_data_pw_ortho_polaw(op,prefix)
!this subroutine reads in and allocate the arrays for the
!description of orthonormalization matrix of wanniers products
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures, ONLY : ortho_polaw, free_memory
USE mp, ONLY : mp_bcast, mp_barrier
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(ortho_polaw) :: op!structure to be read and initialized
CHARACTER(LEN=256) :: prefix!to designate the PW files
INTEGER :: iunq
INTEGER :: iw
! call free_memory(op)
if(ionode) then
iunq=find_free_unit()
open( unit=iunq, file=trim(tmp_dir)//trim(prefix)//'.orthonorm', status='old',form='unformatted')
!read in basis length
read(iunq) op%numpw
endif
call mp_bcast(op%numpw, ionode_id, world_comm)
allocate(op%on_mat(op%numpw,op%numpw))
if(ionode) then
do iw=1,op%numpw
read(iunq) op%on_mat(1:op%numpw,iw)
enddo
end if
do iw=1,op%numpw
call mp_barrier( world_comm )
call mp_bcast( op%on_mat(:,iw), ionode_id, world_comm)
enddo
op%inverse=.false.
if(ionode) close(iunq)
END subroutine
SUBROUTINE read_data_pw_wp_psi(wp,prefix)
!this subroutine reads in and allocate the arrays for the
!description of products of valence^2 times two wannier products
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures, ONLY : wp_psi, free_memory
USE mp, ONLY : mp_bcast
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(wp_psi) :: wp!structure to be read and initialized
CHARACTER(LEN=256) :: prefix!to designate the PW files
INTEGER :: iunq
INTEGER :: iw,hw, jw
! call free_memory(wp)
if(ionode) then
iunq=find_free_unit()
open( unit=iunq, file=trim(tmp_dir)//trim(prefix)//'.wpwp_psi', status='old',form='unformatted')
!read in basis length
read(iunq) wp%numpw
read(iunq) wp%nums_psi
endif
call mp_bcast(wp%numpw, ionode_id, world_comm)
call mp_bcast(wp%nums_psi, ionode_id, world_comm)
allocate(wp%wwp(wp%numpw,wp%numpw,wp%nums_psi))
do hw=1,wp%nums_psi
if(ionode) then
do iw=1,wp%numpw
read(iunq) wp%wwp(iw,1:iw,hw)
enddo
do iw=1,wp%numpw
do jw=iw, wp%numpw
wp%wwp(iw,jw,hw)=wp%wwp(jw,iw,hw)
enddo
enddo
endif
call mp_bcast( wp%wwp(:,:,hw), ionode_id, world_comm)
enddo
if(ionode) close(iunq)
END subroutine
SUBROUTINE read_data_pw_u_prim(wu,prefix)
!this subroutine reads in the inverse wannier transformation matrix
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures
USE mp, ONLY : mp_bcast, mp_barrier
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(wannier_u_prim) :: wu!structure to be read and initialized
CHARACTER(LEN=256) :: prefix!to designate the PW files
INTEGER :: iunu
INTEGER :: iw
if(ionode) then
iunu = find_free_unit()
open( unit=iunu, file=trim(tmp_dir)//trim(prefix)//'.wannier_prim', status='old',form='unformatted')
!read in basis length
read(iunu) wu%nums_prim
read(iunu) wu%nums_occ
read(iunu) wu%nums
write(*,*) 'read_data_pw_u_prim',wu%nums_prim,wu%nums_occ,wu%nums
endif
call mp_bcast(wu%nums_prim, ionode_id, world_comm)
call mp_bcast(wu%nums_occ, ionode_id, world_comm)
call mp_bcast(wu%nums, ionode_id, world_comm)
!allocate arrays
allocate(wu%umat(wu%nums_prim,wu%nums_prim))
if(ionode) then
!read in transformation matrix
do iw=1,wu%nums_prim
read(iunu) wu%umat(1:wu%nums_prim,iw)
enddo
endif
do iw=1,wu%nums_prim
call mp_barrier( world_comm )
call mp_bcast(wu%umat(:,iw), ionode_id, world_comm)
enddo
if(ionode) close(iunu)
return
END SUBROUTINE read_data_pw_u_prim
SUBROUTINE read_data_pw_v_pot_prim(vp,prefix, l_zero)
!this subroutine reads in the coulombian potential and the overlap index
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures
USE mp, ONLY : mp_bcast, mp_barrier
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(v_pot_prim) :: vp!structure to be read and initialized
CHARACTER(LEN=256) :: prefix!to designate the PW files
LOGICAL :: l_zero!if true opens file with head of v pu to zero
INTEGER :: iunu
INTEGER :: iw
if(ionode) then
iunu = find_free_unit()
if(.not. l_zero) then
open( unit=iunu, file=trim(tmp_dir)//trim(prefix)//'.uterms_prim', status='old',form='unformatted')
else
open( unit=iunu, file=trim(tmp_dir)//trim(prefix)//'.uterms_prim_zero', status='old',form='unformatted')
endif
!read in basis length
read(iunu) vp%numpw_prim
read(iunu) vp%numpw
write(*,*) 'read_data_pw_v_pot_prim', vp%numpw_prim,vp%numpw
endif
call mp_bcast(vp%numpw, ionode_id, world_comm)
call mp_bcast(vp%numpw_prim, ionode_id, world_comm)
!allocate arrays
allocate(vp%vmat(vp%numpw_prim,vp%numpw))
allocate(vp%ij(2,vp%numpw_prim))
if(ionode) then
!read in transformation matrix
do iw=1,vp%numpw_prim
read(iunu) vp%vmat(iw,1:vp%numpw)
enddo
close(iunu)
endif
do iw=1,vp%numpw
call mp_barrier( world_comm )
call mp_bcast(vp%vmat(:,iw), ionode_id, world_comm)
enddo
if(ionode) then
iunu = find_free_unit()
open( unit=iunu, file=trim(tmp_dir)//trim(prefix)//'.ij_prim', status='old',form='unformatted')
do iw=1,vp%numpw_prim
read(iunu) vp%ij(1,iw),vp%ij(2,iw)
enddo
close(iunu)
endif
call mp_bcast(vp%ij(:,:), ionode_id, world_comm)
vp%is_parallel=.false.
vp%numpw_para=vp%numpw
vp%first_para=1
return
END SUBROUTINE read_data_pw_v_pot_prim
SUBROUTINE read_data_pw_wp_psi_cutoff_index(wpi,prefix)
!this subroutine reads in and allocate the arrays for the
!indices describing of products of valence^2 times two wannier products
!when a cutoff is applied
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures, ONLY : wp_psi_cutoff_index, free_memory
USE mp, ONLY : mp_bcast
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(wp_psi_cutoff_index) :: wpi!structure to be read and initialized
CHARACTER(LEN=256) :: prefix!to designate the PW files
INTEGER :: iuni
INTEGER :: i
if(ionode) then
iuni=find_free_unit()
open( unit=iuni, file=trim(tmp_dir)//trim(prefix)//'.wpwp_psi_index', status='old',form='unformatted')
!read in basis length
read(iuni) wpi%numpw
read(iuni) wpi%nums_psi
read(iuni) wpi%numpwpw
endif
call mp_bcast(wpi%numpw, ionode_id, world_comm)
call mp_bcast(wpi%nums_psi, ionode_id, world_comm)
call mp_bcast(wpi%numpwpw, ionode_id, world_comm)
allocate(wpi%index(2,wpi%numpwpw))
if(ionode) then
do i=1,wpi%numpwpw
read(iuni) wpi%index(1,i),wpi%index(2,i)
enddo
close(iuni)
endif
call mp_bcast(wpi%index, ionode_id, world_comm)
return
END SUBROUTINE read_data_pw_wp_psi_cutoff_index
SUBROUTINE read_data_pw_wp_psi_cutoff_data(wpi,wp,prefix)
!this subroutine reads in and allocate the arrays for the
!products of valence^2 times two wannier products when a cutoff is applied
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures, ONLY : wp_psi_cutoff_index, wp_psi_cutoff_data,free_memory
USE mp, ONLY : mp_bcast
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(wp_psi_cutoff_index), INTENT(in) :: wpi!indices
TYPE(wp_psi_cutoff_data), INTENT(inout) :: wp!data to be read
CHARACTER(LEN=256), INTENT(in) :: prefix!to designate the PW files
INTEGER :: iund
INTEGER :: i, pos,state
REAL(kind=DP) :: w
wp%numpw=wpi%numpw
wp%nums_psi=wpi%nums_psi
wp%numpwpw=wpi%numpwpw
allocate(wp%wwp(wp%numpwpw,wp%nums_psi))
if(ionode) then
iund=find_free_unit()
open( unit=iund, file=trim(tmp_dir)//trim(prefix)//'.wpwp_psi', status='old',form='unformatted')
!read in basis length
do i=1,wp%nums_psi*wp%numpwpw
read(iund) pos,state,w
wp%wwp(pos,state)=w
enddo
close(iund)
endif
do i=1,wp%nums_psi
call mp_bcast(wp%wwp(:,i), ionode_id, world_comm)
enddo
return
END SUBROUTINE read_data_pw_wp_psi_cutoff_data
SUBROUTINE read_data_pw_exchange(ene_x,max_i,prefix,nspin)
!this subroutine reads in the exchange energies
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures
USE mp, ONLY : mp_bcast
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
REAL(kind=DP) :: ene_x(max_i,nspin)
INTEGER :: max_i
CHARACTER(LEN=256) :: prefix!to designate the PW files
INTEGER, INTENT(in) :: nspin!spin multiplicity
INTEGER :: iunu
INTEGER :: ndata,is
REAL(kind=DP), ALLOCATABLE :: buf(:)
if(ionode) then
iunu = find_free_unit()
open( unit=iunu, file=trim(tmp_dir)//trim(prefix)//'.exchange', status='old',form='unformatted')
read(iunu) ndata
allocate(buf(ndata))
do is=1,nspin
read(iunu) buf(1:ndata)
ene_x(1:max_i,is)=buf(1:max_i)
enddo
close(iunu)
deallocate(buf)
endif
call mp_bcast(ene_x, ionode_id,world_comm)
return
end SUBROUTINE read_data_pw_exchange
SUBROUTINE read_data_pw_exchange_off(ene_x_off,max_i,prefix,nspin)
!this subroutine reads in the whole fock matrix
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures
USE mp, ONLY : mp_bcast
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
REAL(kind=DP) :: ene_x_off(max_i,max_i,nspin)
INTEGER :: max_i
CHARACTER(LEN=256) :: prefix!to designate the PW files
INTEGER, INTENT(in) :: nspin!spin multiplicity
INTEGER :: iunu
INTEGER :: ndata,is,ii
REAL(kind=DP), ALLOCATABLE :: buf(:)
if(ionode) then
iunu = find_free_unit()
open( unit=iunu, file=trim(tmp_dir)//trim(prefix)//'.exchange_off', status='old',form='unformatted')
read(iunu) ndata
allocate(buf(ndata))
do is=1,nspin
do ii=1,ndata
read(iunu) buf(1:ndata)
if(ii<=max_i) ene_x_off(1:max_i,ii,is)=buf(1:max_i)
enddo
enddo
close(iunu)
deallocate(buf)
endif
call mp_bcast(ene_x_off, ionode_id,world_comm)
return
end SUBROUTINE read_data_pw_exchange_off
SUBROUTINE read_data_pw_head_epsilon(he, prefix, l_wing_epsilon, l_gzero)
!this subroutine reads the data
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures, ONLY : head_epsilon
USE mp, ONLY : mp_bcast, mp_barrier
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(head_epsilon) :: he!the head of epsilon to be read
CHARACTER(LEN=256) :: prefix!to designate the PW files
LOGICAL :: l_wing_epsilon!if true read from file also the wing data
LOGICAL :: l_gzero!if true reads also gzero otherwise is initialized to 0
INTEGER :: iun,i, idumm,ipol
REAL(kind=DP) :: rdumm
if(ionode) then
iun = find_free_unit()
open( unit=iun, file=trim(tmp_dir)//'/_ph0/'//trim(prefix)//'.head', status='old',form='unformatted')
read(iun) he%n
read(iun) he%omega
endif
call mp_bcast(he%n, ionode_id,world_comm)
call mp_bcast(he%omega, ionode_id,world_comm)
allocate(he%freqs(he%n+1))
allocate(he%head(he%n+1,3))
if(ionode) then
read(iun) he%freqs(1:he%n+1)
do ipol=1,3
read(iun) he%head(1:he%n+1,ipol)
enddo
close(iun)
endif
call mp_bcast(he%freqs, ionode_id,world_comm)
call mp_bcast(he%head, ionode_id,world_comm)
if(ionode) then
iun = find_free_unit()
open( unit=iun, file=trim(tmp_dir)//trim(prefix)//'.wing', status='old',form='unformatted')
read(iun) idumm
read(iun) rdumm
if(idumm /= he%n) then
write(stdout,*) 'WING: PROBLEM WITH N'
endif
if(rdumm /= he%omega) then
write(stdout,*) 'WING: PROBLEM WITH OMEGA'
endif
read(iun) he%numpw
endif
call mp_bcast(he%numpw, ionode_id,world_comm)
allocate(he%wing(he%numpw, he%n+1,3))
allocate(he%wing_c(he%numpw, he%n+1,3))
! if(idumm /= he%numpw) then
! write(stdout,*) 'WING: PROBLEM WITH NUMPW', idumm, he%numpw
! endif
if(ionode) then
do ipol=1,3
do i=1,he%n+1
read(iun) he%wing(1:he%numpw,i,ipol)
enddo
enddo
! do i=1,he%n+1
! read(iun) he%wing_c(1:he%numpw,i,ipol)
! enddo
close(iun)
endif
! do i=1,he%n+1
! call mp_barrier
!
! call mp_bcast(he%wing(:,i), ionode_id,world_comm)
! call mp_bcast(he%wing_c(:,i), ionode_id,world_comm)
! enddo
call mp_bcast(he%wing, ionode_id,world_comm)
if(l_gzero) then
if(ionode) then
iun = find_free_unit()
open( unit=iun, file=trim(tmp_dir)//trim(prefix)//'.gzero', status='old',form='unformatted')
read(iun) idumm
if(idumm /= he%numpw) then
write(stdout,*) 'WING: PROBLEM WITH NUMPW', idumm, he%numpw
endif
endif
allocate(he%gzero(he%numpw))
if(ionode) then
do i=1,he%numpw
read(iun) he%gzero(i)
enddo
close(iun)
endif
call mp_bcast(he%gzero,ionode_id,world_comm)
else
allocate(he%gzero(he%numpw))
he%gzero(1:he%numpw)=0.d0
endif
return
END SUBROUTINE read_data_pw_head_epsilon
SUBROUTINE read_data_pw_cprim_prod(cpp, prefix, l_vc, ok_read, l_vcw_overlap, l_upper)
!this subroutine read the products cprim c v\tilde{w^P} from disk
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures, ONLY : cprim_prod,free_memory
USE mp, ONLY : mp_bcast, mp_barrier
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(cprim_prod) :: cpp!the structure to be read
CHARACTER(LEN=256) :: prefix!to designate the PW files
LOGICAL :: l_vc !if true reads in the vc terms
LOGICAL, INTENT(out) :: ok_read!if true effectively read otherwise the file doesn't exist
LOGICAL, INTENT(in) :: l_vcw_overlap!if true read the overlaps v c w
LOGICAL, INTENT(in) :: l_upper!if true reads data for reduced upper states
CHARACTER(4) :: nfile
INTEGER :: iunsterms, icp, i
call free_memory(cpp)
if(.not.l_vcw_overlap) then
if(ionode) then
write(nfile,'(4i1)') &
& cpp%cprim/1000,mod(cpp%cprim,1000)/100,mod(cpp%cprim,100)/10,mod(cpp%cprim,10)
if(.not.l_upper) then
if(.not. l_vc) then
inquire(file=trim(tmp_dir)//trim(prefix)//'.cprim.'//nfile,exist=ok_read)
else
inquire(file=trim(tmp_dir)//trim(prefix)//'.vcprim.'//nfile,exist=ok_read)
endif
else
if(.not. l_vc) then
inquire(file=trim(tmp_dir)//trim(prefix)//'.cprim_up.'//nfile,exist=ok_read)
else
inquire(file=trim(tmp_dir)//trim(prefix)//'.vcprim_up.'//nfile,exist=ok_read)
endif
endif
endif
call mp_bcast(ok_read, ionode_id,world_comm)
if(.not. ok_read) return
endif
if(ionode) then
iunsterms = find_free_unit()
write(nfile,'(4i1)') &
& cpp%cprim/1000,mod(cpp%cprim,1000)/100,mod(cpp%cprim,100)/10,mod(cpp%cprim,10)
if(.not.l_upper) then
if(l_vcw_overlap) then
open( unit= iunsterms, file=trim(tmp_dir)//trim(prefix)//'.vcw_overlap.'//nfile, status='old',form='unformatted')
else
if(.not. l_vc) then
open( unit= iunsterms, file=trim(tmp_dir)//trim(prefix)//'.cprim.'//nfile, status='old',form='unformatted')
else
open( unit= iunsterms, file=trim(tmp_dir)//trim(prefix)//'.vcprim.'//nfile, status='old',form='unformatted')
endif
endif
else
if(l_vcw_overlap) then
open( unit= iunsterms, file=trim(tmp_dir)//trim(prefix)//'.vcw_up_overlap.'//nfile, status='old',form='unformatted')
else
if(.not. l_vc) then
open( unit= iunsterms, file=trim(tmp_dir)//trim(prefix)//'.cprim_up.'//nfile, status='old',form='unformatted')
else
open( unit= iunsterms, file=trim(tmp_dir)//trim(prefix)//'.vcprim_up.'//nfile, status='old',form='unformatted')
endif
endif
endif
read(iunsterms) icp
if(icp /= cpp%cprim) then
write(stdout,*) 'PROBLEM WITH CPRIM_PROD'
stop
endif
read(iunsterms) cpp%nums_occ
read(iunsterms) cpp%nums!DIFFERENT MEANING FOR UPPER STATES
read(iunsterms) cpp%numpw
endif
call mp_bcast(cpp%nums_occ, ionode_id,world_comm)
call mp_bcast(cpp%nums, ionode_id,world_comm)
call mp_bcast(cpp%numpw, ionode_id,world_comm)
cpp%nums_cond=cpp%nums-cpp%nums_occ
if(.not.l_vc .or. l_vcw_overlap .and. .not.l_upper) then
allocate(cpp%cpmat(cpp%numpw,cpp%nums_cond))
else
allocate(cpp%cpmat(cpp%numpw,cpp%nums))
endif
cpp%lda=cpp%numpw
if(.not. l_vc .or. l_vcw_overlap .and. .not.l_upper) then
do i=1,cpp%nums_cond
call mp_barrier( world_comm )
if(ionode) read(iunsterms) cpp%cpmat(1:cpp%numpw,i)
call mp_bcast(cpp%cpmat(:,i), ionode_id,world_comm)
enddo
else
do i=1,cpp%nums
call mp_barrier( world_comm )
if(ionode) read(iunsterms) cpp%cpmat(1:cpp%numpw,i)
call mp_bcast(cpp%cpmat(:,i), ionode_id,world_comm)
enddo
endif
if(ionode) close(iunsterms)
cpp%is_parallel=.false.
cpp%numpw_para=cpp%numpw
cpp%first_para=1
return
END SUBROUTINE read_data_pw_cprim_prod
SUBROUTINE read_data_pw_dft_xc(ene_dft_xc,max_i,prefix)
!this subroutine reads in the exchange energies
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures
USE mp, ONLY : mp_bcast
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
REAL(kind=DP) :: ene_dft_xc(max_i)
INTEGER :: max_i
CHARACTER(LEN=256) :: prefix!to designate the PW files
INTEGER :: iunu, i,nn
if(ionode) then
iunu = find_free_unit()
open( unit=iunu, file=trim(tmp_dir)//trim(prefix)//'.dft_xc', status='old',form='unformatted')
read(iunu) nn
do i=1,max_i
read(iunu) ene_dft_xc(i)
enddo
endif
call mp_bcast(ene_dft_xc(1:max_i), ionode_id, world_comm)
return
end SUBROUTINE read_data_pw_dft_xc
SUBROUTINE read_data_pw_dft_xc_off(ene_dft_xc_off,max_i,prefix,ispin)
!this subroutine reads in the exchange energies
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures
USE mp, ONLY : mp_bcast
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
REAL(kind=DP) :: ene_dft_xc_off(max_i,max_i)
INTEGER :: max_i
CHARACTER(LEN=256) :: prefix!to designate the PW files
INTEGER, INTENT(in) :: ispin! spin channel
INTEGER :: iunu, ibnd,nn
if(ionode) then
iunu = find_free_unit()
if(ispin==1) then
open(unit=iunu,file=trim(tmp_dir)//trim(prefix)//'.exc_off',status='old',form='unformatted')
else
open(unit=iunu,file=trim(tmp_dir)//trim(prefix)//'.exc_off2',status='old',form='unformatted')
endif
read(iunu) nn
do ibnd=1,nn
if(ibnd<=max_i) read(iunu) ene_dft_xc_off(1:max_i,ibnd)
enddo
close(iunu)
endif
call mp_bcast(ene_dft_xc_off, ionode_id, world_comm)
return
end SUBROUTINE read_data_pw_dft_xc_off
SUBROUTINE read_data_pw_upper_states(us,prefix)
!this subroutine reads in the upper REDUCED states
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures
USE mp, ONLY : mp_bcast
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(upper_states) :: us!structure to be read and initialized
CHARACTER(LEN=256) :: prefix!to designate the PW files
INTEGER :: iunu
INTEGER :: ii
if(ionode) then
iunu = find_free_unit()
open( unit=iunu, file=trim(tmp_dir)//trim(prefix)//'.upper', status='old',form='unformatted')
read(iunu) us%nums_tot
read(iunu) us%nums
read(iunu) us%nums_occ
read(iunu) us%nums_reduced
endif
call mp_bcast(us%nums_tot, ionode_id, world_comm)
call mp_bcast(us%nums, ionode_id, world_comm)
call mp_bcast(us%nums_occ, ionode_id, world_comm)
call mp_bcast(us%nums_reduced, ionode_id, world_comm)
allocate(us%ene(us%nums_reduced))
if(ionode) then
do ii=1,us%nums_reduced
read(iunu) us%ene(ii)
enddo
close(iunu)
endif
call mp_bcast(us%ene(:),ionode_id, world_comm)
return
END SUBROUTINE read_data_pw_upper_states
SUBROUTINE read_data_pw_vt_mat_lanczos(vtl, ii, prefix, l_pola, ispin)
!this subroutine reads the terms V^v_{v,l}=<Pc w_v(r)w^P_i(r)|z^v_l> from disk
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures, ONLY : vt_mat_lanczos,free_memory,initialize_memory
USE mp, ONLY : mp_bcast, mp_barrier, mp_sum
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(vt_mat_lanczos) :: vtl!the structure to be read
CHARACTER(LEN=256) :: prefix!to designate the PW files
LOGICAL :: l_pola !if true reads the terms for the polarization, otherwise for the self-energy
INTEGER :: ii!state to be read
INTEGER, INTENT(in) :: ispin!spin channel
CHARACTER(4) :: nfile
INTEGER :: iuntmat, il
INTEGER, PARAMETER :: offset=0!ATTENZIONE RESTART it should be 0 normalwise
call initialize_memory(vtl)
call free_memory(vtl)
vtl%ii=ii
write(nfile,'(4i1)') &
& vtl%ii/1000,mod(vtl%ii,1000)/100,mod(vtl%ii,100)/10,mod(vtl%ii,10)
if(ionode) then
iuntmat=find_free_unit()
if(ispin==1) then
if(l_pola) then
open( unit= iuntmat, file=trim(tmp_dir)//trim(prefix)//'.p_mat_lanczos'//nfile, status='old',form='unformatted')
else
open( unit= iuntmat, file=trim(tmp_dir)//trim(prefix)//'.s_mat_lanczos'//nfile, status='old',form='unformatted')
endif
else
if(l_pola) then
open( unit= iuntmat, file=trim(tmp_dir)//trim(prefix)//'.p_mat_lanczos2'//nfile, status='old',form='unformatted')
else
open( unit= iuntmat, file=trim(tmp_dir)//trim(prefix)//'.s_mat_lanczos2'//nfile, status='old',form='unformatted')
endif
endif
read(iuntmat) vtl%ii
read(iuntmat) vtl%nums_occ
read(iuntmat) vtl%numpw
read(iuntmat) vtl%numl
vtl%numl=vtl%numl-offset
endif
call mp_bcast(vtl%nums_occ,ionode_id, world_comm)
call mp_bcast(vtl%numpw,ionode_id, world_comm)
call mp_bcast(vtl%numl,ionode_id, world_comm)
allocate(vtl%vt_mat(vtl%numpw,vtl%numl))
if(ionode) then
do il=1,offset
read(iuntmat) vtl%vt_mat(1:vtl%numpw,1)
enddo
endif
do il=offset+1,vtl%numl+offset
!call mp_barrier( world_comm )
if(ionode) then
read(iuntmat) vtl%vt_mat(1:vtl%numpw,il-offset)
else
vtl%vt_mat(1:vtl%numpw,il-offset)=0.d0
endif
!call mp_bcast(vtl%vt_mat(:,il),ionode_id, world_comm)
!call mp_sum(vtl%vt_mat(1:vtl%numpw,il))
enddo
call mp_bcast(vtl%vt_mat,ionode_id, world_comm)
if(ionode) close(iuntmat)
return
END SUBROUTINE read_data_pw_vt_mat_lanczos
SUBROUTINE read_data_pw_mat_lanczos_full(fl, ii, prefix)
!this subroutine read the full relativistic overlaps
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures, ONLY : mat_lanczos_full,free_memory,initialize_memory
USE mp, ONLY : mp_bcast, mp_barrier, mp_sum
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(mat_lanczos_full) :: fl!the structure to be read
CHARACTER(LEN=256) :: prefix!to designate the PW files
INTEGER :: ii!state to be read
CHARACTER(4) :: nfile
INTEGER :: iun, iw,idumm
fl%ii=ii
write(nfile,'(4i1)') &
&fl%ii/1000,mod(fl%ii,1000)/100,mod(fl%ii,100)/10,mod(fl%ii,10)
call initialize_memory(fl)
if(ionode) then
iun=find_free_unit()
open( unit= iun, file=trim(tmp_dir)//trim(prefix)//'.s_mat_lanczos_full'//nfile, status='old',form='unformatted')
read(iun) idumm
read(iun) fl%numpw
read(iun) fl%nums
endif
call mp_bcast(fl%numpw, ionode_id, world_comm)
call mp_bcast(fl%nums, ionode_id, world_comm)
allocate(fl%f_mat(fl%numpw,fl%nums,2))
if(ionode) then
do iw=1,fl%nums
read(iun) fl%f_mat(1:fl%numpw,iw,1)
enddo
do iw=1,fl%nums
read(iun) fl%f_mat(1:fl%numpw,iw,2)
enddo
close(iun)
endif
call mp_bcast(fl%f_mat, ionode_id, world_comm)
return
END SUBROUTINE read_data_pw_mat_lanczos_full
SUBROUTINE read_data_pw_tt_mat_lanczos(ttl, ii, prefix, l_pola,ispin)
!this subroutine reads the termsT^v_{i,j}=<z^v_i|t_j> from disk
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures, ONLY : tt_mat_lanczos,free_memory,initialize_memory
USE mp, ONLY : mp_bcast, mp_barrier, mp_sum
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(tt_mat_lanczos) :: ttl!the structure to be read
CHARACTER(LEN=256) :: prefix!to designate the PW files
LOGICAL :: l_pola !if true reads the terms for the polarization, otherwise for the self-energy
INTEGER :: ii!state to be read
INTEGER, INTENT(in) :: ispin!spin channel
CHARACTER(4) :: nfile
INTEGER :: iuntmat, il
call initialize_memory(ttl)
call free_memory(ttl)
ttl%ii=ii
write(nfile,'(4i1)') &
& ttl%ii/1000,mod(ttl%ii,1000)/100,mod(ttl%ii,100)/10,mod(ttl%ii,10)
if(ionode) then
iuntmat=find_free_unit()
if(ispin==1) then
if(l_pola) then
open( unit= iuntmat, file=trim(tmp_dir)//trim(prefix)//'.pt_mat_lanczos'//nfile, status='old',form='unformatted')
else
open( unit= iuntmat, file=trim(tmp_dir)//trim(prefix)//'.st_mat_lanczos'//nfile, status='old',form='unformatted')
endif
else
if(l_pola) then
open( unit= iuntmat, file=trim(tmp_dir)//trim(prefix)//'.pt_mat_lanczos2'//nfile, status='old',form='unformatted')
else
open( unit= iuntmat, file=trim(tmp_dir)//trim(prefix)//'.st_mat_lanczos2'//nfile, status='old',form='unformatted')
endif
endif
read(iuntmat) ttl%numt
read(iuntmat) ttl%numl
read(iuntmat) ttl%ii
endif
call mp_bcast(ttl%numt,ionode_id, world_comm)
call mp_bcast(ttl%numl,ionode_id, world_comm)
allocate(ttl%tt_mat(ttl%numt,ttl%numl))
do il=1,ttl%numl
!call mp_barrier
if(ionode) then
read(iuntmat) ttl%tt_mat(1:ttl%numt,il)
else
ttl%tt_mat(1:ttl%numt,il)=0.d0
endif
!call mp_bcast(ttl%tt_mat(:,il),ionode_id, world_comm)
!call mp_sum( ttl%tt_mat(1:ttl%numt,il))
enddo
call mp_bcast(ttl%tt_mat,ionode_id, world_comm)
if(ionode) close(iuntmat)
return
END SUBROUTINE read_data_pw_tt_mat_lanczos
SUBROUTINE read_data_pw_lanczos_chain(lc, ii, prefix, l_pola,ispin)
!this subroutine reads the lanczos chain descriptor from disk
!the date are distributed over the processors
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures, ONLY : lanczos_chain,free_memory,initialize_memory
USE mp, ONLY : mp_bcast, mp_barrier, mp_sum
USE mp_world, ONLY : nproc,mpime, world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(lanczos_chain) :: lc!the structure to be read
CHARACTER(LEN=256) :: prefix!to designate the PW files
LOGICAL :: l_pola !if true reads the terms for the polarization, otherwise for the self-energy
INTEGER :: ii!state to be read , only for self-energy
INTEGER, INTENT(in) :: ispin!spin multiplicity
CHARACTER(4) :: nfile
INTEGER :: iunlc, is,it
INTEGER :: l_blk,nbegin,nend
REAL(kind=DP), ALLOCATABLE :: tmp_mat(:)
call initialize_memory(lc)
call free_memory(lc)
lc%ii=ii
write(nfile,'(4i1)') &
& lc%ii/1000,mod(lc%ii,1000)/100,mod(lc%ii,100)/10,mod(lc%ii,10)
if(ionode) then
iunlc=find_free_unit()
if(ispin==1) then
if(l_pola) then
open( unit= iunlc, file=trim(tmp_dir)//trim(prefix)//'.p_iter_lanczos', status='old',form='unformatted')
else
open( unit= iunlc, file=trim(tmp_dir)//trim(prefix)//'.s_iter_lanczos'//'_'//nfile, status='old',form='unformatted')
endif
else
if(l_pola) then
open( unit= iunlc, file=trim(tmp_dir)//trim(prefix)//'.p_iter_lanczos2', status='old',form='unformatted')
else
open( unit= iunlc, file=trim(tmp_dir)//trim(prefix)//'.s_iter_lanczos2'//'_'//nfile, status='old',form='unformatted')
endif
endif
read(iunlc) lc%numt
read(iunlc) lc%ii
read(iunlc) lc%num_steps
endif
write(*,*) lc%numt, lc%ii,lc%num_steps
call mp_bcast(lc%numt,ionode_id, world_comm)
call mp_bcast(lc%num_steps,ionode_id, world_comm)
l_blk= (lc%numt)/nproc
if(l_blk*nproc < (lc%numt)) l_blk = l_blk+1
nbegin=mpime*l_blk+1
nend=nbegin+l_blk-1
allocate(tmp_mat(lc%numt))
allocate(lc%o_mat(lc%numt,lc%num_steps,l_blk))
allocate(lc%d(lc%num_steps,lc%numt))
allocate(lc%f(lc%num_steps,lc%numt))
do is=1,lc%num_steps
do it=1,lc%numt
tmp_mat(1:lc%numt)=0.d0
if(ionode) read(iunlc) tmp_mat(1:lc%numt)
call mp_sum(tmp_mat(:),world_comm)!this should be faster than mp_bcat
if(it >= nbegin .and. it <= nend) then
lc%o_mat(1:lc%numt,is,it-nbegin+1)= tmp_mat(1:lc%numt)
endif
! if(ionode) read(iunlc) lc%o_mat(1:lc%numt,is,it)
! call mp_barrier
! call mp_bcast(lc%o_mat(1:lc%numt,is,it),ionode_id, world_comm)
enddo
enddo
do it=1,lc%numt
if(ionode) read(iunlc) lc%d(1:lc%num_steps,it)
call mp_barrier( world_comm )
call mp_bcast(lc%d(1:lc%num_steps,it),ionode_id, world_comm)
enddo
do it=1,lc%numt
if(ionode) read(iunlc) lc%f(1:lc%num_steps,it)
call mp_barrier( world_comm )
call mp_bcast(lc%f(1:lc%num_steps,it),ionode_id, world_comm)
enddo
if(ionode) close(iunlc)
deallocate(tmp_mat)
return
END SUBROUTINE read_data_pw_lanczos_chain
SUBROUTINE read_data_pw_vt_mat_lanczos_single(vtl, ii, prefix, l_pola)
!this subroutine reads the terms V^v_{v,l}=<Pc w_v(r)w^P_i(r)|z^v_l> from disk
!single processor version
USE kinds, ONLY : DP
USE basic_structures, ONLY : vt_mat_lanczos,free_memory,initialize_memory
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(vt_mat_lanczos) :: vtl!the structure to be read
CHARACTER(LEN=256) :: prefix!to designate the PW files
LOGICAL :: l_pola !if true reads the terms for the polarization, otherwise for the self-energy
INTEGER :: ii!state to be read
CHARACTER(4) :: nfile
INTEGER :: iuntmat, il
INTEGER, PARAMETER :: offset=0!ATTENZIONE RESTART it should be 0 normalwise
call initialize_memory(vtl)
call free_memory(vtl)
vtl%ii=ii
write(nfile,'(4i1)') &
& vtl%ii/1000,mod(vtl%ii,1000)/100,mod(vtl%ii,100)/10,mod(vtl%ii,10)
iuntmat=find_free_unit()
if(l_pola) then
open( unit= iuntmat, file=trim(tmp_dir)//trim(prefix)//'.p_mat_lanczos'//nfile, status='old',form='unformatted')
else
open( unit= iuntmat, file=trim(tmp_dir)//trim(prefix)//'.s_mat_lanczos'//nfile, status='old',form='unformatted')
endif
read(iuntmat) vtl%ii
read(iuntmat) vtl%nums_occ
read(iuntmat) vtl%numpw
read(iuntmat) vtl%numl
vtl%numl=vtl%numl-offset
allocate(vtl%vt_mat(vtl%numpw,vtl%numl))
do il=1,offset
read(iuntmat) vtl%vt_mat(1:vtl%numpw,1)
enddo
do il=1+offset,vtl%numl+offset
read(iuntmat) vtl%vt_mat(1:vtl%numpw,il-offset)
enddo
close(iuntmat)
return
END SUBROUTINE read_data_pw_vt_mat_lanczos_single
SUBROUTINE read_data_pw_tt_mat_lanczos_single(ttl, ii, prefix, l_pola)
!this subroutine reads the termsT^v_{i,j}=<z^v_i|t_j> from disk
!single processor version
USE kinds, ONLY : DP
USE basic_structures, ONLY : tt_mat_lanczos,free_memory,initialize_memory
USE mp, ONLY : mp_bcast, mp_barrier
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(tt_mat_lanczos) :: ttl!the structure to be read
CHARACTER(LEN=256) :: prefix!to designate the PW files
LOGICAL :: l_pola !if true reads the terms for the polarization, otherwise for the self-energy
INTEGER :: ii!state to be read
CHARACTER(4) :: nfile
INTEGER :: iuntmat, il
call initialize_memory(ttl)
call free_memory(ttl)
ttl%ii=ii
write(nfile,'(4i1)') &
& ttl%ii/1000,mod(ttl%ii,1000)/100,mod(ttl%ii,100)/10,mod(ttl%ii,10)
iuntmat=find_free_unit()
if(l_pola) then
open( unit= iuntmat, file=trim(tmp_dir)//trim(prefix)//'.pt_mat_lanczos'//nfile, status='old',form='unformatted')
else
open( unit= iuntmat, file=trim(tmp_dir)//trim(prefix)//'.st_mat_lanczos'//nfile, status='old',form='unformatted')
endif
read(iuntmat) ttl%numt
read(iuntmat) ttl%numl
read(iuntmat) ttl%ii
allocate(ttl%tt_mat(ttl%numt,ttl%numl))
do il=1,ttl%numl
read(iuntmat) ttl%tt_mat(1:ttl%numt,il)
enddo
close(iuntmat)
return
END SUBROUTINE read_data_pw_tt_mat_lanczos_single
SUBROUTINE read_data_pw_full_prods(fp,prefix)
!this subroutine read the full relativistic overlaps
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode, ionode_id
USE basic_structures, ONLY : full_prods,free_memory,initialize_memory
USE mp, ONLY : mp_bcast, mp_barrier, mp_sum
USE mp_world, ONLY : world_comm
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(full_prods) :: fp!the structure to be read
CHARACTER(LEN=256) :: prefix!to designate the PW files
INTEGER :: iun, is,ii,ipol
iun=find_free_unit()
if(ionode) then
open( unit= iun, file=trim(tmp_dir)//trim(prefix)//'.prod_full', status='old',form='unformatted')
read(iun) fp%nums
read(iun) fp%nbnd
read(iun) fp%numpw
read(iun) fp%numv
endif
call mp_bcast(fp%nums,ionode_id, world_comm)
call mp_bcast(fp%nbnd, ionode_id, world_comm)
call mp_bcast(fp%numpw, ionode_id, world_comm)
call mp_bcast(fp%numv, ionode_id, world_comm)
allocate(fp%ene_ks(fp%nbnd))
allocate(fp%gmat(fp%numpw,2,fp%nbnd,fp%nums))
if(ionode) then
read(iun) fp%ene_ks(1:fp%nbnd)
do is=1,fp%nums
do ii=1,fp%nbnd
do ipol=1,2
read(iun) fp%gmat(1:fp%numpw,ipol,ii,is)
enddo
enddo
enddo
close(iun)
endif
call mp_bcast(fp%ene_ks, ionode_id, world_comm)
call mp_bcast(fp%gmat, ionode_id, world_comm)
return
END SUBROUTINE read_data_pw_full_prods
SUBROUTINE read_data_pw_partial_occ(po, prefix, ispin)
USE kinds, ONLY : DP
USE basic_structures, ONLY : partial_occ,free_memory,initialize_memory
USE mp, ONLY : mp_bcast, mp_barrier
USE mp_world, ONLY : world_comm
USE io_global, ONLY : ionode, ionode_id
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(partial_occ), INTENT(out) :: po!the structure to be read
CHARACTER(LEN=256),INTENT(in) :: prefix!to designate the PW files
INTEGER, INTENT(in) :: ispin!spin channel
INTEGER :: iun, iv,jv
call free_memory(po)
if(ionode) then
iun=find_free_unit()
if(ispin==1) then
open( unit= iun, file=trim(tmp_dir)//trim(prefix)//'.occ_mat', status='old',form='unformatted')
else
open( unit= iun, file=trim(tmp_dir)//trim(prefix)//'.occ_mat2', status='old',form='unformatted')
endif
read(iun) po%nums_occ_min
read(iun) po%nums_occ
read(iun) po%numpw
endif
call mp_bcast(po%nums_occ_min,ionode_id, world_comm)
call mp_bcast(po%nums_occ, ionode_id, world_comm)
call mp_bcast(po%numpw, ionode_id, world_comm)
allocate(po%f_occ(po%nums_occ))
if(ionode) read(iun) po%f_occ(1:po%nums_occ)
call mp_bcast(po%f_occ, ionode_id, world_comm)
allocate(po%ppp_mat(po%numpw,po%nums_occ,po%nums_occ_min+1:po%nums_occ))
do iv=po%nums_occ_min+1,po%nums_occ
do jv=1,po%nums_occ
if(ionode) read(iun) po%ppp_mat(1:po%numpw,jv,iv)
call mp_bcast( po%ppp_mat(1:po%numpw,jv,iv),ionode_id, world_comm)
enddo
enddo
if(ionode) close(iun)
return
END SUBROUTINE read_data_pw_partial_occ
SUBROUTINE read_data_pw_semicore(sc, prefix, ispin)
!NOT_TO_BE_INCLUDED_START
USE kinds, ONLY : DP
USE basic_structures, ONLY : semicore,free_memory,initialize_memory
USE mp, ONLY : mp_bcast, mp_barrier
USE mp_world, ONLY : world_comm
USE io_global, ONLY : ionode, ionode_id
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(semicore), INTENT(out) :: sc!the structure to be read
CHARACTER(LEN=256),INTENT(in) :: prefix!to designate the PW files
INTEGER, INTENT(in) :: ispin!spin channel
INTEGER :: iun, iw,ii
REAL(kind=DP), ALLOCATABLE :: tmp_prod(:)
if(ionode) then
iun=find_free_unit()
if(ispin==1) then
open( unit= iun, file=trim(tmp_dir)//trim(prefix)//'.sc_gvphi', status='old',form='unformatted')
else
open( unit= iun, file=trim(tmp_dir)//trim(prefix)//'.sc_gvphi2', status='old',form='unformatted')
endif
read(iun) sc%n_semicore
endif
call mp_bcast(sc%n_semicore, ionode_id, world_comm)
allocate(sc%en_sc(sc%n_semicore))
if(ionode) then
read(iun) sc%en_sc(1:sc%n_semicore)
read(iun) sc%nums
read(iun) sc%numpw
endif
call mp_bcast(sc%en_sc,ionode_id, world_comm)
call mp_bcast(sc%nums, ionode_id, world_comm)
call mp_bcast(sc%numpw, ionode_id, world_comm)
allocate(sc%ppw_mat(sc%numpw,sc%n_semicore,sc%nums))
allocate(tmp_prod(sc%n_semicore))
if(ionode) then
do iw=1,sc%numpw
do ii=1,sc%nums
read(iun) tmp_prod(1:sc%n_semicore)
sc%ppw_mat(iw,1:sc%n_semicore,ii)= tmp_prod(1:sc%n_semicore)
enddo
enddo
endif
call mp_bcast(sc%ppw_mat, ionode_id, world_comm)
deallocate(tmp_prod)
if(ionode) close(iun)
return
!NOT_TO_BE_INCLUDED_END
END SUBROUTINE read_data_pw_semicore
SUBROUTINE read_data_pw_contour(ct,prefix,ispin,istate)
!NOT_TO_BE_INCLUDED_START
!this subroutines reads the <psi_i|s_\alpha> overlaps
USE kinds, ONLY : DP
USE basic_structures, ONLY : contour_terms,free_memory,initialize_memory
USE mp, ONLY : mp_bcast, mp_barrier
USE mp_world, ONLY : world_comm
USE io_global, ONLY : ionode, ionode_id
USE io_files, ONLY : tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(contour_terms), INTENT(out) :: ct!the structure to be read
CHARACTER(LEN=256),INTENT(in) :: prefix!to designate the PW files
INTEGER, INTENT(in) :: ispin!spin channel
INTEGER, INTENT(in) :: istate!!KS states relative to global s vectors for big_system option
INTEGER :: iun, iw,ii
CHARACTER(4) :: nfile
if(ionode) then
iun=find_free_unit()
write(nfile,'(4i1)') istate/1000,mod(istate,1000)/100,mod(istate,100)/10,mod(istate,10)
if(ispin==1) then
open( unit= iun, file=trim(tmp_dir)//trim(prefix)//'.s_contour'//nfile, status='old',form='unformatted')
else
open( unit= iun, file=trim(tmp_dir)//trim(prefix)//'.s_contour'//nfile, status='old',form='unformatted')
endif
read(iun) ct%nums
read(iun) ct%numt
endif
call mp_bcast(ct%nums, ionode_id, world_comm)
call mp_bcast(ct%numt, ionode_id, world_comm)
allocate(ct%cmat(ct%numt,ct%nums))
if(ionode) then
do ii=1,ct%nums
read(iun) ct%cmat(1:ct%numt,ii)
enddo
close(iun)
endif
call mp_bcast(ct%cmat, ionode_id, world_comm)
return
!NOT_TO_BE_INCLUDED_END
END SUBROUTINE read_data_pw_contour
Reference in New Issue View Git Blame Copy Permalink