Skip to content

GitLab

fleur
fleur
Commit cced8df0 authored by Gregor Michalicek's avatar Gregor Michalicek
Browse files
Options

Remove requirement for read_dos, write_dos subroutines (part 2)

parent b4f9dbd5
Hide whitespace changes
Inline Side-by-side
Showing with 56 additions and 167 deletions
cdn/cdnval.F90
View file @ cced8df0
......@@ -271,7 +271,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
! since z is no longer an argument of cdninf sympsi has to be called here!
IF (banddos%ndir.GT.0) CALL sympsi(lapw,jspin,sym,dimension,nbands,cell,eig,noco,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),zMat)
CALL write_dos(eig_id,ikpt,jspin,dos,slab,orbcomp,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),mcd%mcd)
CALL write_dos(eig_id,ikpt,jspin,slab,orbcomp,mcd%mcd)
END IF
END DO ! end of k-point loop
......
dos/Ek_write_sl.f90
View file @ cced8df0
MODULE m_Ekwritesl
use m_juDFT
CONTAINS
SUBROUTINE Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspin,sym,cell,slab)
SUBROUTINE Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspin,sym,cell,dos,slab)
!-----------------------------------------------------------------
!-- now write E(k) for all kpts if on T3E
!-- now read data from tmp_dos and write of E(k) in ek_orbcomp
......@@ -14,6 +14,7 @@ CONTAINS
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_slab),INTENT(IN) :: slab
......@@ -30,10 +31,7 @@ CONTAINS
! .. Local Arrays
INTEGER norb(23),iqsl(slab%nsld),iqvacpc(2)
REAL qvact(2)
REAL, ALLOCATABLE :: eig(:),qvac(:,:,:,:),orbcomp(:,:,:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:),qis(:),qvlay(:,:,:)
COMPLEX,ALLOCATABLE::qstars(:,:,:,:)
INTEGER,ALLOCATABLE::ksym(:),jsym(:)
REAL, ALLOCATABLE :: eig(:),orbcomp(:,:,:,:,:)
REAL, ALLOCATABLE :: qintsl(:,:,:,:),qmtsl(:,:,:,:),qmtp(:,:,:,:)
CHARACTER (len=2) :: chntype
CHARACTER (len=99) :: chform
......@@ -42,11 +40,8 @@ CONTAINS
CALL juDFT_error("nsl.GT.nsld",calledby="Ek_write_sl")
ENDIF
ALLOCATE(eig(dimension%neigd),orbcomp(dimension%neigd,23,atoms%nat,kpts%nkpt,dimension%jspd))
ALLOCATE(qvac(dimension%neigd,2,kpts%nkpt,dimension%jspd),qintsl(slab%nsld,dimension%neigd,kpts%nkpt,dimension%jspd))
ALLOCATE(qintsl(slab%nsld,dimension%neigd,kpts%nkpt,dimension%jspd))
ALLOCATE(qmtsl(slab%nsld,dimension%neigd,kpts%nkpt,dimension%jspd),qmtp(dimension%neigd,atoms%nat,kpts%nkpt,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
......@@ -82,7 +77,7 @@ CONTAINS
DO ikpt=1,kpts%nkpt
!
call read_eig(eig_id,ikpt,kspin,neig=nbands,eig=eig)
call read_dos(eig_id,ikpt,kspin,qal,qvac(:,:,ikpt,kspin),qis,qvlay,qstars,ksym,jsym,&
call read_dos(eig_id,ikpt,kspin,&
qintsl=qintsl(:,:,ikpt,kspin),qmtsl= qmtsl(:,:,ikpt,kspin),qmtp=qmtp(:,:,ikpt,kspin),orbcomp=orbcomp(:,:,:,ikpt,kspin))
! write(*,*) kspin,nkpt,qmtp(1,:,ikpt,kspin)
!
......@@ -92,7 +87,7 @@ CONTAINS
DO iband = 1,nbands
qvact = 0.0
DO ivac = 1,vacuum%nvac
qvact(ivac) = qvac(iband,ivac,ikpt,kspin)
qvact(ivac) = dos%qvac(iband,ivac,ikpt,kspin)
ENDDO
IF (sym%invs .OR. sym%zrfs) qvact(2) = qvact(1)
iqvacpc(:) = nint(qvact(:)*100.0)
......@@ -138,7 +133,7 @@ CONTAINS
& 7(1x,i3,1x),'|',7(1x,i3,1x),'|',f6.1,'|')
9 FORMAT(133('-'))
!
DEALLOCATE ( eig,qvac,orbcomp,qintsl,qmtsl,qmtp )
DEALLOCATE ( eig,orbcomp,qintsl,qmtsl,qmtp )
END SUBROUTINE Ek_write_sl
END MODULE m_Ekwritesl
dos/doswrite.f90
View file @ cced8df0
......@@ -28,7 +28,7 @@ CONTAINS
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_mcd),INTENT(IN) :: mcd
......@@ -39,14 +39,8 @@ CONTAINS
INTEGER, INTENT (IN) :: nsld,eig_id
! locals
INTEGER :: jsym(DIMENSION%neigd),ksym(DIMENSION%neigd)
REAL :: wk,bkpt(3)
REAL :: eig(DIMENSION%neigd)
REAL :: qal(0:3,atoms%ntype,DIMENSION%neigd,DIMENSION%jspd)
REAL :: qis(DIMENSION%neigd,kpts%nkpt,DIMENSION%jspd)
REAL :: qvac(DIMENSION%neigd,2,kpts%nkpt,DIMENSION%jspd)
REAL :: qvlay(DIMENSION%neigd,vacuum%layerd,2)
COMPLEX :: qstars(vacuum%nstars,DIMENSION%neigd,vacuum%layerd,2)
REAL :: eig(DIMENSION%neigd)
INTEGER :: ne,ikpt,kspin,j,i,n
COMPLEX, ALLOCATABLE :: ac(:,:),bc(:,:)
......@@ -92,10 +86,6 @@ CONTAINS
ENDIF
DO ikpt=1,kpts%nkpt
! call read_eig(eig_id,ikpt,kspin,neig=ne,eig=eig)
! call read_dos(eig_id,ikpt,kspin,qal(:,:,:,kspin),qvac(:,:,ikpt,kspin),&
! qis(:,ikpt,kspin),qvlay(:,:,:),qstars,ksym,jsym)
CALL cdninf(input,sym,noco,kspin,atoms,vacuum,sliceplot,banddos,ikpt,kpts%bk(:,ikpt),&
kpts%wtkpt(ikpt),cell,kpts,results%neig(ikpt,kspin),results%eig(:,ikpt,kspin),dos%qal(0:,:,:,ikpt,kspin),dos%qis,dos%qvac,&
dos%qvlay(:,:,:,ikpt,kspin),dos%qstars(:,:,:,:,ikpt,kspin),dos%ksym(:,ikpt,kspin),dos%jsym(:,ikpt,kspin))
......
dos/evaldos.f90
View file @ cced8df0
......@@ -60,15 +60,13 @@
REAL e_up,e_lo,e_test1,e_test2,fac,sumwei,dk,eFermiCorrection
LOGICAL l_tria,l_orbcomp,l_error
INTEGER itria(3,2*kpts%nkpt),nevk(kpts%nkpt),itetra(4,6*kpts%nkpt)
INTEGER, ALLOCATABLE :: ksym(:),jsym(:)
INTEGER itria(3,2*kpts%nkpt),itetra(4,6*kpts%nkpt)
REAL voltet(6*kpts%nkpt),kx(kpts%nkpt),vkr(3,kpts%nkpt)
REAL ev(dimension%neigd,kpts%nkpt),e(ned),gpart(ned,atoms%ntype),atr(2*kpts%nkpt)
REAL e_grid(ned+1),spect(ned,3*atoms%ntype),ferwe(dimension%neigd,kpts%nkpt)
REAL, ALLOCATABLE :: qal(:,:,:),qval(:,:,:),qlay(:,:,:),g(:,:),qal_tmp(:,:,:),qis(:),qvlay(:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:),qval(:,:,:),qlay(:,:,:),g(:,:)
REAL, ALLOCATABLE :: mcd(:,:,:),orbcomp(:,:,:),qmtp(:,:)
REAL, ALLOCATABLE :: qintsl(:,:),qmtsl(:,:),qvac(:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:)
CHARACTER(len=2) :: spin12(2),ch_mcd(3)
CHARACTER(len=8) :: chntype*2,chform*19
DATA spin12/'.1' , '.2'/
......@@ -88,7 +86,7 @@
ENDIF
ALLOCATE( qal(qdim,dimension%neigd,kpts%nkpt),&
& qval(vacuum%nstars*vacuum%layers*vacuum%nvac,dimension%neigd,kpts%nkpt),&
& qlay(dimension%neigd,vacuum%layerd,2),qstars(vacuum%nstars,dimension%neigd,vacuum%layerd,2))
& qlay(dimension%neigd,vacuum%layerd,2))
IF (l_mcd) THEN
ALLOCATE( mcd(3*atoms%ntype*ncored,dimension%neigd,kpts%nkpt) )
ELSE
......@@ -161,36 +159,31 @@
!
! read data from file!
!
ALLOCATE( ksym(dimension%neigd),jsym(dimension%neigd) )
ALLOCATE( qal_tmp(1:lmax,atoms%ntype,dimension%neigd))
ALLOCATE( orbcomp(dimension%neigd,23,atoms%nat),qintsl(nsld,dimension%neigd))
ALLOCATE( qmtsl(nsld,dimension%neigd),qmtp(dimension%neigd,atoms%nat),qvac(dimension%neigd,2))
ALLOCATE( qis(dimension%neigd),qvlay(dimension%neigd,vacuum%layerd,2))
CALL read_eig(eig_id,k,jspin,neig=nevk(k),eig=ev(:,k))
CALL read_dos(eig_id,k,jspin,qal_tmp,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
ALLOCATE( qmtsl(nsld,dimension%neigd),qmtp(dimension%neigd,atoms%nat))
CALL read_dos(eig_id,k,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
IF (.NOT.l_orbcomp) THEN
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
qal(1:lmax*atoms%ntype,:,k)=reshape(dos%qal(0:,:,:,k,jspin),(/lmax*atoms%ntype,size(dos%qal,3)/))
qal(lmax*atoms%ntype+2,:,k)=dos%qvac(:,1,k,jspin) ! vacuum 1
qal(lmax*atoms%ntype+3,:,k)=dos%qvac(:,2,k,jspin) ! vacuum 2
qal(lmax*atoms%ntype+1,:,k)=dos%qis(:,k,jspin) ! interstitial
ELSE
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)
DO l = 1, results%neig(k,jspin)
qal(i,l,k) = orbcomp(l,i,n_orb)*qmtp(l,n_orb)/10000.
END DO
DO l = nevk(k)+1, dimension%neigd
DO l = results%neig(k,jspin)+1, dimension%neigd
qal(i,l,k) = 0.0
END DO
END DO
END IF
END IF
DEALLOCATE( ksym,jsym )
DEALLOCATE( orbcomp,qintsl,qmtsl,qmtp,qvac,qis,qal_tmp,qvlay)
ntb = max(ntb,nevk(k))
DEALLOCATE( orbcomp,qintsl,qmtsl,qmtp)
ntb = max(ntb,results%neig(k,jspin))
!
! set vacuum partial charge zero, if bulk calculation
! otherwise, write vacuum charge in correct arrays
......@@ -201,13 +194,13 @@
qal(lmax*atoms%ntype+3,n,k) = 0.0
ENDDO
ELSEIF ( banddos%vacdos .and. input%film ) THEN
DO i = 1,nevk(k)
DO i = 1,results%neig(k,jspin)
DO v = 1,vacuum%nvac
DO l = 1,vacuum%layers
index = (l-1)*vacuum%nstars + (v-1)*(vacuum%nstars*vacuum%layers) + 1
qval(index,i,k) = qlay(i,l,v)
DO s = 1,vacuum%nstars - 1
qval(index+s,i,k) = real(qstars(s,i,l,v))
qval(index+s,i,k) = real(dos%qstars(s,i,l,v,k,jspin))
ENDDO
ENDDO
ENDDO
......@@ -236,10 +229,10 @@
!
!---- > convert eigenvalues to ev and shift them by efermi
!
DO i = 1 , nevk(k)
ev(i,k) = ev(i,k)*hartree_to_ev_const - efermi
DO i = 1 , results%neig(k,jspin)
ev(i,k) = results%eig(i,k,jspin)*hartree_to_ev_const - efermi
ENDDO
DO i = nevk(k) + 1, dimension%neigd
DO i = results%neig(k,jspin) + 1, dimension%neigd
ev(i,k) = 9.9e+99
ENDDO
!
......@@ -327,7 +320,7 @@
ELSE
write(*,*) efermi
CALL tetra_dos(lmax,atoms%ntype,dimension%neigd,ned,ntetra,kpts%nkpt,&
itetra,efermi,voltet,e,nevk, ev,qal, g)
itetra,efermi,voltet,e,results%neig(:,jspin), ev,qal, g)
IF (input%jspins.EQ.1) g(:,:) = 2 * g(:,:)
ENDIF
ELSE
......@@ -336,10 +329,10 @@
!
IF ( .not.l_mcd ) THEN
CALL dos_bin(input%jspins,qdim,ned,emin,emax,dimension%neigd,kpts%nkpt,&
nevk,kpts%wtkpt(1:kpts%nkpt),ev,qal, g)
results%neig(:,jspin),kpts%wtkpt(1:kpts%nkpt),ev,qal, g)
ELSE
CALL dos_bin(input%jspins,3*atoms%ntype*ncored,ned,emin,emax,ntb,kpts%nkpt,&
nevk(1:kpts%nkpt),kpts%wtkpt(1:kpts%nkpt),ev(1:ntb,1:kpts%nkpt), mcd(1:3*atoms%ntype*ncored,1:ntb,1:kpts%nkpt), g)
results%neig(:,jspin),kpts%wtkpt(1:kpts%nkpt),ev(1:ntb,1:kpts%nkpt), mcd(1:3*atoms%ntype*ncored,1:ntb,1:kpts%nkpt), g)
ENDIF
ENDIF
!
......@@ -487,7 +480,7 @@
END IF
OPEN (18,FILE='bands'//spin12(jspin))
ntb = minval(nevk(:))
ntb = minval(results%neig(:,jspin))
kx(1) = 0.0
vkr(:,1)=matmul(kpts%bk(:,1),cell%bmat)
DO k = 2, kpts%nkpt
......@@ -530,7 +523,7 @@
ENDDO
ENDIF
DEALLOCATE(qal,qval,qlay,qstars)
DEALLOCATE(qal,qval,qlay)
IF (l_mcd) DEALLOCATE( mcd )
99001 FORMAT (f10.5,110(1x,e10.3))
......
io/eig66_da.F90
View file @ cced8df0
......@@ -266,12 +266,9 @@ CONTAINS
END SUBROUTINE write_eig
SUBROUTINE write_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE write_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(IN) :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
COMPLEX,INTENT(IN) :: qstars(:,:,:,:)
INTEGER,INTENT(IN) :: ksym(:),jsym(:)
REAL,INTENT(IN),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(IN),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
TYPE(t_data_DA),POINTER:: d
......@@ -282,20 +279,15 @@ CONTAINS
IF (d%l_orb.AND.PRESENT(qmtsl)) THEN
IF (d%l_mcd) CPP_error("mcd & orbital decomposition not implemented in IO")
WRITE(d%file_io_id_dos,REC=nrec) qal,qvac,qis,qvlay,qstars,ksym,jsym,qintsl,qmtsl,qmtp,orbcomp
WRITE(d%file_io_id_dos,REC=nrec) qintsl,qmtsl,qmtp,orbcomp
ELSEIF(d%l_mcd.AND.PRESENT(mcd)) THEN
WRITE(d%file_io_id_dos,REC=nrec) qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd
ELSE
WRITE(d%file_io_id_dos,REC=nrec) qal,qvac,qis,qvlay,qstars,ksym,jsym
WRITE(d%file_io_id_dos,REC=nrec) mcd
END IF
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(OUT) :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
COMPLEX,INTENT(OUT) :: qstars(:,:,:,:)
INTEGER,INTENT(OUT) :: ksym(:),jsym(:)
REAL,INTENT(OUT),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(OUT),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
TYPE(t_data_DA),POINTER:: d
......@@ -306,11 +298,9 @@ CONTAINS
IF (d%l_orb.AND.PRESENT(qmtsl)) THEN
IF (d%l_mcd) CPP_error("mcd & orbital decomposition not implemented in IO")
READ(d%file_io_id_dos,REC=nrec) qal,qvac,qis,qvlay,qstars,ksym,jsym,qintsl,qmtsl,qmtp,orbcomp
READ(d%file_io_id_dos,REC=nrec) qintsl,qmtsl,qmtp,orbcomp
ELSEIF(d%l_mcd.AND.PRESENT(mcd)) THEN
READ(d%file_io_id_dos,REC=nrec) qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd
ELSE
READ(d%file_io_id_dos,REC=nrec) qal,qvac,qis,qvlay,qstars,ksym,jsym
READ(d%file_io_id_dos,REC=nrec) mcd
END IF
END SUBROUTINE read_dos
......
io/eig66_hdf.F90
View file @ cced8df0
......@@ -294,28 +294,14 @@ CONTAINS
END SUBROUTINE priv_r_vec
#endif
SUBROUTINE read_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(OUT) :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
COMPLEX,INTENT(OUT) :: qstars(:,:,:,:)
INTEGER,INTENT(OUT) :: ksym(:),jsym(:)
REAL,INTENT(OUT),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(OUT),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
TYPE(t_data_HDF),POINTER :: d
REAL,ALLOCATABLE :: r_tmp5(:,:,:,:,:)
CALL priv_find_data(id,d)
#ifdef CPP_HDF
CALL io_read_real3(d%qalsetid,(/1,1,1,nk,jspin/),(/SIZE(qal,1),SIZE(qal,2),SIZE(qal,3),1,1/),qal)
CALL io_read_real2(d%qvacsetid,(/1,1,nk,jspin/),(/SIZE(qvac,1),SIZE(qvac,2),1,1/),qvac)
CALL io_read_real1(d%qissetid,(/1,nk,jspin/),(/SIZE(qis,1),1,1/),qis)
CALL io_read_real3(d%qvlaysetid,(/1,1,1,nk,jspin/),(/SIZE(qvlay,1),SIZE(qvlay,2),SIZE(qvlay,3),1,1/),qvlay)
ALLOCATE(r_tmp5(2,SIZE(qstars,1),SIZE(qstars,2),SIZE(qstars,3),SIZE(qstars,4)))
CALL io_read_real5(d%qstarssetid,(/1,1,1,1,1,nk,jspin/),(/2,SIZE(qstars,1),SIZE(qstars,2),SIZE(qstars,3),SIZE(qstars,4),1,1/),r_tmp5(:,:,:,:,:))
qstars=CMPLX(r_tmp5(1,:,:,:,:),r_tmp5(2,:,:,:,:))
DEALLOCATE(r_tmp5)
CALL io_read_integer1(d%ksymsetid,(/1,nk,jspin/),(/SIZE(ksym,1),1,1/),ksym)
CALL io_read_integer1(d%jsymsetid,(/1,nk,jspin/),(/SIZE(jsym,1),1,1/),jsym)
IF (d%l_mcd.AND.PRESENT(mcd)) THEN
CALL io_read_real3(d%mcdsetid,(/1,1,1,nk,jspin/),(/SIZE(mcd,1),SIZE(mcd,2),SIZE(mcd,3),1,1/),mcd)
ENDIF
......@@ -329,26 +315,14 @@ CONTAINS
END SUBROUTINE read_dos
SUBROUTINE write_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE write_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(IN) :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
COMPLEX,INTENT(IN) :: qstars(:,:,:,:)
INTEGER,INTENT(IN) :: ksym(:),jsym(:)
REAL,INTENT(IN),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(IN),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
TYPE(t_data_HDF),POINTER ::d
CALL priv_find_data(id,d)
#ifdef CPP_HDF
CALL io_write_real3(d%qalsetid,(/1,1,1,nk,jspin/),(/SIZE(qal,1),SIZE(qal,2),SIZE(qal,3),1,1/),qal)
CALL io_write_real2(d%qvacsetid,(/1,1,nk,jspin/),(/SIZE(qvac,1),SIZE(qvac,2),1,1/),qvac)
CALL io_write_real1(d%qissetid,(/1,nk,jspin/),(/SIZE(qis,1),1,1/),qis)
CALL io_write_real3(d%qvlaysetid,(/1,1,1,nk,jspin/),(/SIZE(qvlay,1),SIZE(qvlay,2),SIZE(qvlay,3),1,1/),qvlay)
CALL io_write_real4(d%qstarssetid,(/1,1,1,1,1,nk,jspin/),(/1,SIZE(qstars,1),SIZE(qstars,2),SIZE(qstars,3),SIZE(qstars,4),1,1/),REAL(qstars))
CALL io_write_real4(d%qstarssetid,(/2,1,1,1,1,nk,jspin/),(/1,SIZE(qstars,1),SIZE(qstars,2),SIZE(qstars,3),SIZE(qstars,4),1,1/),AIMAG(qstars))
CALL io_write_integer1(d%ksymsetid,(/1,nk,jspin/),(/SIZE(ksym,1),1,1/),ksym)
CALL io_write_integer1(d%jsymsetid,(/1,nk,jspin/),(/SIZE(jsym,1),1,1/),jsym)
IF (d%l_mcd.AND.PRESENT(mcd)) THEN
CALL io_write_real3(d%mcdsetid,(/1,1,1,nk,jspin/),(/SIZE(mcd,1),SIZE(mcd,2),SIZE(mcd,3),1,1/),mcd)
ENDIF
......
io/eig66_io.F90
View file @ cced8df0
......@@ -167,7 +167,7 @@ CONTAINS
CALL timestop("IO (write)")
END SUBROUTINE write_eig
SUBROUTINE write_dos(id,nk,jspin,dos,slab,orbcomp,ksym,jsym,mcd)
SUBROUTINE write_dos(id,nk,jspin,slab,orbcomp,mcd)
USE m_eig66_hdf,ONLY:write_dos_hdf=>write_dos
USE m_eig66_DA ,ONLY:write_dos_DA=>write_dos
USE m_eig66_mem,ONLY:write_dos_MEM=>write_dos
......@@ -175,29 +175,19 @@ CONTAINS
USE m_types
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
TYPE(t_dos), INTENT(IN) :: dos
TYPE(t_orbcomp), INTENT(IN) :: orbcomp
TYPE(t_slab), INTENT(IN) :: slab
INTEGER,INTENT(IN) :: ksym(:),jsym(:)
REAL,INTENT(IN),OPTIONAL :: mcd(:,:,:)
CALL timestart("IO (dos-write)")
SELECT CASE (eig66_data_mode(id))
CASE (da_mode)
CALL write_dos_DA(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CALL write_dos_DA(id,nk,jspin,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (hdf_mode)
CALL write_dos_HDF(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CALL write_dos_HDF(id,nk,jspin,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (mem_mode)
CALL write_dos_Mem(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CALL write_dos_Mem(id,nk,jspin,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (MPI_mode)
CALL write_dos_MPI(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CALL write_dos_MPI(id,nk,jspin,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (-1)
CALL juDFT_error("Could not write DOS to eig-file before opening", calledby = "eig66_io")
END SELECT
......@@ -205,28 +195,25 @@ CONTAINS
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
USE m_eig66_hdf,ONLY:read_dos_hdf=>read_dos
USE m_eig66_DA ,ONLY:read_dos_DA=>read_dos
USE m_eig66_mem,ONLY:read_dos_MEM=>read_dos
USE m_eig66_MPI,ONLY:read_dos_MPI=>read_dos
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(OUT) :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
COMPLEX,INTENT(OUT) :: qstars(:,:,:,:)
INTEGER,INTENT(OUT) :: ksym(:),jsym(:)
REAL,INTENT(OUT),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(OUT),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
CALL timestart("IO (dos-read)")
SELECT CASE (eig66_data_mode(id))
CASE (da_mode)
CALL read_dos_DA(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
CALL read_dos_DA(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
CASE (hdf_mode)
CALL read_dos_HDF(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
CALL read_dos_HDF(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
CASE (mem_mode)
CALL read_dos_Mem(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
CALL read_dos_Mem(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
CASE (MPI_mode)
CALL read_dos_MPI(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
CALL read_dos_MPI(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
CASE (-1)
CALL juDFT_error("Could not DOS from read eig-file before opening", calledby = "eig66_io")
END SELECT
......
io/eig66_mem.F90
View file @ cced8df0
......@@ -151,12 +151,9 @@ CONTAINS
END SUBROUTINE priv_writetofile
END SUBROUTINE close_eig
SUBROUTINE write_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE write_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(IN) :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
COMPLEX,INTENT(IN) :: qstars(:,:,:,:)
INTEGER,INTENT(IN) :: ksym(:),jsym(:)
REAL,INTENT(IN),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(IN),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
......@@ -166,13 +163,6 @@ CONTAINS
nrec=nk+(jspin-1)*d%nkpts
d%qal(:,:,:,nrec)=qal
d%qvac(:,:,nrec)=qvac
d%qis(:,nrec)=qis
d%qvlay(:,:,:,nrec)=qvlay
d%qstars(:,:,:,:,nrec)=qstars
d%ksym(:,nrec)=ksym
d%jsym(:,nrec)=jsym
IF (d%l_mcd.AND.PRESENT(mcd)) d%mcd(:,:,:,nrec)=mcd
IF (d%l_orb.AND.PRESENT(qintsl)) THEN
d%qintsl(:,:,nrec)=qintsl
......@@ -182,12 +172,9 @@ CONTAINS
ENDIF
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(OUT) :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
COMPLEX,INTENT(OUT) :: qstars(:,:,:,:)
INTEGER,INTENT(OUT) :: ksym(:),jsym(:)
REAL,INTENT(OUT),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(OUT),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
......@@ -197,13 +184,6 @@ CONTAINS
nrec=nk+(jspin-1)*d%nkpts
qal=d%qal(:,:,:,nrec)
qvac=d%qvac(:,:,nrec)
qis=d%qis(:,nrec)
qvlay=d%qvlay(:,:,:,nrec)
qstars=d%qstars(:,:,:,:,nrec)
ksym=d%ksym(:,nrec)
jsym=d%jsym(:,nrec)
IF (d%l_mcd.AND.PRESENT(mcd)) mcd=d%mcd(:,:,:,nrec)
IF (d%l_orb.AND.PRESENT(qintsl)) THEN
qintsl=d%qintsl(:,:,nrec)
......
io/eig66_mpi.F90
View file @ cced8df0
......@@ -502,12 +502,9 @@ CONTAINS
END SUBROUTINE priv_get_data
#endif
SUBROUTINE write_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE write_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(IN) :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
COMPLEX,INTENT(IN) :: qstars(:,:,:,:)
INTEGER,INTENT(IN) :: ksym(:),jsym(:)
REAL,INTENT(IN),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(IN),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
#ifdef CPP_MPI
......@@ -518,13 +515,6 @@ CONTAINS
pe=d%pe_basis(nk,jspin)
slot=d%slot_basis(nk,jspin)
CALL priv_put_data(pe,slot,RESHAPE(qal,(/SIZE(qal)/)),d%qal_handle)
CALL priv_put_data(pe,slot,RESHAPE(qvac,(/SIZE(qvac)/)),d%qvac_handle)
CALL priv_put_data(pe,slot,RESHAPE(qis,(/SIZE(qis)/)),d%qis_handle)
CALL priv_put_data(pe,slot,RESHAPE(qvlay,(/SIZE(qvlay)/)),d%qvlay_handle)
CALL priv_put_data(pe,slot,RESHAPE(qstars,(/SIZE(qstars)/)),d%qstars_handle)
CALL priv_put_data(pe,slot,RESHAPE(ksym,(/SIZE(ksym)/)),d%ksym_handle)
CALL priv_put_data(pe,slot,RESHAPE(jsym,(/SIZE(jsym)/)),d%jsym_handle)
IF (d%l_mcd.AND.PRESENT(mcd)) CALL priv_put_data(pe,slot,RESHAPE(mcd,(/SIZE(mcd)/)),d%mcd_handle)
IF (d%l_orb.AND.PRESENT(qintsl)) THEN
CALL priv_put_data(pe,slot,RESHAPE(qintsl,(/SIZE(qintsl)/)),d%qintsl_handle)
......@@ -535,12 +525,9 @@ CONTAINS
#endif
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(out) :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
COMPLEX,INTENT(out) :: qstars(:,:,:,:)
INTEGER,INTENT(out) :: ksym(:),jsym(:)
REAL,INTENT(out),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(out),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
#ifdef CPP_MPI
......@@ -551,13 +538,6 @@ CONTAINS
pe=d%pe_basis(nk,jspin)
slot=d%slot_basis(nk,jspin)
CALL priv_get_data(pe,slot,SIZE(qal),d%qal_handle,rdata=qal)
CALL priv_get_data(pe,slot,SIZE(qvac),d%qvac_handle,rdata=qvac)
CALL priv_get_data(pe,slot,SIZE(qis),d%qis_handle,rdata=qis)
CALL priv_get_data(pe,slot,SIZE(qvlay),d%qvlay_handle,rdata=qvlay)
CALL priv_get_data(pe,slot,SIZE(qstars),d%qstars_handle,cdata=qstars)
CALL priv_get_data(pe,slot,SIZE(ksym),d%ksym_handle,idata=ksym)
CALL priv_get_data(pe,slot,SIZE(jsym),d%jsym_handle,idata=jsym)
IF (d%l_mcd.AND.PRESENT(mcd)) CALL priv_get_data(pe,slot,SIZE(mcd),d%mcd_handle,rdata=mcd)
IF (d%l_orb.AND.PRESENT(qintsl)) THEN
CALL priv_get_data(pe,slot,SIZE(qintsl),d%qintsl_handle,rdata=qintsl)
......
main/cdngen.F90
View file @ cced8df0
......@@ -104,7 +104,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL timestart("cdngen: dos")
CALL doswrite(eig_id,dimension,kpts,atoms,vacuum,input,banddos,sliceplot,noco,sym,cell,dos,mcd,results,slab%nsld,oneD)
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspmax,sym,cell,slab)
CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspmax,sym,cell,dos,slab)
END IF
CALL timestop("cdngen: dos")
END IF
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment