Commit f5140782 authored by Daniel Wortmann's avatar Daniel Wortmann

Bugfixes for noco&film. Removed usage of oneD variable in many places...

parent fcd141ab
......@@ -242,13 +242,7 @@ CONTAINS
END IF
!
!-dw
IF (noco%l_noco) THEN
OPEN (25,FILE='potmat',FORM='unformatted',STATUS='old')
!---> skip the four components of the interstitial potential matrix
DO ipot = 1,3
READ (25)
ENDDO
ENDIF
wronk = 2.0
const = 1.0 / ( SQRT(cell%omtil)*wronk )
......@@ -262,15 +256,7 @@ CONTAINS
ac(:,:,:) = CMPLX(0.0,0.0)
bc(:,:,:) = CMPLX(0.0,0.0)
sign = 3. - 2.*ivac
IF (noco%l_noco) THEN
!---> read the non-warping potential matrix, it is needed to
!---> calculate the vacuum basis functions
READ (25)((vz(imz,ipot),imz=1,vacuum%nmzd),ipot=1,2)
!---> skip the warping potential matrix
DO ipot = 1,3
READ (25)
ENDDO
ENDIF
IF (noco%l_noco) THEN
!---> In a non-collinear calculation vacden is only called once.
!---> Thus, the vaccum wavefunctions and the A- and B-coeff. (ac bc)
......@@ -1230,7 +1216,6 @@ CONTAINS
ENDDO
END IF
ENDDO
IF (noco%l_noco) CLOSE (25)
DEALLOCATE (ac,bc,dt,dte,du,ddu,due,ddue,t,te,tei,u,ue,v,yy )
IF (oneD%odi%d1) THEN
......
......@@ -124,18 +124,18 @@ CONTAINS
IF (jspin1==jspin2) THEN
DO i = mpi%n_rank+1,lapw%nv(jspin1),mpi%n_size
i0=(i-1)/mpi%n_size+1 !local column index
ik = map2(i,jspin)
ik = map2(i,jspin1)
DO j = 1,i - 1 !TODO check noco case
!---> overlap: only (g-g') parallel=0 '
IF (map2(j,jspin).EQ.ik) THEN
sij = CONJG(a(i,jspin))*a(j,jspin) + &
CONJG(b(i,jspin))*b(j,jspin)*ddnv(ik,jspin1)
IF (map2(j,jspin1).EQ.ik) THEN
sij = CONJG(a(i,jspin1))*a(j,jspin1) + &
CONJG(b(i,jspin1))*b(j,jspin1)*ddnv(ik,jspin1)
!+APW_LO
IF (input%l_useapw) THEN
apw_lo = CONJG(a(i,jspin)* uz(ik,jspin1) + b(i,jspin)* udz(ik,jspin1) ) &
* (a(j,jspin)* duz(ik,jspin1) + b(j,jspin)*dudz(ik,jspin1) )&
+ (a(j,jspin)* uz(ik,jspin1) + b(j,jspin)* udz(ik,jspin1) ) &
* CONJG(a(i,jspin)* duz(ik,jspin1) + b(i,jspin)*dudz(ik,jspin1) )
apw_lo = CONJG(a(i,jspin1)* uz(ik,jspin1) + b(i,jspin1)* udz(ik,jspin1) ) &
* (a(j,jspin1)* duz(ik,jspin1) + b(j,jspin1)*dudz(ik,jspin1) )&
+ (a(j,jspin1)* uz(ik,jspin1) + b(j,jspin1)* udz(ik,jspin1) ) &
* CONJG(a(i,jspin1)* duz(ik,jspin1) + b(i,jspin1)*dudz(ik,jspin1) )
! IF (i.lt.10) write (3,'(2i4,2f20.10)') i,j,apw_lo
IF (hmat(1,1)%l_real) THEN
hmat(s1,s2)%data_r(j,i0) = hmat(s1,s2)%data_r(j,i0) + 0.25 * REAL(apw_lo)
......@@ -152,7 +152,7 @@ CONTAINS
END IF
ENDDO
!Diagonal term of Overlapp matrix, Hamiltonian later
sij = CONJG(a(i,jspin))*a(i,jspin) + CONJG(b(i,jspin))*b(i,jspin)*ddnv(ik,jspin1)
sij = CONJG(a(i,jspin1))*a(i,jspin1) + CONJG(b(i,jspin1))*b(i,jspin1)*ddnv(ik,jspin1)
IF (hmat(1,1)%l_real) THEN
smat(s1,s2)%data_r(j,i0) = smat(s1,s2)%data_r(j,i0) + REAL(sij)
ELSE
......@@ -172,7 +172,11 @@ CONTAINS
IF (hmat(1,1)%l_real) THEN
hmat(s1,s2)%data_r(j,i0) = hmat(s1,s2)%data_r(j,i0) + REAL(hij)
ELSE
hmat(s1,s2)%data_c(j,i0) = hmat(s1,s2)%data_c(j,i0) + hij
IF (s1==s2) THEN
hmat(s1,s2)%data_c(j,i0) = hmat(s1,s2)%data_c(j,i0) + hij
ELSE
hmat(s1,s2)%data_c(j,i0) = hmat(s1,s2)%data_c(j,i0) + conjg(hij)
ENDIF
ENDIF
ENDDO
ENDDO
......
......@@ -70,8 +70,8 @@ CONTAINS
den%pw(:stars%ng3,:) = fix*den%pw(:stars%ng3,:)
IF (input%film) THEN
den%vacz(:vacuum%nmz,:vacuum%nvac,:) = fix*den%vacz(:vacuum%nmz,:vacuum%nvac,:)
den%vacxy(:vacuum%nmzxy,:oneD%odi%nq2-1,:vacuum%nvac,:) = fix*&
den%vacxy(:vacuum%nmzxy,:oneD%odi%nq2-1,:vacuum%nvac,:)
den%vacxy(:vacuum%nmzxy,:stars%ng2-1,:vacuum%nvac,:) = fix*&
den%vacxy(:vacuum%nmzxy,:stars%ng2-1,:vacuum%nvac,:)
END IF
WRITE (6,FMT=8000) zc,fix
ELSE
......
......@@ -172,7 +172,7 @@ CONTAINS
ALLOCATE (oneD%pgft1x(0:1),oneD%pgft1xx(0:1),oneD%pgft1xy(0:1),&
oneD%pgft1y(0:1),oneD%pgft1yy(0:1))
ENDIF
oneD%odd%nq2 = oneD%odd%n2d
oneD%odd%nq2 = stars%ng2!oneD%odd%n2d
oneD%odi%nq2 = oneD%odd%nq2
!-odim
!+t3e
......
......@@ -47,6 +47,7 @@
USE m_prpxcfft
USE m_inpeig
USE m_efield
USE m_ylm
!-odim
USE m_od_mapatom
USE m_od_chisym
......@@ -86,6 +87,7 @@
ENDIF
IF (input%film.AND..NOT.sym%symor) CALL juDFT_warn("Films&Symor",hint&
& ="Films should be symmorphic",calledby ='setup')
CALL ylmnorm_init(atoms%lmaxd)
IF (.NOT.oneD%odd%d1) THEN
CALL local_sym(&
atoms%lmaxd,atoms%lmax,sym%nop,sym%mrot,sym%tau,&
......
......@@ -157,8 +157,8 @@ c-odim modifications due to one-dimensionality, YM
odd%nq2 = j
odd%kimax2 = odd%n2d - 1
ELSE
odd%n2d = n2d
odd%nq2 = n2d
odd%n2d = ng2
odd%nq2 = ng2
odd%nop = nop
END IF
c+odim
......
......@@ -306,7 +306,7 @@ MODULE m_cdn_io
END DO
END DO
DEALLOCATE(cdomvz)
READ (iUnit) (((den%vacxy(i,j-1,iVac,3),i=1,vacuum%nmzxy),j=2,oneD%odi%nq2), iVac=1,vacuum%nvac)
READ (iUnit) (((den%vacxy(i,j-1,iVac,3),i=1,vacuum%nmzxy),j=2,stars%ng2), iVac=1,vacuum%nvac)
END IF
ELSE
! (datend < 0) => no off-diagonal magnetisation stored
......@@ -634,7 +634,7 @@ MODULE m_cdn_io
END DO
END DO
WRITE (iUnit) ((cdomvz(i,iVac),i=1,vacuum%nmz),iVac=1,vacuum%nvac)
WRITE (iUnit) (((den%vacxy(i,j-1,iVac,3),i=1,vacuum%nmzxy),j=2,oneD%odi%nq2), iVac=1,vacuum%nvac)
WRITE (iUnit) (((den%vacxy(i,j-1,iVac,3),i=1,vacuum%nmzxy),j=2,stars%ng2), iVac=1,vacuum%nvac)
DEALLOCATE(cdomvz)
END IF
END IF
......
......@@ -68,7 +68,7 @@ CONTAINS
j = j + 1
sout(j) = den%vacz(k,iv,js)
END DO
DO k = 1,oneD%odi%nq2-1
DO k = 1,stars%ng2-1
DO i = 1,vacuum%nmzxy
mapvac = mapvac + 1
j = j + 1
......@@ -76,7 +76,7 @@ CONTAINS
END DO
END DO
IF (.NOT.sym%invs2) THEN
DO k = 1,oneD%odi%nq2-1
DO k = 1,stars%ng2-1
DO i = 1,vacuum%nmzxy
mapvac = mapvac + 1
j = j + 1
......@@ -107,7 +107,7 @@ CONTAINS
j = j + 1
sout(j) = den%vacz(k,iv,3)
END DO
DO k = 1,oneD%odi%nq2-1
DO k = 1,stars%ng2-1
DO i = 1,vacuum%nmzxy
mapvac2 = mapvac2 + 1
j = j + 1
......@@ -121,7 +121,7 @@ CONTAINS
j = j + 1
sout(j) = den%vacz(k,iv,4)
END DO
DO k = 1,oneD%odi%nq2-1
DO k = 1,stars%ng2-1
DO i = 1,vacuum%nmzxy
mapvac2 = mapvac2 + 1
j = j + 1
......@@ -129,7 +129,7 @@ CONTAINS
END DO
END DO
END DO
nvaccoeff2 = 2*vacuum%nmzxy*(oneD%odi%nq2-1)*vacuum%nvac + 2*vacuum%nmz*vacuum%nvac
nvaccoeff2 = 2*vacuum%nmzxy*(stars%ng2-1)*vacuum%nvac + 2*vacuum%nmz*vacuum%nvac
IF (mapvac2 .NE. nvaccoeff2) THEN
WRITE (6,*)'The number of vaccum coefficients off the'
WRITE (6,*)'off-diagonal part of the density matrix is'
......@@ -157,7 +157,7 @@ CONTAINS
ENDIF
IF (input%film) THEN
nvaccoeff = vacfac*vacuum%nmzxy*(oneD%odi%nq2-1)*vacuum%nvac + vacuum%nmz*vacuum%nvac
nvaccoeff = vacfac*vacuum%nmzxy*(stars%ng2-1)*vacuum%nvac + vacuum%nmz*vacuum%nvac
IF (mapvac .NE. nvaccoeff) THEN
WRITE(6,*)'The number of vaccum coefficients is'
WRITE(6,*)'inconsitent:'
......
......@@ -60,14 +60,14 @@ CONTAINS
j = j + 1
den%vacz(k,iv,js) = s_in(j)
END DO
DO k = 1,oneD%odi%nq2-1
DO k = 1,stars%ng2-1
DO i = 1,vacuum%nmzxy
j = j + 1
den%vacxy(i,k,iv,js) = CMPLX(s_in(j),0.0)
END DO
END DO
IF (.NOT.sym%invs2) THEN
DO k = 1,oneD%odi%nq2-1
DO k = 1,stars%ng2-1
DO i = 1,vacuum%nmzxy
j = j + 1
den%vacxy(i,k,iv,js) = den%vacxy(i,k,iv,js) + CMPLX(0.0,s_in(j))
......@@ -94,7 +94,7 @@ CONTAINS
j = j + 1
den%vacz(k,iv,3) = s_in(j)
END DO
DO k = 1,oneD%odi%nq2-1
DO k = 1,stars%ng2-1
DO i = 1,vacuum%nmzxy
j = j + 1
den%vacxy(i,k,iv,3) = CMPLX(s_in(j),0.0)
......@@ -106,7 +106,7 @@ CONTAINS
j = j + 1
den%vacz(k,iv,4) = s_in(j)
END DO
DO k = 1,oneD%odi%nq2-1
DO k = 1,stars%ng2-1
DO i = 1,vacuum%nmzxy
j = j + 1
den%vacxy(i,k,iv,3) = den%vacxy(i,k,iv,3)+ CMPLX(0.0,s_in(j))
......
......@@ -111,7 +111,7 @@ CONTAINS
!Now the vacuum part starts
ALLOCATE(vvacxy(0:ifft2-1,vacuum%nmzxyd,2,4))
ALLOCATE(vvacxy(ifft2,vacuum%nmzxyd,2,4))
!---> fouriertransform the spin up and down potential
......@@ -184,7 +184,7 @@ CONTAINS
! & %igf,odl%pgf,odi%nst2)
ELSE
CALL fft2d(stars, vvacxy(:,imz,ivac,ipot),fftwork,&
vTot%vacz(imz,ivac,ipot),vziw,vTot%vacxy(imz,:,ivac,ipot), vacuum%nmzxyd,-1)
vTot%vacz(imz,ivac,ipot),vziw,vTot%vacxy(:,:,ivac,ipot), vacuum%nmzxyd,-1)
END IF
ENDDO
ENDDO
......@@ -204,7 +204,7 @@ CONTAINS
! & %igf,odl%pgf,odi%nst2)
ELSE
CALL fft2d(stars, vvacxy(:,imz,ivac,3),vvacxy(:,imz,ivac,4),&
vTot%vacz(imz,ivac,3),vTot%vacz(imz,ivac,4),vTot%vacxy(imz,:,ivac,3), vacuum%nmzxyd,-1)
vTot%vacz(imz,ivac,3),vTot%vacz(imz,ivac,4),vTot%vacxy(:,:,ivac,3), vacuum%nmzxyd,-1)
END IF
ENDDO
ENDDO
......
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