Skip to content

GitLab

fleur
fleur
Commit a66945e4 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

Modified IO of DOS and related data 

This is now included in the eig-file, hence
two new routines in eig66_io have been created.
parent e15587dc
Hide whitespace changes
Inline Side-by-side
Showing with 2099 additions and 1617 deletions
cdn/cdnval.F90
View file @ a66945e4
......@@ -44,6 +44,7 @@ CONTAINS
! and bands
!***********************************************************************
!
USE m_eig66_io,ONLY: write_dos
USE m_radfun
USE m_radflo
USE m_rhomt
......@@ -158,8 +159,8 @@ CONTAINS
INTEGER, ALLOCATABLE :: nmtsl(:,:),nslat(:,:)
REAL, ALLOCATABLE :: zsl(:,:),volsl(:)
REAL, ALLOCATABLE :: volintsl(:)
REAL, ALLOCATABLE :: qintsl(:,:,:,:),qmtsl(:,:,:,:)
REAL, ALLOCATABLE :: orbcomp(:,:,:,:,:),qmtp(:,:,:,:)
REAL, ALLOCATABLE :: qintsl(:,:),qmtsl(:,:)
REAL, ALLOCATABLE :: orbcomp(:,:,:),qmtp(:,:)
!-new_sl
!-dw
INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:) ,kveclo(:)
......@@ -429,10 +430,10 @@ CONTAINS
atoms,cell,nsld,&
nsl,zsl,nmtsl,nslat,volsl,volintsl)
!
ALLOCATE ( qintsl(nsld,dimension%neigd,kpts%nkptd,dimension%jspd))
ALLOCATE ( qmtsl(nsld,dimension%neigd,kpts%nkptd,jsp_start:jsp_end))
ALLOCATE ( orbcomp(dimension%neigd,23,atoms%natd,kpts%nkptd,jsp_start:jsp_end) )
ALLOCATE ( qmtp(dimension%neigd,atoms%natd,kpts%nkptd,jsp_start:jsp_end) )
ALLOCATE ( qintsl(nsld,dimension%neigd))
ALLOCATE ( qmtsl(nsld,dimension%neigd))
ALLOCATE ( orbcomp(dimension%neigd,23,atoms%natd) )
ALLOCATE ( qmtp(dimension%neigd,atoms%natd) )
IF (.not.input%film) qvac(:,:,:,jspin) = 0.0
ENDIF
!-q_sl
......@@ -626,7 +627,7 @@ CONTAINS
cell,&
z,noccbd,lapw,&
nsl,zsl,nmtsl,oneD,&
qintsl(:,:,ikpt,jspin))
qintsl(:,:))
!
ENDIF
ENDIF
......@@ -727,7 +728,7 @@ CONTAINS
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
CALL q_mt_sl(ispin, atoms,noccbd,nsld, ikpt,noccbd,ccof(-atoms%llod,1,1,1,ispin),&
skip_t,noccbd, acof(:,0:,:,ispin),bcof(:,0:,:,ispin),usdus,&
nmtsl,nsl, qmtsl(:,:,ikpt,ispin))
nmtsl,nsl, qmtsl(:,:))
!
INQUIRE (file='orbcomprot',exist=l_orbcomprot)
......@@ -738,7 +739,7 @@ CONTAINS
ENDIF
CALL orb_comp(ispin,noccbd,atoms,noccbd,usdus,acof(1:,0:,1:,ispin),bcof(1:,0:,1:,ispin),&
ccof(-atoms%llod:,1:,1:,1:,ispin), orbcomp(:,:,:,ikpt,ispin), qmtp(:,:,ikpt,ispin))
ccof(-atoms%llod:,1:,1:,1:,ispin), orbcomp, qmtp)
!
ENDIF
!-new
......@@ -829,56 +830,10 @@ CONTAINS
!
!--dw now write k-point data to tmp_dos
!
CALL judft_error("IO in cdnval not implemented")
IF (mpi%irank==0) THEN
IF ( .not.l_mcd ) THEN
DO ispin = jsp_start,jsp_end
WRITE (84,rec=kpts%nkpt*(ispin-1)+ikpt) bkpt,wk,nbands,eig,&
& qal(:,:,:,ispin),qvac(:,:,ikpt,ispin),&
& qis(:,ikpt,ispin),qvlay(:,:,:,ikpt,ispin),&
& qstars,ksym,jsym
ENDDO
ELSE
WRITE (84,rec=kpts%nkpt*(jspin-1)+ikpt) bkpt,wk,nbands,eig,&
& qal(:,:,:,jspin),qvac(:,:,ikpt,jspin),&
& qis(:,ikpt,jspin),qvlay(:,:,:,ikpt,jspin),&
& qstars,ksym,jsym,mcd(:,1:ncored,:)
ENDIF ! not.l_mcd
!+new_sl
IF (banddos%ndir.EQ.-3) THEN
IF ( .not.l_mcd ) THEN
DO ispin = jsp_start,jsp_end
WRITE (129,rec=kpts%nkpt*(ispin-1)+ikpt) bkpt,wk,&
nbands,eig,qvac(:,:,ikpt,ispin),&
qintsl(:,:,ikpt,ispin),&
qmtsl(:,:,ikpt,ispin),&
orbcomp(:,:,:,ikpt,ispin),&
qmtp(:,:,ikpt,ispin)
ENDDO
ELSE
WRITE (6,FMT=500)
WRITE (16,FMT=500)
500 FORMAT('A calculation of an orbital composition&
&of input%film states (s,px,py,pz,....)&
& for the l_mcd case is not implemented.')
ENDIF ! not.l_mcd
ENDIF ! banddos%ndir == -3
ENDIF ! mpi%irank==0
#ifdef CPP_MPI
DO ispin = jsp_start,jsp_end
CALL mpi_col_dos(&
mpi,l_evp,noccbd,noccbd_l,&
dimension,atoms,atoms,&
nsld,ncored,&
vacuum,vacuum,l_mcd,banddos,kpts,ispin,ikpt,&
bkpt,wk,nbands,eig,qal(0,1,1,ispin),&
qvac(1,1,ikpt,ispin),qis(1,nkpt,ispin),&
qvlay(:,:,:,ikpt,ispin),qstars,ksym,&
jsym,m_mcd,qintsl(:,:,ikpt,ispin),&
qmtsl(:,:,ikpt,ispin),qmtp(:,:,ikpt,ispin),&
orbcomp(:,:,:,ikpt,ispin))
ENDDO
#endif
call write_dos(eig_id,ikpt,ispin,qal(:,:,:,ispin),qvac(:,:,ikpt,ispin),qis(:,ikpt,ispin),&
qvlay(:,:,:,ikpt,ispin),qstars,ksym,jsym,mcd,qintsl,&
qmtsl(:,:),qmtp(:,:),orbcomp)
CALL timestop("cdnval: write_info")
!-new_sl
ENDIF
......@@ -917,7 +872,7 @@ enddo
call timestart("cdnval: dos")
IF (mpi%irank==0) THEN
CALL doswrite(&
dimension,kpts,atoms,vacuum,&
eig_id,dimension,kpts,atoms,vacuum,&
input,banddos,&
sliceplot,noco,sym,&
cell,&
......@@ -925,7 +880,7 @@ enddo
results%ef,nsld,oneD)
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
CALL Ek_write_sl(&
dimension,kpts,atoms,vacuum,&
eig_id,dimension,kpts,atoms,vacuum,&
nsld,input,jspin,&
sym,cell,&
nsl,nslat)
......
dos/Ek_write_sl.f90
View file @ a66945e4
MODULE m_Ekwritesl
use m_juDFT
CONTAINS
SUBROUTINE Ek_write_sl(&
& dimension,kpts,atoms,vacuum,nsld,&
& input,jspin,&
& sym,cell,&
& nsl,nslat)
SUBROUTINE Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,nsld,&
input,jspin, sym,cell, nsl,nslat)
!-----------------------------------------------------------------
!-- now write E(k) for all kpts if on T3E
!-- now read data from tmp_dos and write of E(k) in ek_orbcomp
!-----------------------------------------------------------------
USE m_types
USE m_eig66_io
IMPLICIT NONE
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_input),INTENT(IN) :: input
......@@ -21,7 +19,7 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nsld
INTEGER, INTENT (IN) :: nsld,eig_id
INTEGER, INTENT (IN) :: nsl ,jspin
! ..
! .. Array Arguments ..
......@@ -36,19 +34,22 @@ CONTAINS
INTEGER norb(23),iqsl(nsld),iqvacpc(2)
REAL bkpt(3),qvact(2)
REAL, ALLOCATABLE :: eig(:),qvac(:,:,:,:),orbcomp(:,:,:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:),qis(:),qvlay(:,:,:)
COMPLEX,ALLOCATABLE::qstars(:,:,:,:)
INTEGER,ALLOCATABLE::ksym(:),jsym(:)
REAL, ALLOCATABLE :: qintsl(:,:,:,:),qmtsl(:,:,:,:),qmtp(:,:,:,:)
CHARACTER (len=2) :: chntype
CHARACTER (len=99) :: chform
! ..
! .. Intrinsic Functions
INTRINSIC nint
!
IF (nsl.GT.nsld) THEN
CALL juDFT_error("nsl.GT.nsld",calledby="Ek_write_sl")
ENDIF
ALLOCATE(eig(dimension%neigd),orbcomp(dimension%neigd,23,atoms%natd,kpts%nkptd,dimension%jspd))
ALLOCATE(qvac(dimension%neigd,2,kpts%nkptd,dimension%jspd),qintsl(nsld,dimension%neigd,kpts%nkptd,dimension%jspd))
ALLOCATE(qmtsl(nsld,dimension%neigd,kpts%nkptd,dimension%jspd),qmtp(dimension%neigd,atoms%natd,kpts%nkptd,dimension%jspd))
ALLOCATE(qal(4,atoms%ntype,dimension%neigd),qis(dimension%neigd),qvlay(dimension%neigd,vacuum%layerd,2))
ALLOCATE(qstars(vacuum%nstars,dimension%neigd,vacuum%layerd,2))
ALLOCATE(ksym(dimension%neigd),jsym(dimension%neigd))
!
! ---> open files for a bandstucture with an orbital composition
! ---> in the case of the film geometry
......@@ -83,10 +84,9 @@ CONTAINS
!==============================================================
DO ikpt=1,kpts%nkpt
!
READ (129,rec=kpts%nkpt*(kspin-1)+ikpt) bkpt,wk,nbands,eig,&
& qvac(:,:,ikpt,kspin),qintsl(:,:,ikpt,kspin),&
& qmtsl(:,:,ikpt,kspin),&
& orbcomp(:,:,:,ikpt,kspin),qmtp(:,:,ikpt,kspin)
call read_eig(eig_id,ikpt,kspin,bk=bkpt,neig=nbands,eig=eig)
call read_dos(eig_id,ikpt,kspin,qal,qvac(:,:,ikpt,kspin),qis,qvlay,qstars,ksym,jsym,&
qintsl=qintsl(:,:,ikpt,kspin),qmtsl= qmtsl(:,:,ikpt,kspin),qmtp=qmtp(:,:,ikpt,kspin),orbcomp=orbcomp(:,:,:,ikpt,kspin))
! write(*,*) kspin,nkpt,qmtp(1,:,ikpt,kspin)
!
WRITE (130,FMT=8000) (bkpt(i),i=1,3)
......
dos/doswrite.f90
View file @ a66945e4
......@@ -6,17 +6,18 @@ MODULE m_doswrite
!
CONTAINS
SUBROUTINE doswrite(&
& DIMENSION,kpts,atoms,vacuum,&
& eig_id,DIMENSION,kpts,atoms,vacuum,&
& input,banddos,&
& sliceplot,noco,sym,&
& cell,&
& l_mcd,ncored,ncore,e_mcd,&
& efermi,nsld,oneD)
USE m_eig66_io,ONLY:read_dos
USE m_evaldos
USE m_cdninf
USE m_types
IMPLICIT NONE
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_banddos),INTENT(IN) :: banddos
......@@ -31,7 +32,7 @@ CONTAINS
! .. Scalar Arguments ..
INTEGER,PARAMETER :: n2max=13
INTEGER, INTENT (IN) :: nsld
INTEGER, INTENT (IN) :: nsld,eig_id
INTEGER, INTENT (IN) :: ncored
REAL, INTENT (IN) :: efermi
LOGICAL, INTENT (IN) :: l_mcd
......@@ -98,10 +99,10 @@ CONTAINS
ENDIF
DO ikpt=1,kpts%nkpt
READ (84,rec=kpts%nkpt*(kspin-1)+ikpt) bkpt,wk,ne,eig,&
call read_dos(eig_id,ikpt,kspin,&
& qal(:,:,:,kspin),qvac(:,:,ikpt,kspin),&
& qis(:,ikpt,kspin),&
& qvlay(:,:,:),qstars,ksym,jsym
& qvlay(:,:,:),qstars,ksym,jsym)
CALL cdninf(&
& input,sym,noco,kspin,atoms,&
......@@ -127,7 +128,7 @@ CONTAINS
!
IF (banddos%dos.AND.(banddos%ndir.LT.0)) THEN
CALL evaldos(&
& input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
& eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
& DIMENSION,efermi,&
& l_mcd,ncored,ncore,e_mcd,nsld)
ENDIF
......
dos/evaldos.f90
View file @ a66945e4
MODULE m_evaldos
CONTAINS
SUBROUTINE evaldos(input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
SUBROUTINE evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
dimension,efermiarg, l_mcd,ncored,ncore,e_mcd,nsld)
!----------------------------------------------------------------------
!
......@@ -19,6 +19,7 @@
! ntb=max(nevk)
!
!----------------------------------------------------------------------
USE m_eig66_io,ONLY:read_dos
USE m_triang
USE m_maketetra
USE m_tetrados
......@@ -27,7 +28,7 @@
USE m_smooth
USE m_types
IMPLICIT NONE
INTEGER,INTENT(IN) :: eig_id
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_banddos),INTENT(IN) :: banddos
......@@ -62,7 +63,7 @@
REAL vk(3,kpts%nkptd),wt(kpts%nkptd),voltet(6*kpts%nkpt),kx(kpts%nkpt),vkr(3,kpts%nkpt)
REAL ev(dimension%neigd,kpts%nkptd),e(ned),gpart(ned,atoms%ntype),atr(2*kpts%nkpt)
REAL e_grid(ned+1),spect(ned,3*atoms%ntypd),ferwe(dimension%neigd,kpts%nkptd)
REAL, ALLOCATABLE :: qal(:,:,:),qval(:,:,:),qlay(:,:,:),g(:,:)
REAL, ALLOCATABLE :: qal(:,:,:),qval(:,:,:),qlay(:,:,:),g(:,:),qal_tmp(:,:,:),qis(:),qvlay(:,:,:)
REAL, ALLOCATABLE :: mcd(:,:,:),orbcomp(:,:,:),qmtp(:,:)
REAL, ALLOCATABLE :: qintsl(:,:),qmtsl(:,:),qvac(:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:)
......@@ -155,44 +156,35 @@
ENDDO
ENDDO
!
! read data from dos_tmp file!
! read data from file!
!
IF (( .not.l_mcd ).AND.(banddos%ndir.NE.-3)) THEN
READ(84,rec=kpts%nkpt*(jspin-1)+k) vk(:,k),wt(k),nevk(k),ev(:,k),&
qal(1:lmax*atoms%ntype,:,k), & ! atoms 1...atoms%ntype&
qal(lmax*atoms%ntype+2,:,k), & ! vacuum 1&
qal(lmax*atoms%ntype+3,:,k), & ! vacuum 2&
qal(lmax*atoms%ntype+1,:,k), & ! interstitial&
qlay,qstars
ELSEIF (banddos%ndir.NE.-3) THEN
ALLOCATE( ksym(dimension%neigd),jsym(dimension%neigd) )
READ(84,rec=kpts%nkpt*(jspin-1)+k) vk(:,k),wt(k),nevk(k),ev(:,k),&
qal(1:lmax*atoms%ntype,:,k), & ! atoms 1...atoms%ntype&
qal(lmax*atoms%ntype+2,:,k), & ! vacuum 1&
qal(lmax*atoms%ntype+3,:,k), & ! vacuum 2&
qal(lmax*atoms%ntype+1,:,k), & ! interstitial&
qlay,qstars,ksym,jsym,&
mcd(:,:,k)
ALLOCATE( qal_tmp(1:lmax,atoms%ntype,dimension%neigd))
ALLOCATE( orbcomp(dimension%neigd,23,atoms%natd),qintsl(nsld,dimension%neigd))
ALLOCATE( qmtsl(nsld,dimension%neigd),qmtp(dimension%neigd,atoms%natd),qvac(dimension%neigd,2))
ALLOCATE( qis(dimension%neigd),qvlay(dimension%neigd,vacuum%layerd,2))
CALL read_dos(eig_id,k,jspin,qal_tmp,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
qal(1:lmax*atoms%ntype,:,k)=reshape(qal_tmp,(/lmax*atoms%ntype,size(qal_tmp,3)/))
qal(lmax*atoms%ntype+2,:,k)=qvac(:,1) ! vacuum 1
qal(lmax*atoms%ntype+3,:,k)=qvac(:,2) ! vacuum 2
qal(lmax*atoms%ntype+1,:,k)=qis ! interstitial
DEALLOCATE( ksym,jsym )
ELSE
ALLOCATE( orbcomp(dimension%neigd,23,atoms%natd),qintsl(nsld,dimension%neigd))
ALLOCATE( qmtsl(nsld,dimension%neigd),qmtp(dimension%neigd,atoms%natd),qvac(dimension%neigd,2))
READ (129,rec=kpts%nkpt*(jspin-1)+k) vk(:,k),wt(k),nevk(k),ev(:,k),qvac,qintsl,qmtsl,orbcomp,qmtp
IF (n_orb == 0) THEN
qal(1:nsld,:,k) = qintsl(:,:)
qal(nsld+1:2*nsld,:,k) = qmtsl(:,:)
ELSE
DO i = 1, 23
DO l = 1, nevk(k)
qal(i,l,k) = orbcomp(l,i,n_orb)*qmtp(l,n_orb)/10000.
ENDDO
DO l = nevk(k)+1, dimension%neigd
qal(i,l,k) = 0.0
ENDDO
ENDDO
ENDIF
DEALLOCATE( orbcomp,qintsl,qmtsl,qmtp,qvac)
ENDIF
IF (l_orbcomp)THEN
IF (n_orb == 0) THEN
qal(1:nsld,:,k) = qintsl(:,:)
qal(nsld+1:2*nsld,:,k) = qmtsl(:,:)
ELSE
DO i = 1, 23
DO l = 1, nevk(k)
qal(i,l,k) = orbcomp(l,i,n_orb)*qmtp(l,n_orb)/10000.
ENDDO
DO l = nevk(k)+1, dimension%neigd
qal(i,l,k) = 0.0
ENDDO
ENDDO
ENDIF
ENDIF
DEALLOCATE( orbcomp,qintsl,qmtsl,qmtp,qvac,qis,qal_tmp,qvlay)
ntb = max(ntb,nevk(k))
!
! set vacuum partial charge zero, if bulk calculation
......
io/eig66_da.F90
View file @ a66945e4
MODULE m_eig66_da
#include "juDFT_env.h"
! Do the IO of the eig-file in fortran direct-access
! The eig-file is split into two parts:
! eig.bas contains the basis-set information
! eig.vec contains the eigenvalues and the eigenvectors
! The record number is given by nrec=nk+(jspin-1)*nkpts
! each record contains:
! eig.bas: el,evac,ello,bkpt,wtkpt,nv,nmat,k1,k2,k3,kveclo
! eig.vec: ne,eig,z**
!**: real or complex depending on calculation type
USE m_eig66_data
IMPLICIT NONE
! Do the IO of the eig-file in fortran direct-access
! The eig-file is split into two parts:
! eig.bas contains the basis-set information
! eig.vec contains the eigenvalues and the eigenvectors
! The record number is given by nrec=nk+(jspin-1)*nkpts
! each record contains:
! eig.bas: el,evac,ello,bkpt,wtkpt,nv,nmat,k1,k2,k3,kveclo
! eig.vec: ne,eig,z**
!**: real or complex depending on calculation type
USE m_eig66_data
IMPLICIT NONE
CONTAINS
subroutine priv_find_data(id,d)
INTEGER,INTENT(IN) :: id
TYPE(t_data_DA),POINTER,INTENT(out) :: d
class(t_data),pointer ::dp
call eig66_find_data(dp,id)
select type(dp)
type is (t_data_da)
d=>dp
class default
call judft_error("BUG: wrong datatype in eig66_da")
END SELECT
END subroutine
SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,create,filename)
INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot
LOGICAL, INTENT(IN) :: create
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
!locals
LOGICAL :: l_file
INTEGER :: i1,recl_z,recl_eig
REAL :: r1,r3(3)
COMPLEX :: c1
TYPE(t_data_DA),POINTER:: d
call priv_find_data(id,d)
IF (present(filename)) d%fname=filename
call eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype)
!Allocate the storage for the DATA always read/write
ALLOCATE(d%el_s(0:lmax,ntype),d%ello_s(nlo,ntype),d%evac_s(2))
ALLOCATE(d%kvec_s(nmat,3),d%kveclo_s(nlotot))
!Calculate the record length
INQUIRE(IOLENGTH=recl_eig) d%el_s,d%evac_s,d%ello_s,r3,r1,i1,i1,d%kvec_s,d%kveclo_s
d%recl_bas=recl_eig
INQUIRE(IOLENGTH=recl_eig) r1
recl_eig=recl_eig*(neig+2) ! add a 2 for integer 'neig'
SUBROUTINE priv_find_data(id,d)
INTEGER,INTENT(IN) :: id
TYPE(t_data_DA),POINTER,INTENT(out) :: d
CLASS(t_data),POINTER ::dp
CALL eig66_find_data(dp,id)
SELECT TYPE(dp)
TYPE is (t_data_da)
d=>dp
CLASS default
CALL judft_error("BUG: wrong datatype in eig66_da")
END SELECT
END SUBROUTINE priv_find_data
SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,create,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot
LOGICAL, INTENT(IN) :: create
LOGICAL,INTENT(IN) :: l_dos,l_mcd,l_orb
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat
!locals
LOGICAL :: l_file
INTEGER :: i1,recl_z,recl_eig,recl_dos
REAL :: r1,r3(3)
COMPLEX :: c1
TYPE(t_data_DA),POINTER:: d
CALL priv_find_data(id,d)
IF (PRESENT(filename)) d%fname=filename
CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_dos,l_mcd,l_orb)
!Allocate the storage for the DATA always read/write
ALLOCATE(d%el_s(0:lmax,ntype),d%ello_s(nlo,ntype),d%evac_s(2))
ALLOCATE(d%kvec_s(nmat,3),d%kveclo_s(nlotot))
!Calculate the record length
INQUIRE(IOLENGTH=recl_eig) d%el_s,d%evac_s,d%ello_s,r3,r1,i1,i1,d%kvec_s,d%kveclo_s
d%recl_bas=recl_eig
INQUIRE(IOLENGTH=recl_eig) r1
recl_eig=recl_eig*(neig+2) ! add a 2 for integer 'neig'
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
INQUIRE(IOLENGTH=recl_z) r1
INQUIRE(IOLENGTH=recl_z) r1
#else
INQUIRE(IOLENGTH=recl_z) c1
INQUIRE(IOLENGTH=recl_z) c1
#endif
recl_z=recl_z*nmat*neig
d%recl_vec=recl_eig+recl_z
IF (create) THEN
d%file_io_id_bas=priv_free_uid()
INQUIRE(file=trim(d%fname)//".bas",opened=l_file)
DO while(l_file)
print *,"eig66_open_da:",d%fname," in use"
d%fname=trim(d%fname)//"6"
INQUIRE(file=trim(d%fname)//".bas",opened=l_file)
ENDDO
OPEN(d%file_io_id_bas,FILE=trim(d%fname)//".bas",ACCESS='direct',FORM='unformatted',RECL=d%recl_bas,STATUS='unknown')
d%file_io_id_vec=priv_free_uid()
OPEN(d%file_io_id_vec,FILE=trim(d%fname)//".vec",ACCESS='direct',FORM='unformatted',RECL=d%recl_vec,STATUS='unknown')
ELSE
d%file_io_id_bas=priv_free_uid()
OPEN(d%file_io_id_bas,FILE=trim(d%fname)//".bas",ACCESS='direct',FORM='unformatted',RECL=d%recl_bas,STATUS='old')
d%file_io_id_vec=priv_free_uid()
OPEN(d%file_io_id_vec,FILE=trim(d%fname)//".vec",ACCESS='direct',FORM='unformatted',RECL=d%recl_vec,STATUS='old')
ENDIF
CONTAINS
INTEGER FUNCTION priv_free_uid() RESULT(uid)
IMPLICIT NONE
LOGICAL::used
used=.TRUE.
uid=665
DO WHILE(used)
uid=uid+1
INQUIRE(UNIT=uid,OPENED=used)
END DO
END FUNCTION
END SUBROUTINE open_eig
SUBROUTINE close_eig(id,filename)
INTEGER,INTENT(IN)::id
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
type(t_data_DA),pointer:: d
call priv_find_data(id,d)
DEALLOCATE(d%el_s,d%ello_s,d%evac_s,d%kvec_s,d%kveclo_s)
CLOSE(d%file_io_id_bas)
CLOSE(d%file_io_id_vec)
d%recl_vec=0
d%recl_bas=0
!If a filename was given and the name is not the current filename then rename
IF (present(filename)) THEN
IF (filename.NE.d%fname) THEN
CALL system("mv "//trim(d%fname)//".bas "//trim(filename)//".bas")
CALL system("mv "//trim(d%fname)//".vec "//trim(filename)//".vec")
ENDIF
ENDIF
d%fname="eig"
CALL eig66_remove_data(id)
END SUBROUTINE close_eig
SUBROUTINE read_eig(id,nk,jspin,nv,nmat,k1,k2,k3,bk,wk,neig,eig,el,ello,evac,kveclo,n_start,n_end,z)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
INTEGER, INTENT(OUT),OPTIONAL :: nv,nmat
INTEGER, INTENT(OUT),OPTIONAL :: neig
REAL, INTENT(OUT),OPTIONAL :: eig(:)
INTEGER, INTENT(OUT),OPTIONAL :: k1(:),k2(:),k3(:),kveclo(:)
REAL, INTENT(OUT),OPTIONAL :: evac(:),ello(:,:),el(:,:)
REAL, INTENT(OUT),OPTIONAL :: bk(:),wk
INTEGER, INTENT(IN),OPTIONAL :: n_start,n_end
CLASS(*),TARGET,INTENT(OUT),OPTIONAL :: z(:,:)
!Local variables
INTEGER:: nv_s,nmat_s,n,nrec,neig_s
REAL :: bkpt(3),wtkpt
REAL,ALLOCATABLE::eig_s(:),zr_s(:,:)
COMPLEX,ALLOCATABLE::zc_s(:,:)
REAL,POINTER :: zr(:,:)
COMPLEX,POINTER:: zc(:,:)
type(t_data_DA),POINTER:: d
call priv_find_data(id,d)
! check if io is performed correctly
IF (present(n_start)) THEN
IF (n_start/=1) &
CALL juDFT_error("In direct access mode only all eigenstates can be read")
ENDIF
nrec=nk+(jspin-1)*d%nkpts
IF (present(el).OR.present(ello).OR.present(evac).OR.present(bk).OR.present(wk).OR.&
present(nv).OR.present(nmat).OR.present(k1).OR.present(k2).OR.present(k3).OR.&
present(kveclo)) THEN
!IO of basis-set information
READ(d%file_io_id_bas,REC=nrec) nmat_s,d%el_s,d%evac_s,d%ello_s,bkpt,wtkpt,nv_s,d%kvec_s,d%kveclo_s
IF (present(el)) el=d%el_s
IF (present(evac)) evac=d%evac_s
IF (present(ello)) ello=d%ello_s
IF (present(bk)) bk=bkpt
IF (present(wk)) wk=wtkpt
IF (present(nv)) nv=nv_s
IF (present(nmat)) nmat=nmat_s
IF (present(k1)) k1=d%kvec_s(:,1)
IF (present(k2)) k2=d%kvec_s(:,2)
IF (present(k3)) k3=d%kvec_s(:,3)
IF (present(kveclo)) kveclo=d%kveclo_s
ENDIF
IF (.NOT.(present(eig).OR.present(neig).OR.present(z))) RETURN
IF (.NOT.(present(eig).OR.present(z))) THEN
READ(d%file_io_id_vec,REC=nrec) neig
RETURN
ENDIF
IF (present(eig)) THEN
ALLOCATE(eig_s(size(eig)))
ENDIF
IF (present(z).and..not.present(eig)) THEN
ALLOCATE(eig_s(size(z,2)))
ENDIF
IF (present(z)) THEN
SELECT TYPE(z)
TYPE IS (real)
INQUIRE(IOLENGTH=n) neig_s,eig_s,real(z)
IF (n>d%recl_vec) CALL juDFT_error("BUG: Too long record")
zr=>z