Commit 7fc65bd0 authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents f5140782 82fde059
......@@ -38,7 +38,7 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE init_chase(mpi,dimension,input,atoms,kpts,noco,vacuum,banddos,l_real)
SUBROUTINE init_chase(mpi,dimension,atoms,kpts,noco,l_real)
USE m_types
USE m_types_mpi
......@@ -49,12 +49,9 @@ IMPLICIT NONE
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_banddos), INTENT(IN) :: banddos
LOGICAL, INTENT(IN) :: l_real
......@@ -63,11 +60,8 @@ IMPLICIT NONE
IF (juDFT_was_argument("-diag:chase")) THEN
nevd = min(dimension%neigd,dimension%nvd+atoms%nlotot)
nexd = min(max(nevd/4, 45),dimension%nvd+atoms%nlotot-nevd) !dimensioning for workspace
chase_eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,nevd+nexd,kpts%nkpt,DIMENSION%jspd,atoms%lmaxd,&
atoms%nlod,atoms%ntype,atoms%nlotot,noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,&
mpi%n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=DIMENSION%nstd,&
nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
l_orb=banddos%l_orb)
chase_eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,nevd+nexd,kpts%nkpt,DIMENSION%jspd,&
noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,mpi%n_size)
END IF
END SUBROUTINE init_chase
......
......@@ -68,7 +68,7 @@ CONTAINS
! ..
! .. Scalar Arguments ..
INTEGER,INTENT(IN) :: iter
INTEGER,INTENT(INOUT) :: eig_id
INTEGER,INTENT(IN) :: eig_id
! ..
!-odim
!+odim
......@@ -115,17 +115,10 @@ CONTAINS
!IF (mpi%irank.EQ.0) CALL openXMLElementFormPoly('iteration',(/'numberForCurrentRun','overallNumber '/),(/iter,v%iter/),&
! RESHAPE((/19,13,5,5/),(/2,2/)))
eig_id=open_eig(&
mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd,kpts%nkpt,DIMENSION%jspd,atoms%lmaxd,&
atoms%nlod,atoms%ntype,atoms%nlotot,noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,&
mpi%n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=DIMENSION%nstd,&
nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
l_orb=banddos%l_orb)
!---> set up and solve the eigenvalue problem
!---> loop over spins
!---> set up k-point independent t(l'm',lm) matrices
CALL mt_setup(atoms,sym,sphhar,input,noco,enpara,inden,v,mpi,results,DIMENSION,td,ud)
!---> set up and solve the eigenvalue problem
!---> loop over spins
!---> set up k-point independent t(l'm',lm) matrices
CALL mt_setup(atoms,sym,sphhar,input,noco,enpara,inden,v,mpi,results,DIMENSION,td,ud)
neigBuffer = 0
results%neig = 0
......
......@@ -42,6 +42,7 @@ CONTAINS
USE m_rinpXML
USE m_winpXML
USE m_init_wannier_defaults
USE m_xsf_io
IMPLICIT NONE
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell
......@@ -101,6 +102,7 @@ CONTAINS
CHARACTER(LEN=20) :: filename
REAL :: a1_temp(3),a2_temp(3),a3_temp(3)
REAL :: scale_temp, dtild_temp
REAL :: forceAllAtoms(3,atoms%nat)
CLASS(t_forcetheo),ALLOCATABLE:: forcetheo
input=input_in
atoms_new=atoms
......@@ -135,9 +137,33 @@ CONTAINS
ENDDO
istep = 1
CALL bfgs(atoms%ntype,istep,istep0,forcetot,&
& zat,input%xa,input%thetad,input%epsdisp,input%epsforce,tote,&
& xold,y,h,tau0, lconv)
CALL bfgs(atoms%ntype,istep,istep0,forcetot,zat,input%xa,input%thetad,input%epsdisp,&
input%epsforce,tote,xold,y,h,tau0,lconv)
!write out struct_force.xsf file
forceAllAtoms = 0.0
na = 0
DO itype=1,atoms%ntype
forcetot(:,itype)=MATMUL(cell%bmat,forcetot(:,itype))/tpi_const ! to inner coordinates
DO ieq = 1,atoms%neq(itype)
na = na + 1
jop = sym%invtab(atoms%ngopr(na))
IF (oneD%odi%d1) jop = oneD%ods%ngopr(na)
DO i = 1,3
DO j = 1,3
IF (.NOT.oneD%odi%d1) THEN
forceAllAtoms(i,na) = forceAllAtoms(i,na) + sym%mrot(i,j,jop) * forcetot(j,itype)
ELSE
forceAllAtoms(i,na) = forceAllAtoms(i,na) + oneD%ods%mrot(i,j,jop) * forcetot(j,itype)
END IF
END DO
END DO
forceAllAtoms(:,na) = MATMUL(cell%amat,forceAllAtoms(:,na)) ! to external coordinates
END DO
END DO
OPEN (55,file="struct_force.xsf",status='replace')
CALL xsf_WRITE_atoms(55,atoms,input%film,.false.,cell%amat,forceAllAtoms)
CLOSE (55)
IF (lconv) THEN
WRITE (6,'(a)') "Des woars!"
......
......@@ -24,6 +24,7 @@ MODULE m_constants
INTEGER, PARAMETER :: POTDEN_TYPE_POTTOT = 1 ! 0 < POTDEN_TYPE <= 1000 ==> potential
INTEGER, PARAMETER :: POTDEN_TYPE_POTCOUL = 2
INTEGER, PARAMETER :: POTDEN_TYPE_POTX = 3
INTEGER, PARAMETER :: POTDEN_TYPE_POTYUK = 4
INTEGER, PARAMETER :: POTDEN_TYPE_DEN = 1001 ! 1000 < POTDEN_TYPE ==> density
CHARACTER(2),DIMENSION(0:103),PARAMETER :: namat_const=(/&
......
MODULE m_calc_hybrid
USE m_judft
CONTAINS
SUBROUTINE calc_hybrid(hybrid,kpts,atoms,input,DIMENSION,mpi,noco,cell,vacuum,oneD,banddos,results,sym,xcpot,v,it )
SUBROUTINE calc_hybrid(hybrid,kpts,atoms,input,DIMENSION,mpi,noco,cell,oneD,results,sym,xcpot,v,it )
USE m_types
USE m_mixedbasis
USE m_coulombmatrix
......@@ -17,9 +17,7 @@ CONTAINS
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_hybrid),INTENT(INOUT) :: hybrid
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_results),INTENT(INOUT):: results
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
......@@ -100,12 +98,8 @@ CONTAINS
CALL timestart("Preparation for Hybrid functionals")
CALL juDFT_WARN ("Hybrid functionals not working in this version")
eig_id=open_eig(&
mpi%mpi_comm,dimension%nbasfcn,dimension%neigd,kpts%nkpt,dimension%jspd,atoms%lmaxd,atoms%nlod,atoms%ntype,atoms%nlotot&
,noco%l_noco,.FALSE.,sym%invs.AND..NOT.noco%l_noco,noco%l_soc,.FALSE.,&
mpi%n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=DIMENSION%nstd,&
nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
l_orb=banddos%l_orb)
eig_id=open_eig(mpi%mpi_comm,dimension%nbasfcn,dimension%neigd,kpts%nkpt,dimension%jspd,&
noco%l_noco,.FALSE.,sym%invs.AND..NOT.noco%l_noco,noco%l_soc,.FALSE.,mpi%n_size)
!construct the mixed-basis
CALL timestart("generation of mixed basis")
......
......@@ -118,8 +118,10 @@
pkpt( : ,kpts%nkpt3(2)+1, : ) = pkpt(:,1,:)
pkpt( : , : ,kpts%nkpt3(3)+1) = pkpt(:,:,1)
IF(any(pkpt.eq.0))
&STOP 'kptgen: Definition of pkpt-pointer failed.'
IF(any(pkpt.eq.0)) THEN
CALL juDFT_error('kptgen: Definition of pkpt-pointer failed.',
& calledby='kptgen_hybrid')
END IF
iarr = 1
ldum = .false.
DO i = 1,nkpt
......
......@@ -224,6 +224,7 @@ CONTAINS
ALLOCATE(noel(atoms%ntype),atomTypeSpecies(atoms%ntype),speciesRepAtomType(atoms%ntype))
ALLOCATE(xmlElectronStates(29,atoms%ntype),xmlPrintCoreStates(29,atoms%ntype))
ALLOCATE(xmlCoreOccs(1,1,1),atoms%label(atoms%nat))
ALLOCATE(hybrid%lcutm1(atoms%ntype),hybrid%lcutwf(atoms%ntype),hybrid%select1(4,atoms%ntype))
filename = 'inpConverted.xml'
xmlElectronStates = noState_const
xmlPrintCoreStates = .FALSE.
......@@ -234,7 +235,17 @@ CONTAINS
noel(i) = namat_const(atoms%nz(i))
atomTypeSpecies(i) = i
speciesRepAtomType(i) = i
hybrid%lcutm1(iType) = 4
hybrid%lcutwf(iType) = atoms%lmax(iType) - atoms%lmax(iType) / 10
hybrid%select1(:,iType) = (/4, 0, 4, 2 /)
END DO
hybrid%gcutm1 = input%rkmax - 0.5
hybrid%tolerance1 = 1.0e-4
hybrid%ewaldlambda = 3
hybrid%lexp = 16
hybrid%bands1 = max( nint(input%zelec)*10, 60 )
numSpecies = SIZE(speciesRepAtomType)
ALLOCATE(atoms%speciesName(numSpecies))
atoms%speciesName = ''
......
......@@ -85,11 +85,8 @@
! REAL, PARAMETER :: eps=0.00000001
! ..
!HF added for HF and hybrid functionals
REAL :: gcutm,tolerance
REAL :: taual_hyb(3,atoms%nat)
INTEGER :: selct(4,atoms%ntype),lcutm(atoms%ntype)
INTEGER :: selct2(4,atoms%ntype)
INTEGER :: bands
INTEGER :: bands
LOGICAL :: l_gamma
INTEGER :: nkpt3(3)
!HF
......@@ -149,7 +146,8 @@
input%pallst = .false. ; obsolete%lwb = .false. ; vacuum%starcoeff = .false.
input%strho = .false. ; input%l_f = .false. ; atoms%l_geo(:) = .true.
noco%l_noco = noco%l_ss ; input%jspins = 1
input%itmax = 9 ; input%maxiter = 99 ; input%imix = 7 ; input%alpha = 0.05 ; input%minDistance = 0.0
input%itmax = 9 ; input%maxiter = 99 ; input%imix = 7 ; input%alpha = 0.05
input%preconditioning_param = 0.0 ; input%minDistance = 0.0
input%spinf = 2.0 ; obsolete%lepr = 0 ; input%coretail_lmax = 0
sliceplot%kk = 0 ; sliceplot%nnne = 0 ; vacuum%nstars = 0 ; vacuum%nstm = 0
input%isec1 = 99 ; nu = 5 ; vacuum%layerd = 1 ; iofile = 6
......@@ -294,18 +292,9 @@
ENDIF
!HF added for HF and hybrid functionals
gcutm = input%rkmax - 0.5
tolerance = 1e-4
hybrid%gcutm1 = input%rkmax - 0.5
hybrid%tolerance1 = 1e-4
taual_hyb = atoms%taual
selct(1,:) = 4
selct(2,:) = 0
selct(3,:) = 4
selct(4,:) = 2
lcutm = 4
selct2(1,:) = 4
selct2(2,:) = 0
selct2(3,:) = 4
selct2(4,:) = 2
ALLOCATE(hybrid%lcutwf(atoms%ntype))
ALLOCATE(hybrid%lcutm1(atoms%ntype))
ALLOCATE(hybrid%select1(4,atoms%ntype))
......@@ -318,25 +307,28 @@
hybrid%select1(3,:) = 4
hybrid%select1(4,:) = 2
bands = max( nint(input%zelec)*10, 60 )
nkpt3 = (/ 4, 4, 4 /)
l_gamma = .false.
IF ( l_hyb ) THEN
input%ellow = input%ellow - 2.0
input%elup = input%elup + 10.0
input%gw_neigd = bands
l_gamma = .true.
hybrid%l_hybrid = l_hyb
IF (l_hyb) THEN
input%ellow = input%ellow - 2.0
input%elup = input%elup + 10.0
input%gw_neigd = bands
l_gamma = .true.
IF(juDFT_was_argument("-old")) THEN
CALL juDFT_error('No hybrid functionals input for old input file implemented', calledby='set_inp')
END IF
ELSE
input%gw_neigd = 0
END IF
!HF
! rounding
atoms%rmt(:) = real(NINT( atoms%rmt(:) * 100 ) / 100.)
atoms%dx(:) = real(NINT( atoms%dx(:) * 1000) / 1000.)
stars%gmax = real(NINT( stars%gmax * 10 ) / 10.)
input%rkmax = real(NINT( input%rkmax * 10 ) / 10.)
xcpot%gmaxxc = real(NINT( xcpot%gmaxxc * 10 ) / 10.)
gcutm = real(INT( gcutm * 10 ) / 10.)
atoms%rmt(:) = real(NINT(atoms%rmt(:) * 100 ) / 100.)
atoms%dx(:) = real(NINT(atoms%dx(:) * 1000) / 1000.)
stars%gmax = real(NINT(stars%gmax * 10 ) / 10.)
input%rkmax = real(NINT(input%rkmax * 10 ) / 10.)
xcpot%gmaxxc = real(NINT(xcpot%gmaxxc * 10 ) / 10.)
hybrid%gcutm1 = real(NINT(hybrid%gcutm1 * 10 ) / 10.)
IF (input%film) THEN
vacuum%dvac = real(NINT(vacuum%dvac*100)/100.)
dtild = real(NINT(dtild*100)/100.)
......@@ -431,6 +423,17 @@
kpts%nkpt = kpts%nkpt3(1) * kpts%nkpt3(2) * kpts%nkpt3(3)
END IF
IF (l_hyb) THEN
! Changes for hybrid functionals
input%isec1 = 999
namex = 'hse '
input%frcor = .true. ; input%ctail = .false. ; atoms%l_geo = .false.
input%itmax = 15 ; input%maxiter = 25!; input%imix = 17
IF (ANY(kpts%nkpt3(:).EQ.0)) kpts%nkpt3(:) = 4
div(:) = kpts%nkpt3(:)
kpts%specificationType = 2
END IF
IF(.NOT.juDFT_was_argument("-old")) THEN
nkptOld = kpts%nkpt
latnamTemp = cell%latnam
......@@ -444,12 +447,15 @@
IF(l_explicit) THEN
! kpts generation
kpts%l_gamma = l_gamma
sym%symSpecType = 3
CALL kpoints(oneD,sym,cell,input,noco,banddos,kpts,l_kpts)
kpts%specificationType = 3
IF (l_hyb) kpts%specificationType = 2
END IF
IF(l_explicit) THEN
sym%symSpecType = 3
!set latnam to any
cell%latnam = 'any'
......@@ -506,26 +512,23 @@
CLOSE (6)
IF (atoms%ntype.GT.999) THEN
WRITE(*,*) 'More than 999 atom types -> no conventional inp file generated!'
WRITE(*,*) 'Use inp.xml file instead!'
ELSE IF (juDFT_was_argument("-old")) THEN
IF (juDFT_was_argument("-old")) THEN
IF (atoms%ntype.GT.999) THEN
CALL juDFT_error('More than 999 atom types only work with the inp.xml input file',calledby='set_inp')
END IF
IF (kpts%specificationType.EQ.4) THEN
CALL juDFT_error('No k point set specification by density supported for old inp file',&
calledby = 'set_inp')
END IF
CALL rw_inp(&
& ch_rw,atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,dtild,input%comment)
CALL rw_inp(ch_rw,atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts,&
noel,namex,relcor,a1,a2,a3,dtild,input%comment)
iofile = 6
OPEN (iofile,file='inp',form='formatted',status='old',position='append')
IF( l_hyb ) THEN
WRITE (iofile,FMT=9999) product(nkpt3),nkpt3,l_gamma
ELSE IF( (div(1) == 0).OR.(div(2) == 0) ) THEN
IF((div(1) == 0).OR.(div(2) == 0)) THEN
WRITE (iofile,'(a5,i5)') 'nkpt=',kpts%nkpt
ELSE
WRITE (iofile,'(a5,i5,3(a4,i2))') 'nkpt=',kpts%nkpt,',nx=',div(1),',ny=',div(2),',nz=',div(3)
......@@ -534,34 +537,6 @@
CLOSE (iofile)
END IF
iofile = 6
!HF create hybrid functional input file
IF ( l_hyb ) THEN
OPEN (iofile,file='inp_hyb',form='formatted',status='new',&
& iostat=iostat)
IF (iostat /= 0) THEN
STOP &
& 'Cannot create new file "inp_hyb". Maybe it already exists?'
ENDIF
! Changes for hybrid functionals
input%strho = .false. ; input%isec1 = 999
namex = 'hse '
input%frcor = .true. ; input%ctail = .false. ; atoms%l_geo = .false.
input%itmax = 15 ; input%maxiter = 25 ; input%imix = 17
CALL rw_inp(&
& ch_rw,atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,dtild,input%comment)
IF ( ALL(div /= 0) ) nkpt3 = div
WRITE (iofile,FMT=9999) product(nkpt3),nkpt3,l_gamma
9999 FORMAT ( 'nkpt=',i5,',nx=',i2,',ny=',i2,',nz=',i2,',gamma=',l1)
CLOSE (iofile)
END IF ! l_hyb
DEALLOCATE(hybrid%lcutwf)
!HF
END SUBROUTINE set_inp
END MODULE m_setinp
......@@ -34,15 +34,13 @@ CONTAINS
END SELECT
END SUBROUTINE priv_find_data
SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,create,l_real,l_soc,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot
SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,create,l_real,l_soc,filename)
INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins
LOGICAL, INTENT(IN) :: create,l_real,l_soc
LOGICAL,INTENT(IN),OPTIONAL :: 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
INTEGER :: i1,recl_z,recl_eig
REAL :: r1,r3(3)
COMPLEX :: c1
TYPE(t_data_DA),POINTER:: d
......@@ -50,7 +48,7 @@ CONTAINS
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_real,l_soc,l_dos,l_mcd,l_orb)
CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,l_real,l_soc)
!Calculate the record length
......@@ -67,28 +65,6 @@ CONTAINS
d%recl_vec=recl_eig+recl_z
IF (d%l_dos) THEN
IF (.NOT.(PRESENT(layers).AND.PRESENT(nstars).AND.PRESENT(ncored).AND.PRESENT(nsld).AND.PRESENT(nat))) &
CALL judft_error("BUG:Could not open file for DOS-data",calledby="eig66_da")
INQUIRE(IOLENGTH=i1) i1
recl_dos=i1*2*neig !ksym&jsym
INQUIRE(IOLENGTH=i1) r1
recl_dos=recl_dos+i1*3*neig !qvac&qis
recl_dos=recl_dos+i1*4*ntype*neig !qal
recl_dos=recl_dos+i1*neig*2*max(1,layers) !qvlay
IF (l_orb) THEN
recl_dos=recl_dos+i1*2*nsld*neig !qintsl,qmtsl
recl_dos=recl_dos+i1*24*neig*nat !qmtp,orbcomp
ENDIF
INQUIRE(IOLENGTH=i1) c1
recl_dos=recl_dos+i1*nstars*neig*max(1,layers)*2 !qstars
IF (l_mcd) recl_dos=recl_dos+i1*3*ntype*ncored*neig !mcd
ELSE
recl_dos=-1
ENDIF
d%recl_dos=recl_dos
IF (create) THEN
INQUIRE(file=TRIM(d%fname),opened=l_file)
DO WHILE(l_file)
......@@ -100,20 +76,11 @@ CONTAINS
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
d%file_io_id_dos=priv_free_uid()
OPEN(d%file_io_id_dos,FILE=TRIM(d%fname)//".dos",ACCESS='direct',FORM='unformatted',RECL=d%recl_dos,STATUS='unknown')
ENDIF
ELSE
d%file_io_id_vec=priv_free_uid()
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
d%file_io_id_dos=priv_free_uid()
OPEN(d%file_io_id_dos,FILE=TRIM(d%fname)//".dos",ACCESS='direct',FORM='unformatted',RECL=d%recl_dos,STATUS='old')
ENDIF
ENDIF
CONTAINS
INTEGER FUNCTION priv_free_uid() RESULT(uid)
......
......@@ -13,31 +13,25 @@ module m_eig66_data
TYPE :: t_data
INTEGER:: io_mode
INTEGER:: jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype
LOGICAL:: l_dos,l_mcd,l_orb,l_real,l_soc
INTEGER:: jspins,nkpts,nmat,neig,nlo,ntype
LOGICAL:: l_real,l_soc
END TYPE
TYPE,EXTENDS(t_data):: t_data_DA
INTEGER :: recl_vec=0,recl_dos,recl_wiks
INTEGER :: recl_vec=0,recl_wiks
CHARACTER(LEN=20) :: fname="eig"
INTEGER :: file_io_id_vec,file_io_id_dos,file_io_id_wiks
INTEGER :: file_io_id_vec,file_io_id_wiks
END TYPE
TYPE,extends(t_data):: t_data_MPI
INTEGER :: n_size=1
INTEGER :: size_k,size_el,size_ello,size_eig
INTEGER :: size_k,size_eig
INTEGER :: eig_handle,zr_handle,zc_handle,neig_handle,w_iks_handle
INTEGER :: qal_handle,qvac_handle,qis_handle,qvlay_handle,qintsl_handle,qmtsl_handle
INTEGER :: qmtp_handle,orbcomp_handle,qstars_handle,mcd_handle,jsym_handle,ksym_handle
INTEGER,ALLOCATABLE :: pe_basis(:,:),slot_basis(:,:)
INTEGER,ALLOCATABLE :: pe_ev(:,:,:),slot_ev(:,:,:)
INTEGER :: irank
INTEGER,POINTER :: neig_data(:)
REAL,POINTER :: eig_data(:),zr_data(:), w_iks_data(:)
REAL,POINTER :: qal_data(:),qvac_data(:),qis_data(:),qvlay_data(:)
REAL,POINTER :: qintsl_data(:),qmtsl_data(:),qmtp_data(:),orbcomp_data(:),mcd_data(:)
COMPLEX,POINTER :: qstars_data(:)
INTEGER,POINTER :: jsym_data(:),ksym_data(:)
COMPLEX,POINTER :: zc_data(:)
END TYPE
TYPE,EXTENDS(t_data):: t_data_hdf
......@@ -45,9 +39,6 @@ module m_eig66_data
INTEGER(HID_T) :: fid
INTEGER(HID_T) :: neigsetid
INTEGER(HID_T) :: energysetid,wikssetid,evsetid
INTEGER(HID_T) :: qalsetid,qvacsetid,qissetid,qvlaysetid
INTEGER(HID_T) :: qstarssetid,ksymsetid,jsymsetid,mcdsetid
INTEGER(HID_T) :: qintslsetid,qmtslsetid,qmtpsetid,orbcompsetid
CHARACTER(LEN=20) :: fname="eig"
#endif
END TYPE
......@@ -57,18 +48,6 @@ module m_eig66_data
REAL,ALLOCATABLE :: eig_eig(:,:,:)
REAL,ALLOCATABLE :: eig_vecr(:,:)
COMPLEX,ALLOCATABLE :: eig_vecc(:,:)
REAL,ALLOCATABLE :: qal(:,:,:,:)
REAL,ALLOCATABLE :: qvac(:,:,:)
REAL,ALLOCATABLE :: qis(:,:)
REAL,ALLOCATABLE :: qvlay(:,:,:,:)
COMPLEX,ALLOCATABLE :: qstars(:,:,:,:,:)
INTEGER,ALLOCATABLE :: ksym(:,:)
INTEGER,ALLOCATABLE :: jsym(:,:)
REAL,ALLOCATABLE :: mcd(:,:,:,:)
REAL,ALLOCATABLE :: qintsl(:,:,:)
REAL,ALLOCATABLE :: qmtsl(:,:,:)
REAL,ALLOCATABLE :: qmtp(:,:,:)
REAL,ALLOCATABLE :: orbcomp(:,:,:,:)
END TYPE
TYPE t_list
......@@ -85,30 +64,16 @@ module m_eig66_data
contains
subroutine eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc,l_dos,l_mcd,l_orb)
subroutine eig66_data_storedefault(d,jspins,nkpts,nmat,neig,l_real,l_soc)
CLASS(t_data)::d
INTEGER,INTENT(IN)::jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype
INTEGER,INTENT(IN)::jspins,nkpts,nmat,neig
LOGICAL,INTENT(IN):: l_real,l_soc
LOGICAL,INTENT(IN),OPTIONAL::l_dos,l_mcd,l_orb
d%jspins=jspins
d%nkpts=nkpts
d%nmat=nmat
d%neig=neig
d%lmax=lmax
d%nlotot=nlotot
d%nlo=nlo
d%ntype=ntype
d%l_real=l_real
d%l_soc=l_soc
if (present(l_dos)) THEN
d%l_dos=l_dos
d%l_mcd=l_mcd
d%l_orb=l_orb
else
d%l_dos=.false.
d%l_mcd=.false.
d%l_orb=.false.
endif
END SUBROUTINE
subroutine eig66_find_data(d,id,io_mode)
......
......@@ -57,7 +57,7 @@ CONTAINS
END SELECT
END SUBROUTINE priv_find_data
!----------------------------------------------------------------------
SUBROUTINE open_eig(id,mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,create,l_real,l_soc,nlotot,readonly,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
SUBROUTINE open_eig(id,mpi_comm,nmat,neig,nkpts,jspins,create,l_real,l_soc,readonly,filename)
!*****************************************************************
! opens hdf-file for eigenvectors+values
......@@ -65,11 +65,9 @@ CONTAINS
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,mpi_comm
INTEGER, INTENT(IN) :: nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot
INTEGER, INTENT(IN) :: nmat,neig,nkpts,jspins
LOGICAL, INTENT(IN) :: create,readonly,l_real,l_soc