Commit 9d9906c2 authored by Daniel Wortmann's avatar Daniel Wortmann

Removed jij data-type, added first implementation of further force-theorem...

Removed jij data-type, added first implementation of further force-theorem modes, these lack tests&support in xml-shema
parent 6ddaa944
...@@ -8,7 +8,7 @@ MODULE m_genNewNocoInp ...@@ -8,7 +8,7 @@ MODULE m_genNewNocoInp
CONTAINS CONTAINS
SUBROUTINE genNewNocoInp(input,atoms,jij,noco,noco_new) SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
USE m_juDFT USE m_juDFT
USE m_types USE m_types
...@@ -19,7 +19,6 @@ SUBROUTINE genNewNocoInp(input,atoms,jij,noco,noco_new) ...@@ -19,7 +19,6 @@ SUBROUTINE genNewNocoInp(input,atoms,jij,noco,noco_new)
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_noco),INTENT(INOUT) :: noco_new TYPE(t_noco),INTENT(INOUT) :: noco_new
...@@ -50,7 +49,7 @@ SUBROUTINE genNewNocoInp(input,atoms,jij,noco,noco_new) ...@@ -50,7 +49,7 @@ SUBROUTINE genNewNocoInp(input,atoms,jij,noco,noco_new)
OPEN (24,file='nocoinp',form='formatted', status='old') OPEN (24,file='nocoinp',form='formatted', status='old')
REWIND (24) REWIND (24)
CALL rw_noco_write(atoms,jij,noco_new, input) CALL rw_noco_write(atoms,noco_new, input)
CLOSE (24) CLOSE (24)
END SUBROUTINE genNewNocoInp END SUBROUTINE genNewNocoInp
......
...@@ -19,7 +19,7 @@ CONTAINS ...@@ -19,7 +19,7 @@ CONTAINS
!> The matrices generated and diagonalized here are of type m_mat as defined in m_types_mat. !> The matrices generated and diagonalized here are of type m_mat as defined in m_types_mat.
!>@author D. Wortmann !>@author D. Wortmann
SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,& SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,&
sym,kpts,DIMENSION, vacuum, input, cell, enpara_in,enpara,banddos, noco,jij, oneD,hybrid,& sym,kpts,DIMENSION, vacuum, input, cell, enpara_in,enpara,banddos, noco, oneD,hybrid,&
it,eig_id,results,inden,v,vx) it,eig_id,results,inden,v,vx)
USE m_constants, ONLY : pi_const,sfp_const USE m_constants, ONLY : pi_const,sfp_const
USE m_types USE m_types
...@@ -55,7 +55,6 @@ CONTAINS ...@@ -55,7 +55,6 @@ CONTAINS
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_banddos),INTENT(IN) :: banddos TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
...@@ -154,7 +153,7 @@ CONTAINS ...@@ -154,7 +153,7 @@ CONTAINS
CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,l_zref, mpi) CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,l_zref, mpi)
call timestart("Setup of H&S matrices") call timestart("Setup of H&S matrices")
CALL eigen_hssetup(jsp,mpi,DIMENSION,hybrid,enpara,input,vacuum,noco,jij,sym,& CALL eigen_hssetup(jsp,mpi,DIMENSION,hybrid,enpara,input,vacuum,noco,sym,&
stars,cell,sphhar,atoms,ud,td,v,lapw,l_real,smat,hmat) stars,cell,sphhar,atoms,ud,td,v,lapw,l_real,smat,hmat)
CALL timestop("Setup of H&S matrices") CALL timestop("Setup of H&S matrices")
...@@ -191,13 +190,8 @@ CONTAINS ...@@ -191,13 +190,8 @@ CONTAINS
#else #else
ne_found=ne_all ne_found=ne_all
#endif #endif
!jij%eig_l = 0.0 ! need not be used, if hdf-file is present
IF (.NOT.l_real) THEN IF (.NOT.l_real) THEN
IF (.NOT.jij%l_J) THEN
zMat%data_c(:lapw%nmat,:ne_found) = CONJG(zMat%data_c(:lapw%nmat,:ne_found)) zMat%data_c(:lapw%nmat,:ne_found) = CONJG(zMat%data_c(:lapw%nmat,:ne_found))
ELSE
zMat%data_c(:lapw%nmat,:ne_found) = CMPLX(0.0,0.0)
ENDIF
ENDIF ENDIF
CALL write_eig(eig_id, nk,jsp,ne_found,ne_all,& 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) eig(:ne_found),n_start=mpi%n_size,n_end=mpi%n_rank,zmat=zMat)
......
...@@ -15,7 +15,7 @@ CONTAINS ...@@ -15,7 +15,7 @@ CONTAINS
!! 4. The vacuum part is added (in hsvac()) !! 4. The vacuum part is added (in hsvac())
!! 5. The matrices are copied to the final matrix, in the noco-case the full matrix is constructed from the 4-parts. !! 5. The matrices are copied to the final matrix, in the noco-case the full matrix is constructed from the 4-parts.
SUBROUTINE eigen_hssetup(isp,mpi,DIMENSION,hybrid,enpara,input,vacuum,noco,jij,sym,& SUBROUTINE eigen_hssetup(isp,mpi,DIMENSION,hybrid,enpara,input,vacuum,noco,sym,&
stars,cell,sphhar,atoms,ud,td,v,lapw,l_real,smat_final,hmat_final) stars,cell,sphhar,atoms,ud,td,v,lapw,l_real,smat_final,hmat_final)
USE m_hs_int USE m_hs_int
USE m_hsvac USE m_hsvac
...@@ -33,7 +33,6 @@ CONTAINS ...@@ -33,7 +33,6 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
...@@ -82,7 +81,7 @@ CONTAINS ...@@ -82,7 +81,7 @@ CONTAINS
IF (input%film) THEN IF (input%film) THEN
CALL timestart("Vacuum part") CALL timestart("Vacuum part")
CALL hsvac(vacuum,stars,DIMENSION, atoms,mpi,isp,input,v,enpara%evac0,cell,& CALL hsvac(vacuum,stars,DIMENSION, atoms,mpi,isp,input,v,enpara%evac0,cell,&
lapw,sym, noco,jij,hmat,smat) lapw,sym, noco,hmat,smat)
CALL timestop("Vacuum part") CALL timestop("Vacuum part")
ENDIF ENDIF
!Now copy the data into final matrix !Now copy the data into final matrix
......
...@@ -12,7 +12,7 @@ CONTAINS ...@@ -12,7 +12,7 @@ CONTAINS
!----------------------------------------------------------- !-----------------------------------------------------------
SUBROUTINE hsvac(& SUBROUTINE hsvac(&
vacuum,stars,DIMENSION, atoms,mpi,jsp,input,v,evac,cell,& vacuum,stars,DIMENSION, atoms,mpi,jsp,input,v,evac,cell,&
lapw,sym, noco,jij,hmat,smat) lapw,sym, noco,hmat,smat)
USE m_vacfun USE m_vacfun
...@@ -22,7 +22,6 @@ CONTAINS ...@@ -22,7 +22,6 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
...@@ -57,13 +56,10 @@ CONTAINS ...@@ -57,13 +56,10 @@ CONTAINS
REAL ddnv(DIMENSION%nv2d,DIMENSION%jspd),dudz(DIMENSION%nv2d,DIMENSION%jspd) REAL ddnv(DIMENSION%nv2d,DIMENSION%jspd),dudz(DIMENSION%nv2d,DIMENSION%jspd)
REAL duz(DIMENSION%nv2d,DIMENSION%jspd), udz(DIMENSION%nv2d,DIMENSION%jspd) REAL duz(DIMENSION%nv2d,DIMENSION%jspd), udz(DIMENSION%nv2d,DIMENSION%jspd)
REAL uz(DIMENSION%nv2d,DIMENSION%jspd) REAL uz(DIMENSION%nv2d,DIMENSION%jspd)
! l_J auxiliary potential array
COMPLEX, ALLOCATABLE :: vxy1(:,:,:)
! .. ! ..
d2 = SQRT(cell%omtil/cell%area) d2 = SQRT(cell%omtil/cell%area)
IF (jij%l_J) ALLOCATE (vxy1(vacuum%nmzxyd,stars%ng2-1,2))
!---> set up mapping function from 3d-->2d lapws !---> set up mapping function from 3d-->2d lapws
......
...@@ -9,7 +9,7 @@ MODULE m_od_hsvac ...@@ -9,7 +9,7 @@ MODULE m_od_hsvac
CONTAINS CONTAINS
SUBROUTINE od_hsvac(& SUBROUTINE od_hsvac(&
vacuum,stars,DIMENSION, oneD,atoms, jsp,input,vxy,vz,evac,cell,& vacuum,stars,DIMENSION, oneD,atoms, jsp,input,vxy,vz,evac,cell,&
bkpt,lapw, MM,vM,m_cyl,n2d_1, n_size,n_rank,sym,noco,jij,nv2,l_real,hamOvlp) bkpt,lapw, MM,vM,m_cyl,n2d_1, n_size,n_rank,sym,noco,nv2,l_real,hamOvlp)
! subroutine for calculating the hamiltonian and overlap matrices in ! subroutine for calculating the hamiltonian and overlap matrices in
! the vacuum in the case of 1-dimensional calculations ! the vacuum in the case of 1-dimensional calculations
...@@ -25,7 +25,6 @@ CONTAINS ...@@ -25,7 +25,6 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
...@@ -70,14 +69,11 @@ CONTAINS ...@@ -70,14 +69,11 @@ CONTAINS
REAL, ALLOCATABLE :: ddnv(:,:,:),dudz(:,:,:) REAL, ALLOCATABLE :: ddnv(:,:,:),dudz(:,:,:)
REAL, ALLOCATABLE :: duz(:,:,:) REAL, ALLOCATABLE :: duz(:,:,:)
REAL, ALLOCATABLE :: udz(:,:,:),uz(:,:,:) REAL, ALLOCATABLE :: udz(:,:,:),uz(:,:,:)
! l_J auxiliary potential array
COMPLEX, ALLOCATABLE :: vxy1(:,:,:)
! .. ! ..
ic = CMPLX(0.,1.) ic = CMPLX(0.,1.)
d2 = SQRT(cell%omtil/cell%area) d2 = SQRT(cell%omtil/cell%area)
IF (jij%l_J) ALLOCATE (vxy1(vacuum%nmzxyd,n2d_1-1,2))
ALLOCATE (& ALLOCATE (&
ai(-vM:vM,DIMENSION%nv2d,DIMENSION%nvd),bi(-vM:vM,DIMENSION%nv2d,DIMENSION%nvd),& ai(-vM:vM,DIMENSION%nv2d,DIMENSION%nvd),bi(-vM:vM,DIMENSION%nv2d,DIMENSION%nvd),&
nvp(DIMENSION%nv2d,DIMENSION%jspd),ind(stars%ng2,DIMENSION%nv2d,DIMENSION%jspd),& nvp(DIMENSION%nv2d,DIMENSION%jspd),ind(stars%ng2,DIMENSION%nv2d,DIMENSION%jspd),&
...@@ -133,35 +129,13 @@ CONTAINS ...@@ -133,35 +129,13 @@ CONTAINS
!---> load the non-warping part of the potential !---> load the non-warping part of the potential
READ (25)((vz(imz,ivac,ipot),imz=1,vacuum%nmzd),ipot=1,4) READ (25)((vz(imz,ivac,ipot),imz=1,vacuum%nmzd),ipot=1,4)
npot = 3 npot = 3
!---> for J-coeff. we average the up-up and down-down parts
!---> and off-diagonal elements of the potential matrix to zero
IF (jij%l_J) THEN
vz(:,ivac,1) = (vz(:,ivac,1) + vz(:,ivac,2))/2.
vz(:,ivac,2) = vz(:,ivac,1)
vz(:,ivac,3) = 0.0
vz(:,ivac,4) = 0.0
END IF
ENDIF ENDIF
DO ipot = 1,npot DO ipot = 1,npot
IF (noco%l_noco) THEN IF (noco%l_noco) THEN
IF (.NOT.jij%l_J) THEN READ (25)((vxy(imz,k,ivac), imz=1,vacuum%nmzxy),k=1,n2d_1-1)
READ (25)((vxy(imz,k,ivac), imz=1,vacuum%nmzxy),k=1,n2d_1-1)
END IF
!---> l_J we want to average the diagonal elements of the pot. matrix !---> l_J we want to average the diagonal elements of the pot. matrix
IF (jij%l_J .AND. ipot.EQ.1) THEN
READ (25)((vxy(imz,k,ivac), imz=1,vacuum%nmzxy),k=1,n2d_1-1)
READ (25)((vxy1(imz,k,ivac), imz=1,vacuum%nmzxy),k=1,n2d_1-1)
vxy(:,:,ivac) = (vxy(:,:,ivac)+vxy1(:,:,ivac))/2.
END IF
IF (jij%l_J .AND. ipot.EQ.3) THEN
READ (25)((vxy(imz,k,ivac), imz=1,vacuum%nmzxy),k=1,n2d_1-1)
END IF
IF (jij%l_J .AND. ipot.EQ.3) vxy(:,:,ivac)=CMPLX(0.,0.)
ENDIF ! loco ENDIF ! loco
! get the wavefunctions and set up the tuuv, etc matrices ! get the wavefunctions and set up the tuuv, etc matrices
...@@ -354,8 +328,6 @@ CONTAINS ...@@ -354,8 +328,6 @@ CONTAINS
ENDDO !ipot ENDDO !ipot
IF (jij%l_J) DEALLOCATE (vxy1)
DEALLOCATE (ai,bi,nvp,ind,kvac3,map1, tddv,tduv,tudv,tuuv,a,b,bess,dbss,bess1, ddnv,dudz,duz,udz,uz ) DEALLOCATE (ai,bi,nvp,ind,kvac3,map1, tddv,tduv,tudv,tuuv,a,b,bess,dbss,bess1, ddnv,dudz,duz,udz,uz )
RETURN RETURN
......
...@@ -11,4 +11,5 @@ eigen_soc/sointg.f90 ...@@ -11,4 +11,5 @@ eigen_soc/sointg.f90
eigen_soc/sorad.f90 eigen_soc/sorad.f90
eigen_soc/spnorb.f90 eigen_soc/spnorb.f90
eigen_soc/vso.f90 eigen_soc/vso.f90
eigen_soc/ssomat.F90
) )
...@@ -13,9 +13,6 @@ MODULE m_spnorb ...@@ -13,9 +13,6 @@ MODULE m_spnorb
!********************************************************************* !*********************************************************************
CONTAINS CONTAINS
SUBROUTINE spnorb(atoms,noco,input,mpi, enpara, vr, usdus, rsoc,l_angles) SUBROUTINE spnorb(atoms,noco,input,mpi, enpara, vr, usdus, rsoc,l_angles)
USE m_anglso
USE m_sgml
USE m_sorad USE m_sorad
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
...@@ -37,12 +34,7 @@ CONTAINS ...@@ -37,12 +34,7 @@ CONTAINS
INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n
LOGICAL, SAVE :: first_k = .TRUE. LOGICAL, SAVE :: first_k = .TRUE.
! .. ! ..
! .. Local Arrays ..
INTEGER ispjsp(2)
! ..
! ..
DATA ispjsp/1,-1/
!Allocate space for SOC matrix elements; set to zero at the same time !Allocate space for SOC matrix elements; set to zero at the same time
ALLOCATE(rsoc%rsopp (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopp =0.0 ALLOCATE(rsoc%rsopp (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopp =0.0
ALLOCATE(rsoc%rsoppd (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsoppd=0.0 ALLOCATE(rsoc%rsoppd (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsoppd=0.0
...@@ -97,10 +89,34 @@ CONTAINS ...@@ -97,10 +89,34 @@ CONTAINS
9000 FORMAT (5x,' p ',5x,' d ', 5x, ' f ') 9000 FORMAT (5x,' p ',5x,' d ', 5x, ' f ')
! !
IF (.NOT.l_angles) RETURN !Calculate angular matrix elements if requested
IF (l_angles) &
CALL spnorb_angles(atoms,mpi,noco%theta,noco%phi,rsoc%soangl)
END SUBROUTINE spnorb
SUBROUTINE spnorb_angles(atoms,mpi,theta,phi,soangl)
IF ((ABS(noco%theta).LT.0.00001).AND.(ABS(noco%phi).LT.0.00001)) THEN USE m_anglso
USE m_sgml
USE m_sorad
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_mpi),INTENT(IN) :: mpi
REAL,INTENT(IN) :: theta,phi
COMPLEX,INTENT(INOUT) :: soangl(:,-atoms%lmaxd:,:,:,-atoms%lmaxd:,:)
! ..
! ..
! .. Local Scalars ..
INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n
! ..
! .. Local Arrays ..
INTEGER ispjsp(2)
! ..
! ..
DATA ispjsp/1,-1/
IF ((ABS(theta).LT.0.00001).AND.(ABS(phi).LT.0.00001)) THEN
! !
! TEST for real function sgml(l1,m1,is1,l2,m2,is2) ! TEST for real function sgml(l1,m1,is1,l2,m2,is2)
! !
...@@ -112,7 +128,7 @@ CONTAINS ...@@ -112,7 +128,7 @@ CONTAINS
is2=ispjsp(jspin2) is2=ispjsp(jspin2)
DO m1 = -l1,l1,1 DO m1 = -l1,l1,1
DO m2 = -l2,l2,1 DO m2 = -l2,l2,1
rsoc%soangl(l1,m1,jspin1,l2,m2,jspin2) =& soangl(l1,m1,jspin1,l2,m2,jspin2) =&
CMPLX(sgml(l1,m1,is1,l2,m2,is2),0.0) CMPLX(sgml(l1,m1,is1,l2,m2,is2),0.0)
ENDDO ENDDO
ENDDO ENDDO
...@@ -134,8 +150,8 @@ CONTAINS ...@@ -134,8 +150,8 @@ CONTAINS
! !
DO m1 = -l1,l1,1 DO m1 = -l1,l1,1
DO m2 = -l2,l2,1 DO m2 = -l2,l2,1
rsoc%soangl(l1,m1,jspin1,l2,m2,jspin2) =& soangl(l1,m1,jspin1,l2,m2,jspin2) =&
anglso(noco%theta,noco%phi,l1,m1,is1,l2,m2,is2) anglso(theta,phi,l1,m1,is1,l2,m2,is2)
ENDDO ENDDO
ENDDO ENDDO
! !
...@@ -152,7 +168,7 @@ CONTAINS ...@@ -152,7 +168,7 @@ CONTAINS
DO jspin2 = 1,2 DO jspin2 = 1,2
WRITE (6,FMT=*) 'd-states:is1=',jspin1,',is2=',jspin2 WRITE (6,FMT=*) 'd-states:is1=',jspin1,',is2=',jspin2
WRITE (6,FMT='(7x,7i8)') (m1,m1=-3,3,1) WRITE (6,FMT='(7x,7i8)') (m1,m1=-3,3,1)
WRITE (6,FMT=8003) (m2, (rsoc%soangl(3,m1,jspin1,3,m2,jspin2),& WRITE (6,FMT=8003) (m2, (soangl(3,m1,jspin1,3,m2,jspin2),&
m1=-3,3,1),m2=-3,3,1) m1=-3,3,1),m2=-3,3,1)
ENDDO ENDDO
ENDDO ENDDO
...@@ -160,5 +176,5 @@ CONTAINS ...@@ -160,5 +176,5 @@ CONTAINS
8002 FORMAT (' so - angular matrix elements') 8002 FORMAT (' so - angular matrix elements')
8003 FORMAT (i8,14f8.4) 8003 FORMAT (i8,14f8.4)
END SUBROUTINE spnorb END SUBROUTINE spnorb_angles
END MODULE m_spnorb END MODULE m_spnorb
This diff is collapsed.
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
MODULE m_ferhis MODULE m_ferhis
CONTAINS CONTAINS
SUBROUTINE ferhis(input,kpts,mpi,results, index,idxeig,idxkpt,idxjsp,n,& SUBROUTINE ferhis(input,kpts,mpi,results, index,idxeig,idxkpt,idxjsp,n,&
nstef,ws,spindg,weight, e,ne,we, noco,jij,cell) nstef,ws,spindg,weight, e,ne,we, noco,cell)
!*********************************************************************** !***********************************************************************
! !
! This subroutine determines the fermi energy and the sum of the ! This subroutine determines the fermi energy and the sum of the
...@@ -60,7 +60,6 @@ CONTAINS ...@@ -60,7 +60,6 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_noco),INTENT(IN),OPTIONAL :: noco TYPE(t_noco),INTENT(IN),OPTIONAL :: noco
TYPE(t_jij),INTENT(IN),OPTIONAL :: jij
TYPE(t_cell),INTENT(IN),OPTIONAL :: cell TYPE(t_cell),INTENT(IN),OPTIONAL :: cell
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
...@@ -295,20 +294,6 @@ CONTAINS ...@@ -295,20 +294,6 @@ CONTAINS
WRITE (6,FMT=8040) results%seigv WRITE (6,FMT=8040) results%seigv
END IF END IF
!--- J constants
IF (PRESENT(jij)) THEN
IF (jij%l_J) THEN
IF (jij%l_disp) THEN
qc=MATMUL(noco%qss,cell%bmat)
WRITE (114,FMT=1001) noco%qss(1),noco%qss(2),noco%qss(3),SQRT(dot_product(qc,qc)),results%seigv
ELSE
WRITE (114,FMT=1002) noco%qss(1),noco%qss(2),noco%qss(3),results%seigv
ENDIF
ENDIF
1001 FORMAT (4(f14.10,1x),f20.10)
1002 FORMAT (3(f14.10,1x),f20.10)
ENDIF
!--- J constants
! !
! 7.12.95 r.pentcheva seigscv = seigsc + seigv will be ! 7.12.95 r.pentcheva seigscv = seigsc + seigv will be
......
...@@ -8,7 +8,7 @@ MODULE m_fermie ...@@ -8,7 +8,7 @@ MODULE m_fermie
!---------------------------------------------------------------------- !----------------------------------------------------------------------
CONTAINS CONTAINS
SUBROUTINE fermie(eig_id, mpi,kpts,obsolete,& SUBROUTINE fermie(eig_id, mpi,kpts,obsolete,&
input, noco,e_min,jij,cell,results) input, noco,e_min,cell,results)
!---------------------------------------------------f-------------------- !---------------------------------------------------f--------------------
! !
...@@ -44,7 +44,6 @@ CONTAINS ...@@ -44,7 +44,6 @@ CONTAINS
TYPE(t_obsolete),INTENT(IN) :: obsolete TYPE(t_obsolete),INTENT(IN) :: obsolete
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_kpts),INTENT(IN) :: kpts
! .. ! ..
...@@ -102,18 +101,6 @@ CONTAINS ...@@ -102,18 +101,6 @@ CONTAINS
! initiliaze e ! initiliaze e
e = 0 e = 0
!
IF (jij%l_J) THEN
#if defined(CPP_MPI)&&defined(CPP_NEVER)
CALL mpi_col_eigJ(mpi%mpi_comm,mpi%irank,mpi%isize,kpts%nkpt,SIZE(results%w_iks,1),kpts%nkpt,&
& jij%nkpt_l,jij%eig_l,&
& kpts%bk,kpts%wtkpt,ne(1,1),eig)
IF (mpi%irank.NE.0) THEN
DEALLOCATE( idxeig,idxjsp,idxkpt,index,e,eig,we )
RETURN
ENDIF
#endif
ENDIF
IF ( mpi%irank == 0 ) WRITE (6,FMT=8000) IF ( mpi%irank == 0 ) WRITE (6,FMT=8000)
...@@ -223,7 +210,7 @@ CONTAINS ...@@ -223,7 +210,7 @@ CONTAINS
IF (noco%l_noco) nspins = 1 IF (noco%l_noco) nspins = 1
tkb_1 = input%tkb tkb_1 = input%tkb
CALL ferhis(input,kpts,mpi,results,index,idxeig,idxkpt,idxjsp, n,& CALL ferhis(input,kpts,mpi,results,index,idxeig,idxkpt,idxjsp, n,&
nstef,ws,spindg,weight,e,ne,we, noco,jij,cell) nstef,ws,spindg,weight,e,ne,we, noco,cell)
END IF END IF
! 7.12.95 r.pentcheva seigscv must be calculated outside if (gauss) ! 7.12.95 r.pentcheva seigscv must be calculated outside if (gauss)
results%seigscv = results%seigsc + results%seigv results%seigscv = results%seigsc + results%seigv
......
...@@ -12,7 +12,7 @@ CONTAINS ...@@ -12,7 +12,7 @@ CONTAINS
! ********************************************************************* ! *********************************************************************
! * calculates the NEW atomic positions after the results%force calculation * ! * calculates the NEW atomic positions after the results%force calculation *
! * SUBROUTINE is based on a BFGS method implemented by jij%M. Weinert * ! * SUBROUTINE is based on a BFGS method implemented by M. Weinert *
! * [cf. PRB 52 (9) p. 6313 (1995)] * ! * [cf. PRB 52 (9) p. 6313 (1995)] *
! * * ! * *
! * as a first step we READ in the file 'inp' WITH some additional * ! * as a first step we READ in the file 'inp' WITH some additional *
...@@ -82,7 +82,6 @@ CONTAINS ...@@ -82,7 +82,6 @@ CONTAINS
TYPE(t_enpara) :: enpara_temp TYPE(t_enpara) :: enpara_temp
TYPE(t_xcpot) :: xcpot_temp TYPE(t_xcpot) :: xcpot_temp
TYPE(t_results) :: results_temp TYPE(t_results) :: results_temp
TYPE(t_jij) :: jij_temp
TYPE(t_kpts) :: kpts_temp TYPE(t_kpts) :: kpts_temp
TYPE(t_hybrid) :: hybrid_temp TYPE(t_hybrid) :: hybrid_temp
TYPE(t_oneD) :: oneD_temp TYPE(t_oneD) :: oneD_temp
...@@ -182,7 +181,7 @@ CONTAINS ...@@ -182,7 +181,7 @@ CONTAINS
ALLOCATE(xmlCoreOccs(1,1,1)) ALLOCATE(xmlCoreOccs(1,1,1))
CALL initWannierDefaults(wann_temp) CALL initWannierDefaults(wann_temp)
CALL r_inpXML(atoms_temp,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,& CALL r_inpXML(atoms_temp,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
banddos_temp,dimension_temp,forcetheo,cell_temp,sym_temp,xcpot_temp,noco_temp,Jij_temp,& banddos_temp,dimension_temp,forcetheo,cell_temp,sym_temp,xcpot_temp,noco_temp,&
oneD_temp,hybrid_temp,kpts_temp,enpara_temp,coreSpecInput_temp,wann_temp,noel_temp,& oneD_temp,hybrid_temp,kpts_temp,enpara_temp,coreSpecInput_temp,wann_temp,noel_temp,&
namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,dtild_temp,xmlElectronStates,& namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,dtild_temp,xmlElectronStates,&
xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,l_kpts_temp) xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,l_kpts_temp)
...@@ -194,7 +193,7 @@ CONTAINS ...@@ -194,7 +193,7 @@ CONTAINS
div(:) = MIN(kpts_temp%nkpt3(:),1) div(:) = MIN(kpts_temp%nkpt3(:),1)
stars_temp%gmax = stars_temp%gmaxInit stars_temp%gmax = stars_temp%gmaxInit
CALL w_inpXML(atoms_new,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,forcetheo,&