Commit e2452f13 authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' of fleur-git:fleur into develop

parents ded182a0 8a5df050
......@@ -381,9 +381,10 @@
sf = czero
DO j = 1,sym%nop
x = -tpi_const* ( kr(1,j) * atoms%taual(1,nat)&
& + kr(2,j) * atoms%taual(2,nat)&
& + kr(3,j) * atoms%taual(3,nat))
sf = sf + CMPLX(COS(x),SIN(x))*phas(j)
& + kr(2,j) * atoms%taual(2,nat)&
& + kr(3,j) * atoms%taual(3,nat))
!gb sf = sf + CMPLX(COS(x),SIN(x))*phas(j)
sf = sf + CMPLX(COS(x),SIN(x))*conjg(phas(j))
ENDDO
sf = sf / REAL( sym%nop )
qpw(k,jspin) = qpw(k,jspin) + sf * qf(k)
......@@ -398,8 +399,8 @@
sf = czero
DO j = 1,oneD%ods%nop
x = -tpi_const* ( kro(1,j)*atoms%taual(1,nat)&
& + kro(2,j)*atoms%taual(2,nat)&
& + kro(3,j)*atoms%taual(3,nat))
& + kro(2,j)*atoms%taual(2,nat)&
& + kro(3,j)*atoms%taual(3,nat))
sf = sf + CMPLX(COS(x),SIN(x))*phaso(j)
ENDDO
sf = sf / REAL( oneD%ods%nop )
......
......@@ -973,9 +973,9 @@ enddo
!Note: no deallocation anymore, we rely on Fortran08 :-)
IF ((jsp_end.EQ.input%jspins)) THEN
IF ((banddos%dos.OR.banddos%vacdos).AND.(banddos%ndir/=-2)) CALL juDFT_end("DOS OK")
IF ((banddos%dos.OR.banddos%vacdos).AND.(banddos%ndir/=-2)) CALL juDFT_end("DOS OK",mpi%irank)
IF (vacuum%nstm.EQ.3) CALL juDFT_end("VACWAVE OK")
IF (vacuum%nstm.EQ.3) CALL juDFT_end("VACWAVE OK",mpi%irank)
ENDIF
END SUBROUTINE cdnval
END MODULE m_cdnval
......@@ -478,7 +478,7 @@ CONTAINS
CALL cfft(psi2r,psi2i,ifftq3,stars%kq3_fft,ifftq3,isn)
cwk=0.0
DO ik = 0 , stars%kmxq_fft - 1
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(psi1r(igq_fft(ik)),psi1i(igq_fft(ik)))
ENDDO
DO istr = 1,stars%ng3_fft
......@@ -491,7 +491,7 @@ CONTAINS
cwk=0.0
DO ik = 0 , stars%kmxq_fft - 1
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(psi2r(igq_fft(ik)),psi2i(igq_fft(ik)))
ENDDO
DO istr = 1,stars%ng3_fft
......@@ -582,16 +582,16 @@ CONTAINS
ecwk=0.0
IF (noco%l_noco) THEN
DO ik = 0 , stars%kmxq_fft - 1
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(rhomat(igq_fft(ik),idens),psi1r(igq_fft(ik)))
ENDDO
ELSE
DO ik = 0 , stars%kmxq_fft - 1
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(rhon(igq_fft(ik)),zero)
#else
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(rhon(igq_fft(ik)),psir(igq_fft(ik)))
#endif
ENDDO
......@@ -599,10 +599,10 @@ CONTAINS
IF (input%l_f) THEN
DO ik = 0 , stars%kmxq_fft - 1
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
ecwk(stars%igfft(ik,1))=ecwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
ecwk(stars%igfft(ik,1))=ecwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(ekin(igq_fft(ik)),zero)
#else
ecwk(stars%igfft(ik,1))=ecwk(stars%igfft(ik,1))+stars%pgfft(ik)*&
ecwk(stars%igfft(ik,1))=ecwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(ekin(igq_fft(ik)),psii(igq_fft(ik)))
#endif
ENDDO
......
......@@ -86,11 +86,8 @@
srmt = s*atoms%rmt(n)
sfs = (0.0,0.0)
DO nn = 1,sym%nop
!arg = tpi* (kr(1,nn)*taual(1,na)+kr(2,nn)*taual(2,na)+
!+ kr(3,nn)*taual(3,na))
arg =tpi_const*dot_product(kr(:,nn),atoms%taual(:,na))
!sfs = sfs + exp(cmplx(0.0,arg))*ph(nn)
sfs=sfs+cmplx(cos(arg),sin(arg))*ph(nn)
arg = tpi_const * dot_product(real(kr(:,nn)),atoms%taual(:,na))
sfs = sfs + cmplx(cos(arg),sin(arg))*ph(nn)
ENDDO
sfs = sfs/sym%nop
! -----3*ji(gr)/gr term
......@@ -108,12 +105,10 @@
& stars%kv3,&
& kr,ph)
sfs = (0.0,0.0)
DO 11 nn = 1,sym%nop
arg = tpi_const* (kr(1,nn)*atoms%taual(1,na)+&
& kr(2,nn)*atoms%taual(2,na)+&
& kr(3,nn)*atoms%taual(3,na))
sfs = sfs + exp(cmplx(0.0,arg))*ph(nn)
11 CONTINUE
DO nn = 1,sym%nop
arg = tpi_const * dot_product(real(kr(:,nn)),atoms%taual(:,na))
sfs = sfs + cmplx(cos(arg),sin(arg))*ph(nn)
ENDDO
sfs = sfs/sym%nop
! -----3*ji(gr)/gr term
s1 = 3.* (sin(srmt)/srmt-cos(srmt))/ (srmt*srmt)
......
......@@ -66,7 +66,7 @@ CONTAINS
CALL spgrot(sym%nop,sym%symor,sym%mrot,sym%tau,sym%invtab, kv, kr,ph)
sfs = (0.0,0.0)
DO nn = 1,sym%nop
arg = tpi_const* dot_product(kr(:,nn),atoms%taual(:,nat))
arg = tpi_const* dot_product(real(kr(:,nn)),atoms%taual(:,nat))
sfs = sfs + CMPLX(COS(arg),SIN(arg))*ph(nn)
ENDDO
sfs = sfs/sym%nop
......
......@@ -36,9 +36,9 @@ CONTAINS
#endif
! ..
! .. Local Scalars ..
REAL phase,phasep,q1,zsl1,zsl2,qi,volsli,volintsli
REAL q1,zsl1,zsl2,qi,volsli,volintsli
INTEGER i ,indp,ix1,iy1,iz1,j,n,ns,ind
COMPLEX x
COMPLEX x,phase,phasep
! ..
! .. Local Arrays ..
COMPLEX, ALLOCATABLE :: stfunint(:,:),z_z(:)
......@@ -102,11 +102,11 @@ CONTAINS
phase = stars%rgphs(ix1,iy1,iz1)/ (stars%nstr(ind)*cell%omtil)
phasep = stars%rgphs(-ix1,-iy1,-iz1)/ (stars%nstr(indp)*cell%omtil)
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
z_z(ind) = z_z(ind) + z(j,n)*z(i,n)*phase
z_z(indp) = z_z(indp) + z(i,n)*z(j,n)*phasep
z_z(ind) = z_z(ind) + z(j,n)*z(i,n)*REAL(phase)
z_z(indp) = z_z(indp) + z(i,n)*z(j,n)*REAL(phasep)
#else
z_z(ind) = z_z(ind) +z(j,n)*CONJG(z(i,n))*CMPLX(phase,0.0)
z_z(indp)= z_z(indp)+z(i,n)*CONJG(z(j,n))*CMPLX(phasep,0.0)
z_z(ind) = z_z(ind) +z(j,n)*CONJG(z(i,n))*phase
z_z(indp)= z_z(indp)+z(i,n)*CONJG(z(j,n))*phasep
#endif
ENDDO
ENDDO
......
......@@ -48,7 +48,7 @@ init/tetcon.f init/kvecon.f
set(inpgen_F90 io/xsf_io.f90
global/types.F90 global/enpara.f90 global/chkmt.f90 inpgen/inpgen.f90 inpgen/set_inp.f90 io/rw_inp.f90 juDFT/juDFT.F90
juDFT/stop.F90 juDFT/time.F90 juDFT/init.F90 io/w_inpXML.f90 init/julia.f90)
juDFT/stop.F90 juDFT/time.F90 juDFT/init.F90 io/w_inpXML.f90 init/julia.f90 io/xmlOutput.f90)
set(fleur_SRC ${fleur_F90} ${fleur_F77})
......
......@@ -649,7 +649,7 @@ CONTAINS
IF(l_file) CLOSE(1014)
INQUIRE(667,opened=l_file)
IF(l_file) CLOSE(667)
CALL juDFT_end("GW finished")
CALL juDFT_end("GW finished",mpi%irank)
ENDIF
ENDIF
......
......@@ -49,12 +49,12 @@ CONTAINS
#endif
! ..
! .. Local Scalars ..
COMPLEX th
REAL phase,b1(3),b2(3),r2
COMPLEX th,ts,phase
REAL b1(3),b2(3),r2
INTEGER i,i1,i2,i3,ii,in,j,ig3,ispin,l
INTEGER istart,nc
COMPLEX ust1,vp1,ts
COMPLEX ust1,vp1
COMPLEX, ALLOCATABLE :: vpw1(:) ! for J constants
! ..
! ..
......
......@@ -44,7 +44,8 @@ CONTAINS
REAL, INTENT (OUT):: ddnv(dimension%nv2d,dimension%jspd)
! ..
! .. Local Scalars ..
REAL ev,phase,scale,xv,yv,vzero
REAL ev,scale,xv,yv,vzero
COMPLEX phase
INTEGER i,i1,i2,i3,ik,ind2,ind3,jk,np1,jspin,jsp1,jsp2
LOGICAL tail
! ..
......
......@@ -88,7 +88,7 @@ CONTAINS
& lconv)
IF (lconv) THEN
WRITE (6,'(a)') "Des woars!"
CALL juDFT_end(" GEO Des woars ")
CALL juDFT_end(" GEO Des woars ", 1) ! The 1 is temporarily. Should be mpi%irank.
ELSE
atoms_new=atoms
......
......@@ -60,7 +60,7 @@
pylm(lm,n) = cmplx(0.,0.)
ENDDO
DO j = 1,sym%nop
x = tpi_const* dot_product(kr(:,j),atoms%taual(:,na))
x = tpi_const* dot_product(real(kr(:,j)),atoms%taual(:,na))
sf = cmplx(cos(x),sin(x))*phas(j)
DO l = 0,atoms%lmax(n)
ll1 = l*(l+1) + 1
......
......@@ -49,4 +49,5 @@ init/setlomap.F90
init/setup.f90
init/stepf.F90
init/strgn.f90
init/initParallelProcesses.f90
)
MODULE m_InitParallelProcesses
CONTAINS
SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,&
dimension,cell,sym,xcpot,noco,jij,oneD,hybrid,&
kpts,enpara,sphhar,mpi,results,obsolete)
USE m_types
IMPLICIT NONE
INCLUDE 'mpif.h'
TYPE(t_mpi), INTENT(INOUT) :: mpi
TYPE(t_input), INTENT(INOUT) :: input
TYPE(t_sym), INTENT(INOUT) :: sym
TYPE(t_stars), INTENT(INOUT) :: stars
TYPE(t_atoms), INTENT(INOUT) :: atoms
TYPE(t_vacuum), INTENT(INOUT) :: vacuum
TYPE(t_kpts), INTENT(INOUT) :: kpts
TYPE(t_oneD), INTENT(INOUT) :: oneD
TYPE(t_hybrid), INTENT(INOUT) :: hybrid
TYPE(t_Jij), INTENT(INOUT) :: Jij
TYPE(t_cell), INTENT(INOUT) :: cell
TYPE(t_banddos), INTENT(INOUT) :: banddos
TYPE(t_sliceplot),INTENT(INOUT) :: sliceplot
TYPE(t_xcpot), INTENT(INOUT) :: xcpot
TYPE(t_noco), INTENT(INOUT) :: noco
TYPE(t_dimension),INTENT(INOUT) :: dimension
TYPE(t_enpara), INTENT(INOUT) :: enpara
TYPE(t_sphhar), INTENT(INOUT) :: sphhar
TYPE(t_results), INTENT(INOUT) :: results
TYPE(t_obsolete), INTENT(INOUT) :: obsolete
INTEGER ierr(3)
EXTERNAL MPI_BCAST
CALL MPI_BCAST(atoms%ntype,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%ntypd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%nat,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%natd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%nlod,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%lmaxd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%llod,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%jmtd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sym%nop,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sym%nop2,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%n3d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%n2d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%k1d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%k2d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%k3d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sphhar%nlhd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sphhar%ntypsd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sphhar%memd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(dimension%jspd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(dimension%nstd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(dimension%nn3d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(dimension%nn2d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(kpts%numSpecialPoints,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(kpts%nkpts,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(kpts%nkptd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(kpts%nkpt,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%jspins,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(vacuum%layerd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(oneD%odd%k3,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(oneD%odd%M,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(oneD%odd%n2d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(oneD%odd%nop,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(oneD%odd%nn2d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(obsolete%nwdd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(jij%nqptd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
IF (mpi%irank.NE.0) THEN
ALLOCATE(atoms%nz(atoms%ntype),atoms%zatom(atoms%ntype)) !nz and zatom have the same content!
ALLOCATE(atoms%jri(atoms%ntype),atoms%dx(atoms%ntype),atoms%rmt(atoms%ntype))
ALLOCATE(atoms%lmax(atoms%ntype),atoms%nlo(atoms%ntype),atoms%lnonsph(atoms%ntype))
ALLOCATE(atoms%ncst(atoms%ntype),atoms%lda_u(atoms%ntype))
ALLOCATE(atoms%nflip(atoms%ntype),atoms%bmu(atoms%ntype),atoms%neq(atoms%ntype))
ALLOCATE(atoms%l_geo(atoms%ntype),atoms%relax(3,atoms%ntype))
ALLOCATE(atoms%taual(3,atoms%nat),atoms%pos(3,atoms%nat))
ALLOCATE(atoms%numStatesProvided(atoms%ntype))
ALLOCATE(atoms%rmsh(atoms%jmtd,atoms%ntype))
ALLOCATE(atoms%volmts(atoms%ntype))
ALLOCATE(atoms%vr0(atoms%ntype)) ! This should actually not be in the atoms type!
ALLOCATE(atoms%ncv(atoms%ntype))
ALLOCATE(atoms%ngopr(atoms%nat))
ALLOCATE(atoms%lapw_l(atoms%ntype))
ALLOCATE(atoms%invsat(atoms%nat))
ALLOCATE(atoms%nlhtyp(atoms%ntype),atoms%ntypsy(atoms%nat))
ALLOCATE(sphhar%clnu(sphhar%memd,0:sphhar%nlhd,sphhar%ntypsd))
ALLOCATE(sphhar%llh(0:sphhar%nlhd,sphhar%ntypsd))
ALLOCATE(sphhar%mlh(sphhar%memd,0:sphhar%nlhd,sphhar%ntypsd))
ALLOCATE(sphhar%nlh(sphhar%ntypsd),sphhar%nmem(0:sphhar%nlhd,sphhar%ntypsd))
ALLOCATE(noco%soc_opt(atoms%ntype+2),noco%l_relax(atoms%ntype),noco%b_con(2,atoms%ntype))
ALLOCATE(noco%alph(atoms%ntype),noco%beta(atoms%ntype))
ALLOCATE(Jij%alph1(atoms%ntype),Jij%l_magn(atoms%ntype),Jij%M(atoms%ntype))
ALLOCATE(Jij%magtype(atoms%ntype),Jij%nmagtype(atoms%ntype))
ALLOCATE(kpts%specialPoints(3,kpts%numSpecialPoints))
ALLOCATE(kpts%specialPointNames(kpts%numSpecialPoints))
ALLOCATE(kpts%bk(3,kpts%nkpts))
ALLOCATE(kpts%weight(kpts%nkpts))
ALLOCATE(kpts%wtkpt(kpts%nkpt))
ALLOCATE(enpara%evac0(2,input%jspins))
ALLOCATE(enpara%lchg_v(2,input%jspins),enpara%skiplo(atoms%ntypd,input%jspins))
ALLOCATE(enpara%enmix(input%jspins))
ALLOCATE(sym%mrot(3,3,sym%nop),sym%tau(3,sym%nop))
ALLOCATE(sym%invarop(atoms%nat,sym%nop),sym%invarind(atoms%nat))
ALLOCATE(sym%multab(sym%nop,sym%nop),sym%invtab(sym%nop))
ALLOCATE(sym%invsatnr(atoms%nat),sym%d_wgn(-3:3,-3:3,3,sym%nop))
ALLOCATE(atoms%llo(atoms%nlod,atoms%ntype))
ALLOCATE(atoms%ulo_der(atoms%nlod,atoms%ntype))
ALLOCATE(enpara%ello0(atoms%nlod,atoms%ntype,input%jspins))
ALLOCATE(enpara%llochg(atoms%nlod,atoms%ntype,input%jspins))
ALLOCATE(enpara%el0(0:atoms%lmaxd,atoms%ntype,input%jspins))
ALLOCATE(enpara%lchange(0:atoms%lmaxd,atoms%ntype,input%jspins))
ALLOCATE(atoms%l_dulo(atoms%nlod,atoms%ntype)) ! For what is this?
ALLOCATE(atoms%lo1l(0:atoms%llod,atoms%ntype))
ALLOCATE(atoms%nlol(0:atoms%llod,atoms%ntype))
ALLOCATE(atoms%coreStateOccs(dimension%nstd,2,atoms%ntype))
ALLOCATE(atoms%coreStateNprnc(dimension%nstd,atoms%ntype))
ALLOCATE(atoms%coreStateKappa(dimension%nstd,atoms%ntype))
ALLOCATE(vacuum%izlay(vacuum%layerd,2))
ALLOCATE(stars%ig(-stars%k1d:stars%k1d,-stars%k2d:stars%k2d,-stars%k3d:stars%k3d))
ALLOCATE(stars%ig2(stars%n3d),stars%igz(stars%n3d))
ALLOCATE(stars%kv2(2,stars%n2d),stars%kv3(3,stars%n3d))
ALLOCATE(stars%nstr2(stars%n2d),stars%nstr(stars%n3d))
ALLOCATE(stars%sk2(stars%n2d),stars%sk3(stars%n3d),stars%phi2(stars%n2d))
ALLOCATE(stars%igfft(0:dimension%nn3d-1,2),stars%igfft2(0:dimension%nn2d-1,2))
ALLOCATE(stars%rgphs(-stars%k1d:stars%k1d,-stars%k2d:stars%k2d,-stars%k3d:stars%k3d))
ALLOCATE(stars%pgfft(0:dimension%nn3d-1),stars%pgfft2(0:dimension%nn2d-1))
ALLOCATE(stars%ufft(0:27*stars%k1d*stars%k2d*stars%k3d-1),stars%ustep(stars%n3d))
ALLOCATE(results%force(3,atoms%ntype,dimension%jspd))
ALLOCATE(results%force_old(3,atoms%ntype))
ALLOCATE(oneD%ig1(-oneD%odd%k3:oneD%odd%k3,-oneD%odd%M:oneD%odd%M))
ALLOCATE(oneD%kv1(2,oneD%odd%n2d),oneD%nstr1(oneD%odd%n2d))
ALLOCATE(oneD%ngopr1(atoms%natd),oneD%mrot1(3,3,oneD%odd%nop),oneD%tau1(3,oneD%odd%nop))
ALLOCATE(oneD%invtab1(oneD%odd%nop),oneD%multab1(oneD%odd%nop,oneD%odd%nop))
ALLOCATE(oneD%igfft1(0:oneD%odd%nn2d-1,2),oneD%pgfft1(0:oneD%odd%nn2d-1))
ALLOCATE(hybrid%nindx(0:atoms%lmaxd,atoms%ntype))
ALLOCATE(hybrid%select1(4,atoms%ntype),hybrid%lcutm1(atoms%ntype))
ALLOCATE(hybrid%select2(4,atoms%ntype),hybrid%lcutm2(atoms%ntype),hybrid%lcutwf(atoms%ntype))
ALLOCATE(hybrid%ddist(dimension%jspd))
IF (xcpot%igrd.NE.0) THEN
ALLOCATE (stars%ft2_gfx(0:dimension%nn2d-1),stars%ft2_gfy(0:dimension%nn2d-1))
ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),&
oneD%pgft1xy(0:oneD%odd%nn2d-1),&
oneD%pgft1y(0:oneD%odd%nn2d-1),oneD%pgft1yy(0:oneD%odd%nn2d-1))
ELSE
ALLOCATE (stars%ft2_gfx(0:1),stars%ft2_gfy(0:1))
ALLOCATE (oneD%pgft1x(0:1),oneD%pgft1xx(0:1),oneD%pgft1xy(0:1),&
oneD%pgft1y(0:1),oneD%pgft1yy(0:1))
END IF
oneD%odd%nq2 = oneD%odd%n2d
atoms%vr0(:) = 0.0
jij%M(:) = 0.0
jij%l_magn(:) =.FALSE.
results%force(:,:,:) = 0.0
jij%l_wr=.TRUE.
jij%nqptd=1
jij%nmagn=1
jij%mtypes=1
jij%phnd=1
hybrid%ddist = 1.0
stars%sk2(:) = 0.0
stars%phi2(:) = 0.0
END IF
END SUBROUTINE initParallelProcesses
END MODULE m_InitParallelProcesses
......@@ -32,8 +32,8 @@
ELSE
DO n = 1,nop
ni = invtab(n)
phas(n) = exp(cmplx(0,1)*tpi_const*
+ dot_product(kr(:,n),tau(:,ni)))
phas(n) = exp(cmplx(0.0,-1.0)*tpi_const*
+ dot_product(real(kr(:,n)),tau(:,ni)))
! note that, in general phas(n) could be complex!
ENDDO
END IF
......
......@@ -221,7 +221,7 @@ CONTAINS
DO k2 = -stars%k2d,stars%k2d
DO k1 = -stars%k1d,stars%k1d
stars%ig(k1,k2,k3) = 0
stars%rgphs(k1,k2,k3) = 0.0
stars%rgphs(k1,k2,k3) = cmplx(0.0,0.0)
ENDDO
ENDDO
ENDDO
......@@ -347,7 +347,7 @@ CONTAINS
kidx=0
kidx2=0
!-gu
stars%rgphs(:,:,:) = 0.0
stars%rgphs(:,:,:) = cmplx(0.0,0.0)
DO k = 1,stars%ng3
CALL spgrot(&
......@@ -498,7 +498,7 @@ CONTAINS
! normalize phases:
!
IF (sym%symor) THEN
stars%rgphs(:,:,:) = 1.0
stars%rgphs(:,:,:) = cmplx(1.0,0.0)
ELSE
pon = 1.0 / sym%nop
pon2 = 1.0 / sym%nop2
......@@ -831,7 +831,7 @@ CONTAINS
!
! sum over phases
!
stars%rgphs(:,:,:) = 0.0
stars%rgphs(:,:,:) = cmplx(0.0,0.0)
starloop: DO k = 1,stars%ng3
CALL spgrot(&
......@@ -906,7 +906,7 @@ CONTAINS
! normalize phases:
!
IF (sym%symor) THEN
stars%rgphs(:,:,:) = 1.0
stars%rgphs(:,:,:) = cmplx(1.0,0.0)
ELSE
pon = 1.0 / sym%nop
DO k3 = -mxx3,mxx3
......
......@@ -213,6 +213,6 @@ PROGRAM inpgen
DEALLOCATE (vacuum%izlay)
DEALLOCATE ( atoms%taual,sym%mrot,sym%tau,atoms%neq,atoms%zatom,atoms%rmt,natmap,atoms%pos,idlist )
IF (inistop) CALL juDFT_end("Symmetry done")
IF (inistop) CALL juDFT_end("Symmetry done",1)
END
......@@ -59,7 +59,7 @@
CHARACTER(len=3) :: latnamTemp
INTEGER nu,iofile
INTEGER iggachk
INTEGER n ,iostat, errorStatus
INTEGER n ,iostat, errorStatus, numSpecies
REAL scale,scpos ,zc
REAL ello0(atoms%nlod,atoms%ntype),evac0(2)
......@@ -416,13 +416,13 @@
IF(errorStatus.NE.0) THEN
STOP 'Error: Cannot print out FleurInputSchema.xsd'
END IF
numSpecies = atoms%nat
CALL w_inpXML(&
& atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,div,l_gamma,&
& noel,namex,relcor,a1,a2,a3,scale,dtild,name,&
& xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
& atomTypeSpecies,speciesRepAtomType,&
& atomTypeSpecies,speciesRepAtomType,.FALSE.,numSpecies,&
& enpara%el0(:,:,1),enpara%ello0(:,:,1),enpara%evac0(:,1))
IF(juDFT_was_argument("-explicit")) THEN
......
......@@ -20,4 +20,5 @@ io/wrtdop.f90
io/w_inpXML.f90
io/xsf_io.f90
io/xmlIntWrapFort.f90
io/xmlOutput.f90
)
......@@ -3,7 +3,9 @@ MODULE m_rinpXML
CONTAINS
SUBROUTINE r_inpXML(&
& atoms,obsolete,vacuum,input,stars,sliceplot,banddos,dimension,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,enpara,sphhar,l_opti)
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,enpara,sphhar,l_opti,&
& noel,namex,relcor,a1,a2,a3,scale,dtild,xmlElectronStates,&
& xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType)
USE iso_c_binding
USE m_juDFT
......@@ -63,7 +65,17 @@ SUBROUTINE r_inpXML(&
TYPE(t_dimension),INTENT(OUT) :: dimension
TYPE(t_enpara) ,INTENT(OUT) :: enpara
TYPE(t_sphhar) ,INTENT(OUT) :: sphhar
LOGICAL, INTENT(OUT) :: l_opti
LOGICAL, INTENT(OUT) :: l_opti
INTEGER, ALLOCATABLE, INTENT(INOUT) :: xmlElectronStates(:,:)
INTEGER, ALLOCATABLE, INTENT(INOUT) :: atomTypeSpecies(:)
INTEGER, ALLOCATABLE, INTENT(INOUT) :: speciesRepAtomType(:)
REAL, ALLOCATABLE, INTENT(INOUT) :: xmlCoreOccs(:,:,:)
LOGICAL, ALLOCATABLE, INTENT(INOUT) :: xmlPrintCoreStates(:,:)
CHARACTER(len=3), ALLOCATABLE, INTENT(INOUT) :: noel(:)
CHARACTER(len=4), INTENT(OUT) :: namex
CHARACTER(len=12), INTENT(OUT) :: relcor
REAL, INTENT(OUT) :: a1(3),a2(3),a3(3)
REAL, INTENT(OUT) :: scale, dtild
CHARACTER(len=8) :: name(10)
......@@ -76,7 +88,7 @@ SUBROUTINE r_inpXML(&
!-odim
! ..
! .. Local Variables
REAL ::dtild ,scpos ,zc
REAL :: scpos ,zc
INTEGER ::nw
INTEGER ieq,i,k,na,n,ii
REAL s3,ah,a,hs2,rest
......@@ -122,11 +134,11 @@ SUBROUTINE r_inpXML(&
INTEGER :: speciesEParams(0:3)
INTEGER :: mrotTemp(3,3,48)
REAL :: tauTemp(3,48)
REAL :: a1(3),a2(3),a3(3), bk(3)
REAL :: bk(3)
LOGICAL :: flipSpin, l_eV, invSym, l_qfix, relaxX, relaxY, relaxZ, l_gga, l_kpts
LOGICAL :: l_vca, coreConfigPresent, l_enpara
REAL :: magMom, radius, logIncrement, qsc(3), latticeScale, dr
REAL :: aTemp, scale, zp, rmtmax, sumWeight, ldau_u, ldau_j, tempReal
REAL :: aTemp, zp, rmtmax, sumWeight, ldau_u, ldau_j, tempReal
REAL :: weightScale
LOGICAL :: l_amf
REAL, PARAMETER :: boltzmannConst = 3.1668114e-6 ! value is given in Hartree/Kelvin
......@@ -138,8 +150,6 @@ SUBROUTINE r_inpXML(&