Commit 49d5f493 authored by Daniel Wortmann's avatar Daniel Wortmann

Changed interface and functionality of read_eig & write_eig, most probable still broken...

parent 12fb707b
......@@ -133,7 +133,7 @@ CONTAINS
! .. Local Scalars ..
TYPE(t_lapw):: lapw
INTEGER :: llpd
REAL wk,wronk,sign,emcd_lo,emcd_up
REAL wronk,sign,emcd_lo,emcd_up
INTEGER i,ie,iv,ivac,j,k,l,l1,lh ,n,ilo,isp,nat,&
nbands,noded,nodeu,noccbd,nslibd,na,&
ikpt,npd ,jsp_start,jsp_end,ispin
......@@ -144,8 +144,6 @@ CONTAINS
! ...Local Arrays ..
INTEGER n_bands(0:dimension%neigd),ncore(atoms%ntype)
REAL cartk(3),xp(3,dimension%nspd),e_mcd(atoms%ntype,input%jspins,dimension%nstd)
REAL ello(atoms%nlod,atoms%ntype,dimension%jspd),evac(2,dimension%jspd)
REAL epar(0:atoms%lmaxd,atoms%ntype,dimension%jspd),evdu(2,dimension%jspd)
REAL eig(dimension%neigd)
REAL vz0(2)
REAL uuilon(atoms%nlod,atoms%ntype),duilon(atoms%nlod,atoms%ntype)
......@@ -342,7 +340,7 @@ CONTAINS
eig_id,&
mpi%irank,mpi%isize,jspin,dimension%jspd,&
noco%l_noco,&
ello,evac,epar,wk,n_bands,n_size)
n_bands,n_size)
#ifdef CPP_MPI
! Sinchronizes the RMA operations
CALL MPI_BARRIER(mpi%mpi_comm,ie)
......@@ -375,11 +373,11 @@ CONTAINS
DO l = 0,atoms%lmax(n)
DO ispin =jsp_start,jsp_end
CALL radfun(&
l,n,ispin,epar(l,n,ispin),vr(1,0,n,ispin),atoms,&
l,n,ispin,enpara%el0(l,n,ispin),vr(1,0,n,ispin),atoms,&
f(1,1,l,ispin),g(1,1,l,ispin),usdus,&
nodeu,noded,wronk)
IF (input%cdinf.AND.mpi%irank==0) WRITE (6,FMT=8002) l,&
epar(l,n,ispin),usdus%us(l,n,ispin),usdus%dus(l,n,ispin),nodeu,&
enpara%el0(l,n,ispin),usdus%us(l,n,ispin),usdus%dus(l,n,ispin),nodeu,&
usdus%uds(l,n,ispin),usdus%duds(l,n,ispin),noded,usdus%ddn(l,n,ispin),&
wronk
END DO
......@@ -408,7 +406,7 @@ CONTAINS
!
IF ( atoms%nlo(n) > 0 ) THEN
DO ispin = jsp_start,jsp_end
CALL radflo(atoms,n,ispin, ello(1,1,ispin),vr(:,0,n,ispin), f(1,1,0,ispin),&
CALL radflo(atoms,n,ispin, enpara%ello0(1,1,ispin),vr(:,0,n,ispin), f(1,1,0,ispin),&
g(1,1,0,ispin),mpi, usdus, uuilon,duilon,ulouilopn, flo(:,:,:,ispin))
END DO
END IF
......@@ -561,8 +559,7 @@ CONTAINS
eig_id,dimension%nvd,dimension%jspd,mpi%irank,mpi%isize,&
ikpt,jspin,zmat%nbasfcn,noco%l_ss,noco%l_noco,&
noccbd,n_start,n_end,&
ello,evdu,epar,&
wk,nbands,eig,zMat)
nbands,eig,zMat)
#ifdef CPP_MPI
! Sinchronizes the RMA operations
if (l_evp) CALL MPI_BARRIER(mpi%mpi_comm,ie)
......@@ -575,8 +572,8 @@ CONTAINS
CALL nstm3(&
sym,atoms,vacuum,stars,ikpt,lapw%nv(jspin),&
input,jspin,kpts,&
cell,wk,lapw%k1(:,jspin),lapw%k2(:,jspin),&
evac(1,jspin),vz,vz0,&
cell,kpts%wtkpt(ikpt),lapw%k1(:,jspin),lapw%k2(:,jspin),&
enpara%evac0(1,jspin),vz,vz0,&
gvac1d,gvac2d)
END IF
......@@ -591,7 +588,7 @@ CONTAINS
IF (mpi%irank==0) WRITE (16,FMT=*) 'NNNE',sliceplot%nnne
IF (mpi%irank==0) WRITE (16,FMT=*) 'sliceplot%kk',sliceplot%kk
nslibd = 0
IF (input%pallst) we(:nbands) = wk
IF (input%pallst) we(:nbands) = kpts%wtkpt(ikpt)
IF (sliceplot%kk.EQ.0) THEN
IF (mpi%irank==0) THEN
WRITE (16,FMT='(a)') 'ALL K-POINTS ARE TAKEN IN SLICE'
......@@ -680,7 +677,7 @@ CONTAINS
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL timestart("cdnval: vacden")
CALL vacden(vacuum,dimension,stars,oneD, kpts,input, cell,atoms,noco,banddos,&
gvac1d,gvac2d, we,ikpt,jspin,vz,vz0, noccbd,lapw, evac,eig,&
gvac1d,gvac2d, we,ikpt,jspin,vz,vz0, noccbd,lapw, enpara%evac0,eig,&
den,qvac,qvlay, qstars,zMat)
CALL timestop("cdnval: vacden")
END IF
......@@ -821,7 +818,7 @@ CONTAINS
bcof(:,0:,:,ispin),e1cof,e2cof, acoflo,bcoflo, results,f_a12)
ENDIF
CALL force_a21(input,atoms,dimension,noccbd,sym,&
oneD,cell,we,ispin,epar(0:,:,ispin),noccbd,eig,usdus,acof(:,0:,:,ispin),&
oneD,cell,we,ispin,enpara%el0(0:,:,ispin),noccbd,eig,usdus,acof(:,0:,:,ispin),&
bcof(:,0:,:,ispin),ccof(-atoms%llod:,:,:,:,ispin), aveccof,bveccof,cveccof,&
results,f_a21,f_b4)
......@@ -943,7 +940,7 @@ CONTAINS
CALL cdnmt(&
dimension%jspd,atoms,sphhar,llpd,&
noco,l_fmpl,jsp_start,jsp_end,&
epar,ello,vr(:,0,:,:),uu,du,dd,uunmt,udnmt,dunmt,ddnmt,&
enpara%el0,enpara%ello0,vr(:,0,:,:),uu,du,dd,uunmt,udnmt,dunmt,ddnmt,&
usdus,usdus%uloulopn,aclo,bclo,cclo,acnmt,bcnmt,ccnmt,&
orb,orbl,orblo,mt21,lo21,uloulopn21,uloulop21,&
uunmt21,ddnmt21,udnmt21,dunmt21,&
......
......@@ -32,7 +32,7 @@ CONTAINS
! ..
! .. Local Arrays
INTEGER norb(23),iqsl(nsld),iqvacpc(2)
REAL bkpt(3),qvact(2)
REAL qvact(2)
REAL, ALLOCATABLE :: eig(:),qvac(:,:,:,:),orbcomp(:,:,:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:),qis(:),qvlay(:,:,:)
COMPLEX,ALLOCATABLE::qstars(:,:,:,:)
......@@ -84,12 +84,12 @@ CONTAINS
!==============================================================
DO ikpt=1,kpts%nkpt
!
call read_eig(eig_id,ikpt,kspin,bk=bkpt,neig=nbands,eig=eig)
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,&
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)
WRITE (130,FMT=8000) (kpts%bk(i,ikpt),i=1,3)
8000 FORMAT (/,3x,' k =',3f10.5,/)
!
DO iband = 1,nbands
......
......@@ -106,7 +106,7 @@ CONTAINS
DO ikpt=1,kpts%nkpt
call read_eig(eig_id,ikpt,kspin,&
bk=bkpt,wk=wk,neig=ne,eig=eig)
neig=ne,eig=eig)
call read_dos(eig_id,ikpt,kspin,&
& qal(:,:,:,kspin),qvac(:,:,ikpt,kspin),&
& qis(:,ikpt,kspin),&
......@@ -114,8 +114,8 @@ CONTAINS
CALL cdninf(&
& input,sym,noco,kspin,atoms,&
& vacuum,sliceplot,banddos,ikpt,bkpt,&
& wk,cell,kpts,&
& vacuum,sliceplot,banddos,ikpt,kpts%bk(:,ikpt),&
& kpts%wtkpt(ikpt),cell,kpts,&
& ne,eig,qal(0:,:,:,kspin),qis,qvac,&
& qvlay(:,:,:),&
& qstars,ksym,jsym)
......
......@@ -164,7 +164,7 @@
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,wk=wt(k),neig=nevk(k),eig=ev(:,k))
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)
IF (.NOT.l_orbcomp) THEN
qal(1:lmax*atoms%ntype,:,k)=reshape(qal_tmp,(/lmax*atoms%ntype,size(qal_tmp,3)/))
......@@ -337,7 +337,7 @@
nevk,wt,ev,qal, g)
ELSE
CALL dos_bin(input%jspins,3*atoms%ntype*ncored,ned,emin,emax,ntb,kpts%nkpt,&
nevk(1:kpts%nkpt),wt(1:kpts%nkpt),ev(1:ntb,1:kpts%nkpt), mcd(1:3*atoms%ntype*ncored,1:ntb,1:kpts%nkpt), g)
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)
ENDIF
ENDIF
!
......
......@@ -199,14 +199,8 @@ CONTAINS
zMat%data_c(:lapw%nmat,:ne_found) = CMPLX(0.0,0.0)
ENDIF
ENDIF
CALL write_eig(eig_id, nk,jsp,ne_found,ne_all,lapw%nv(jsp),lapw%nmat,&
bkpt, kpts%wtkpt(nk),eig(:ne_found),el=enpara%el0(0:,:,jsp),ello=enpara%ello0(:,:,jsp),evac=enpara%evac0(:,jsp),&
nlotot=atoms%nlotot,n_start=mpi%n_size,n_end=mpi%n_rank,zmat=zMat)
IF (noco%l_noco) THEN
CALL write_eig(eig_id, nk,2,ne_found,ne_all,lapw%nv(2),lapw%nmat,&
bkpt, kpts%wtkpt(nk),eig(:ne_found),el=enpara%el0(0:,:,2),ello= enpara%ello0(:,:,2),evac=enpara%evac0(:,2),&
nlotot=atoms%nlotot)
ENDIF
CALL write_eig(eig_id, nk,jsp,ne_found,ne_all,&
eig(:ne_found),n_start=mpi%n_size,n_end=mpi%n_rank,zmat=zMat)
#if defined(CPP_MPI)
!RMA synchronization
CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
......
......@@ -8,7 +8,7 @@ MODULE m_aline
USE m_juDFT
CONTAINS
SUBROUTINE aline(eig_id, nk,atoms,DIMENSION,sym,&
cell,input, jsp,el,usdus,lapw,tlmplm, noco, oneD, bkpt,eig,ne,zMat,hmat,smat)
cell,input, jsp,el,usdus,lapw,tlmplm, noco, oneD,eig,ne,zMat,hmat,smat)
!************************************************************************
!* *
!* eigensystem-solver for moderatly-well converged potentials *
......@@ -54,7 +54,7 @@ CONTAINS
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: el(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd)
REAL, INTENT (OUT) :: eig(DIMENSION%neigd),bkpt(3)
REAL, INTENT (OUT) :: eig(DIMENSION%neigd)
TYPE(t_mat),INTENT(IN):: hmat,smat
! ..
......@@ -80,7 +80,7 @@ CONTAINS
lhelp= MAX(lapw%nmat,(DIMENSION%neigd+2)*DIMENSION%neigd)
CALL read_eig(eig_id,nk,jsp,bk=bkpt,neig=ne,nv=lapw%nv(jsp),nmat=lapw%nmat, eig=eig,zmat=zmat)
CALL read_eig(eig_id,nk,jsp,neig=ne, eig=eig,zmat=zmat)
IF (l_real) THEN
ALLOCATE ( h_r(DIMENSION%neigd,DIMENSION%neigd),s_r(DIMENSION%neigd,DIMENSION%neigd) )
h_r = 0.0 ; s_r=0.0
......
......@@ -12,7 +12,7 @@ CONTAINS
rsopp,rsoppd,rsopdp,rsopdpd,nk,&
rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop,&
usdus,soangl,&
ello,nsize,nmat,&
nsize,nmat,&
eig_so,zso)
#include"cpp_double.h"
......@@ -50,7 +50,7 @@ CONTAINS
REAL, INTENT (IN) :: rsoploplop(atoms%ntype,atoms%nlod,atoms%nlod,2,2)
COMPLEX, INTENT (IN) :: soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2)
COMPLEX, INTENT (OUT) :: zso(:,:,:)!(dimension%nbasfcn,2*dimension%neigd,wannierspin)
REAL, INTENT (OUT) :: eig_so(2*DIMENSION%neigd),ello(atoms%nlod,atoms%ntype,DIMENSION%jspd)
REAL, INTENT (OUT) :: eig_so(2*DIMENSION%neigd)
!-odim
!+odim
! ..
......@@ -65,8 +65,7 @@ CONTAINS
! ..
! .. Local Arrays ..
INTEGER :: nsz(2)
REAL :: eig(DIMENSION%neigd,DIMENSION%jspd),s(3),bkpt(3)
REAL :: epar(0:atoms%lmaxd,atoms%ntype),evac(2)
REAL :: eig(DIMENSION%neigd,DIMENSION%jspd),s(3)
REAL, ALLOCATABLE :: rwork(:)
COMPLEX,ALLOCATABLE :: cwork(:),chelp(:,:,:,:,:)
COMPLEX,ALLOCATABLE :: ahelp(:,:,:,:,:),bhelp(:,:,:,:,:)
......@@ -113,9 +112,7 @@ CONTAINS
DO jsp = 1,input%jspins
CALL read_eig(&
eig_id,nk,jsp,&
el=epar,ello=ello(:,:,jsp),&
evac=evac,neig=ne,eig=eig(:,jsp))
eig_id,nk,jsp, neig=ne,eig=eig(:,jsp))
CALL read_eig(&
eig_id,nk,jsp,&
n_start=1,n_end=ne,&
......
......@@ -21,7 +21,7 @@ MODULE m_eigenso
!
CONTAINS
SUBROUTINE eigenso(eig_id,mpi,DIMENSION,stars,vacuum,atoms,sphhar,&
obsolete,sym,cell,noco,input,kpts,oneD,vTot)
obsolete,sym,cell,noco,input,kpts,oneD,vTot,enpara)
USE m_eig66_io, ONLY : read_eig,write_eig
USE m_spnorb
......@@ -46,6 +46,7 @@ CONTAINS
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: vTot
TYPE(t_enpara),INTENT(IN) :: enpara
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: eig_id
......@@ -56,7 +57,6 @@ CONTAINS
INTEGER n_loc,n_plus,i_plus,n_end,nsz,nmat
LOGICAL l_socvec !,l_all
INTEGER wannierspin
TYPE(t_enpara) :: enpara
TYPE(t_usdus):: usdus
! ..
! .. Local Arrays..
......@@ -89,10 +89,8 @@ CONTAINS
usdus%uds(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),usdus%duds(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),&
usdus%ddn(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),&
usdus%ulos(atoms%nlod,atoms%ntype,DIMENSION%jspd),usdus%dulos(atoms%nlod,atoms%ntype,DIMENSION%jspd),&
usdus%uulon(atoms%nlod,atoms%ntype,DIMENSION%jspd),usdus%dulon(atoms%nlod,atoms%ntype,DIMENSION%jspd),&
enpara%evac0(2,DIMENSION%jspd),enpara%ello0(atoms%nlod,atoms%ntype,DIMENSION%jspd),&
enpara%el0(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd))
usdus%uulon(atoms%nlod,atoms%ntype,DIMENSION%jspd),usdus%dulon(atoms%nlod,atoms%ntype,DIMENSION%jspd))
IF (input%l_wann.OR.l_socvec) THEN
wannierspin = 2
ELSE
......@@ -101,15 +99,8 @@ CONTAINS
!
!---> set up and solve the eigenvalue problem
! ---> radial k-idp s-o matrix elements calc. and storage
!
!---> radial k-idp s-o matrix elements calc. and storage
!
DO jspin = 1, input%jspins
CALL read_eig(eig_id,&
1,jspin,&
el=enpara%el0(:,:,jspin),&
ello=enpara%ello0(:,:,jspin),evac=enpara%evac0(:,jspin))
ENDDO
#if defined(CPP_MPI)
!RMA synchronization
CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
......@@ -215,14 +206,10 @@ CONTAINS
ALLOCATE( zso(lapw%nv(1)+atoms%nlotot,2*DIMENSION%neigd,wannierspin))
zso(:,:,:) = CMPLX(0.0,0.0)
CALL timestart("eigenso: alineso")
CALL alineso(eig_id,lapw,&
mpi,DIMENSION,atoms,sym,kpts,&
input,noco,cell,oneD,&
rsopp,rsoppd,rsopdp,rsopdpd,nk,&
CALL alineso(eig_id,lapw, mpi,DIMENSION,atoms,sym,kpts,&
input,noco,cell,oneD, rsopp,rsoppd,rsopdp,rsopdpd,nk,&
rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop,&
usdus,soangl,&
enpara%ello0,nsz,nmat,&
eig_so,zso)
usdus,soangl, nsz,nmat, eig_so,zso)
CALL timestop("eigenso: alineso")
IF (mpi%irank.EQ.0) THEN
WRITE (16,FMT=8010) nk,nsz
......@@ -233,18 +220,14 @@ CONTAINS
8020 FORMAT (5x,5f12.6)
IF (input%eonly) THEN
CALL write_eig(eig_id,&
nk,jspin,neig=nsz,neig_total=nsz,nmat=SIZE(zso,1),&
eig=eig_so(:nsz))
CALL write_eig(eig_id, nk,jspin,neig=nsz,neig_total=nsz, eig=eig_so(:nsz))
ELSE
CALL zmat%alloc(.FALSE.,SIZE(zso,1),nsz)
DO jspin = 1,wannierspin
CALL timestart("eigenso: write_eig")
zmat%data_c=zso(:,:nsz,jspin)
CALL write_eig(eig_id,&
nk,jspin,neig=nsz,neig_total=nsz,nmat=nmat,&
eig=eig_so(:nsz),zmat=zmat)
CALL write_eig(eig_id, nk,jspin,neig=nsz,neig_total=nsz, eig=eig_so(:nsz),zmat=zmat)
CALL timestop("eigenso: write_eig")
ENDDO
......
......@@ -76,15 +76,16 @@ CONTAINS
nrec1 = kpts%nkpt*(jsp-1) + nk
zmat(nk)%nbasfcn=dimension%nbasfcn
zmat(nk)%nbands=dimension%neigd2
if (l_real) THEN
IF (l_real) THEN
ALLOCATE(zmat(nk)%z_r(dimension%nbasfcn,dimension%neigd2))
ALLOCATE(zmat(nk)%z_c(0,0))
else
ALLOCATE(zmat(nk)%z_c(dimension%nbasfcn,dimension%neigd2))
ALLOCATE(zmat(nk)%z_r(0,0))
endif
CALL read_eig(eig_id_hf,nk,jsp,el=el_eig,ello=ello_eig, neig=hybrid%ne_eig(nk),eig=eig_irr(:,nk), w_iks=results%w_iks(:,nk,jsp),&!kveclo=hybdat%kveclo_eig(:,nk),
zmat=zmat(nk))
ENDIF
CALL judft_error("TODO,hs_setup")
!CALL read_eig(eig_id_hf,nk,jsp,el=el_eig,ello=ello_eig, neig=hybrid%ne_eig(nk),eig=eig_irr(:,nk), w_iks=results%w_iks(:,nk,jsp),&!kveclo=hybdat%kveclo_eig(:,nk),
! zmat=zmat(nk))
END DO
!Allocate further space
......@@ -301,7 +302,8 @@ CONTAINS
! Reading the eig file
!DO nk = n_start,kpts%nkpt,n_stride
DO nk = 1,kpts%nkpt,1
CALL read_eig(eig_id_hf,nk,jsp,el=el_eig, ello=ello_eig,neig=hybrid%ne_eig(nk),w_iks=results%w_iks(:,nk,jsp))
CALL judft_error("TODO,hs_setup")
! CALL read_eig(eig_id_hf,nk,jsp,el=el_eig, ello=ello_eig,neig=hybrid%ne_eig(nk),w_iks=results%w_iks(:,nk,jsp))
hybrid%nobd(nk) = COUNT(results%w_iks(:hybrid%ne_eig(nk),nk,jsp) > 0.0 )
END DO
......
......@@ -198,7 +198,8 @@ CONTAINS
DO jsp=1,DIMENSION%jspd
CALL read_eig(eig_id,1,jsp,el=el(:,:,jsp),ello=ello(:,:,jsp))
CALL judft_error("TODO,mixedbasis")
! CALL read_eig(eig_id,1,jsp,el=el(:,:,jsp),ello=ello(:,:,jsp))
ENDDO
ALLOCATE ( vr0(atoms%jmtd,atoms%ntype,DIMENSION%jspd) )
......
......@@ -17,7 +17,7 @@
> eig_id,
> irank,isize,jspin,jspins,
> l_noco,
< ello,evac,epar,wk,n_bands,n_size)
< n_bands,n_size)
USE m_eig66_io, ONLY : read_eig
IMPLICIT NONE
!
......@@ -29,27 +29,17 @@
INTEGER, INTENT (OUT) :: n_size
REAL, INTENT (INOUT) :: wk
INTEGER, INTENT (OUT) :: n_bands(0:) !n_bands(0:neigd)
REAL, INTENT (INOUT) :: ello(:,:,:),evac(:,:) !ello(nlod,ntypd,jspd),evac(2,jspd)
REAL, INTENT (INOUT) :: epar(0:,:,:) !epar(0:lmaxd,ntypd,jspd)
INTEGER isp
IF (l_noco) THEN
CALL read_eig(eig_id,1,1,
< neig=n_bands(1))
DO isp = 1, jspins
CALL read_eig(eig_id,1,isp,
< el=epar(:,:,isp),ello=ello(:,:,isp),evac=evac(:,isp))
ENDDO
ELSE
CALL read_eig(eig_id,1,jspin,
< neig=n_bands(1),el=epar(:,:,jspin),
< ello=ello(:,:,jspin),evac=evac(:,jspin))
< neig=n_bands(1))
ENDIF
c
c n_size is the number of records per k-point,
......@@ -67,8 +57,7 @@ c
> eig_id,nvd,jspd,irank,isize,
> ikpt,jspin,nbasfcn,l_ss,l_noco,
> noccbd,n_start,n_end,
< ello,evdu,epar,
< wk,nbands,eig,zmat)
< nbands,eig,zmat)
USE m_eig66_io, ONLY : read_eig
USE m_types
......@@ -82,12 +71,9 @@ c
INTEGER, INTENT (IN) :: noccbd,n_start,n_end
LOGICAL, INTENT (IN) :: l_ss,l_noco
INTEGER, INTENT (OUT) :: nbands
REAL, INTENT (OUT) :: wk
REAL, INTENT (OUT) :: eig(:) !bkpt(3),eig(neigd)
REAL, INTENT (INOUT) :: ello(:,:,:),evdu(:,:) !ello(nlod,ntypd,jspd),evdu(2,jspd)
REAL, INTENT (INOUT) :: epar(0:,:,:) !epar(0:lmaxd,ntypd,jspd)
TYPE(t_zmat), INTENT (INOUT) :: zmat !z(nbasfcn,noccbd) !can be real/complex
!
! Local variables ...
......@@ -103,34 +89,23 @@ c
!
CALL timestart("cdn_read")
IF (l_ss) THEN
CALL read_eig(eig_id,ikpt,1,
< wk=wk,neig=nbands)
DO isp = jspd,1,-1
CALL read_eig(eig_id,ikpt,isp,
< nmat=nmat)
! write(*,*) kveclo
ENDDO
CALL read_eig(
> eig_id,ikpt,1,n_start=n_start,n_end=n_end,
< eig=eig,nmat=nmat,zmat=zmat)
CALL read_eig(eig_id,ikpt,1, neig=nbands)
CALL read_eig(eig_id,ikpt,1,n_start=n_start,n_end=n_end,
< eig=eig,zmat=zmat)
!
! For Non-Collinear, but no Spin-Spirals
!
ELSEIF (l_noco) THEN
CALL read_eig(
> eig_id,ikpt,1,
< wk=wk,neig=nbands,
< nmat=nmat)
CALL read_eig(
> eig_id,ikpt,1, neig=nbands)
CALL read_eig(
> eig_id,ikpt,1,n_start=n_start,n_end=n_end,
< eig=eig,nmat=nmat,zmat=zmat)
< eig=eig,zmat=zmat)
!
! For Collinear
!
ELSE
CALL read_eig(eig_id,ikpt,jspin,
< nmat=nmat)
IF (zmat%l_real) THEN
zmat%z_r=0
ELSE
......@@ -140,7 +115,6 @@ c
CALL read_eig(
> eig_id,ikpt,jspin,n_start=n_start,n_end=n_end,
< wk=wk,
< neig=nbands,eig=eig,
< zmat=zmat)
......@@ -149,8 +123,6 @@ c
! IF (nbands>neigd) CALL juDFT_error("nbands.GT.neigd",calledby
! + ="cdn_read")
IF (nmat>nbasfcn) CALL juDFT_error("nmat.GT.nbasfcn",calledby
+ ="cdn_read")
END SUBROUTINE cdn_read
END MODULE m_cdnread
......@@ -52,18 +52,11 @@ CONTAINS
IF (PRESENT(filename)) d%fname=filename
CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc,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
INQUIRE(IOLENGTH=recl_eig) r1
d%recl_wiks=recl_eig*neig
print *,lmax,ntype,nlo,nlotot,nmat,neig
recl_eig=recl_eig*(neig+2) ! add a 2 for integer 'neig'
if (l_real.and..not.l_soc ) THEN
INQUIRE(IOLENGTH=recl_z) r1
......@@ -73,8 +66,6 @@ CONTAINS
recl_z=recl_z*nmat*neig
d%recl_vec=recl_eig+recl_z
print *,l_real,l_soc
print *,"reclen:",d%recl_vec,nmat,neig,recl_z,recl_eig
IF (d%l_dos) THEN
IF (.NOT.(PRESENT(layers).AND.PRESENT(nstars).AND.PRESENT(ncored).AND.PRESENT(nsld).AND.PRESENT(nat))) &
......@@ -99,16 +90,14 @@ CONTAINS
IF (create) THEN
d%file_io_id_bas=priv_free_uid()
INQUIRE(file=TRIM(d%fname)//".bas",opened=l_file)
INQUIRE(file=TRIM(d%fname),opened=l_file)
DO WHILE(l_file)
write(*,*) "eig66_open_da:",d%fname," in use"
d%fname=TRIM(d%fname)//"6"
INQUIRE(file=TRIM(d%fname)//".bas",opened=l_file)
INQUIRE(file=TRIM(d%fname),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')
OPEN(d%file_io_id_vec,FILE=TRIM(d%fname),ACCESS='direct',FORM='unformatted',RECL=d%recl_vec,STATUS='unknown')
d%file_io_id_wiks=priv_free_uid()
OPEN(d%file_io_id_wiks,FILE=TRIM(d%fname)//".wiks",ACCESS='direct',FORM='unformatted',RECL=d%recl_wiks,STATUS='unknown')
IF(d%recl_dos>0) THEN
......@@ -117,10 +106,8 @@ CONTAINS
ENDIF
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')
OPEN(d%file_io_id_vec,FILE=TRIM(d%fname),ACCESS='direct',FORM='unformatted',RECL=d%recl_vec,STATUS='old')
d%file_io_id_wiks=priv_free_uid()
OPEN(d%file_io_id_wiks,FILE=TRIM(d%fname)//".wiks",ACCESS='direct',FORM='unformatted',RECL=d%recl_wiks,STATUS='old')
IF(d%recl_dos>0) THEN
......@@ -147,32 +134,25 @@ CONTAINS
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)
CLOSE(d%file_io_id_wiks)
d%recl_vec=0
d%recl_bas=0
d%recl_wiks=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")
CALL system("mv "//TRIM(d%fname)//" "//TRIM(filename))
ENDIF
ENDIF
d%fname="eig"
CALL eig66_remove_data(id)
END SUBROUTINE close_eig
SUBROUTINE read_eig(id,nk,jspin,nv,nmat,bk,wk,neig,eig,w_iks,el,ello,evac,n_start,n_end,zmat)
SUBROUTINE read_eig(id,nk,jspin,neig,eig,w_iks,n_start,n_end,zmat)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
INTEGER, INTENT(OUT),OPTIONAL :: nv,nmat
INTEGER, INTENT(OUT),OPTIONAL :: neig
REAL, INTENT(OUT),OPTIONAL :: eig(:),w_iks(:)
REAL, INTENT(OUT),OPTIONAL :: evac(:),ello(:,:),el(:,:)
REAL, INTENT(OUT),OPTIONAL :: bk(:),wk
INTEGER, INTENT(IN),OPTIONAL :: n_start,n_end
TYPE(t_zmat),OPTIONAL :: zmat
......@@ -193,29 +173,16 @@ CONTAINS
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)) 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
ENDIF
IF (PRESENT(w_iks)) THEN
print *, "R:w_iks:",nrec
read(d%file_io_id_wiks,REC=nrec) w_iks
ENDIF
IF (.NOT.(PRESENT(eig).OR.PRESENT(neig).OR.PRESENT(zmat))) RETURN
READ(d%file_io_id_vec,REC=nrec) neig_s
IF (PRESENT(neig)) THEN
print *,"R:",neig_s
neig=neig_s
ENDIF
IF (.NOT.(PRESENT(eig).OR.PRESENT(zmat))) RETURN
......@@ -224,23 +191,16 @@ CONTAINS
IF (zmat%l_real) THEN
INQUIRE(IOLENGTH=n) neig_s,eig_s,REAL(zmat%z_r)
IF (n>d%recl_vec) THEN
print *,n,d%recl_vec
print *,size(eig_s)
print *,size(zmat%z_r)
CALL juDFT_error("BUG: Too long record")
END IF
READ(d%file_io_id_vec,REC=nrec) neig_s,eig_s,zmat%z_r
ELSE
INQUIRE(IOLENGTH=n) neig_s,eig_s,CMPLX(zmat%z_c)
IF (n>d%recl_vec) THEN
print *,n,d%recl_vec
print *,size(eig_s)
print *,size(zmat%z_c)
CALL juDFT_error("BUG: Too long record")
END IF
READ(d%file_io_id_vec,REC=nrec) neig_s,eig_s,zmat%z_c
ENDIF
print *,"R:",nrec,nk,neig_s
ELSE
INQUIRE(IOLENGTH=n) neig_s,eig_s
IF (n>d%recl_vec) CALL juDFT_error("BUG: Too long record")
......@@ -250,14 +210,11 @@ CONTAINS
END SUBROUTINE read_eig
SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,nv,nmat,bk,wk, &
eig,w_iks,el,ello,evac,nlotot,n_size,n_rank,zmat)
SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,eig,w_iks,n_size,n_rank,zmat)
INTEGER, INTENT(IN) :: id,nk,jspin
INTEGER, INTENT(IN),OPTIONAL :: n_size,n_rank
REAL, INTENT(IN),OPTIONAL :: wk
INTEGER, INTENT(IN),OPTIONAL :: neig,nv,nmat,nlotot,neig_total
REAL, INTENT(IN),OPTIONAL :: bk(3),eig(:),el(:,:),w_iks(:)
REAL, INTENT(IN),OPTIONAL :: evac(:),ello(:,:)
INTEGER, INTENT(IN),OPTIONAL :: neig,neig_total
REAL, INTENT(IN),OPTIONAL :: eig(:),w_iks(:)
TYPE(t_mat),INTENT(IN),OPTIONAL :: zmat
INTEGER:: nrec,r_len
......@@ -278,36 +235,12 @@ CONTAINS
!Now it is time for the IO :-)
nrec=nk+(jspin-1)*d%nkpts
IF (PRESENT(nmat).AND..NOT.PRESENT(el)) THEN
!IO of basis-set information
READ(d