Commit 809a4a25 authored by Matthias Redies's avatar Matthias Redies

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

parents e3f17b23 1df3cbc6
......@@ -6,6 +6,7 @@ c
SUBROUTINE dosef(
> ei,nemax,jspins,sfac,ntria,itria,atr,eig)
c
USE m_constants
USE m_trisrt
IMPLICIT NONE
C ..
......@@ -52,7 +53,7 @@ c--- > e1<ei<e2
ENDDO
! gb s = (2./jspins)*s
s = sfac * s
WRITE (6,FMT=8000) ei,jsp,s
WRITE (oUnit,FMT=8000) ei,jsp,s
ENDDO
8000 FORMAT (/,10x,'density of states at',f12.6,' har for spin',i2,'=',
......
......@@ -22,6 +22,8 @@ c and ef+8kt to obtain neutrality.
c
c***********************************************************************
USE m_constants
IMPLICIT NONE
C .. Scalar Arguments ..
......@@ -74,7 +76,7 @@ c***********************************************************************
+ calledby="ef_newton")
ELSE
rec_level=0
IF ( irank == 0 ) WRITE (6,FMT='(/,5x,''EF_NEWTON: '',
IF ( irank == 0 ) WRITE (oUnit,FMT='(/,5x,''EF_NEWTON: '',
+''Adjust Fermi-Energy by Newton-Method.'',/)')
ENDIF
c
......@@ -113,13 +115,13 @@ c
IF (abs(sff).LT.eps) THEN
!Converged, so do some output and return
w_near_ef = sff + w_near_ef
IF ( irank == 0 ) WRITE (6,FMT=8010) icnt,sff,-sff/sdff
IF (irank == 0) WRITE (oUnit,FMT=8010) icnt,sff,-sff/sdff
DO idim = inkem + 1,nocst
we(index(idim)) = ff(idim)
END DO
8000 FORMAT (15x,'ef_newton failed after :',i3,'iterations.',/,
8000 FORMAT (15x,'ef_newton failed after :',i3,'iterations.',/,
+ 15x,'The error in the weight is : ',e12.5,/,
+ 15x,'The error in ef is : ',e12.5,' htr',/)
8010 FORMAT (15x,'Number of iterations needed : ',i3,/,
......@@ -130,10 +132,10 @@ c
IF (abs(sdff).LT.1e-29) THEN
if (irank==0) THEN
write(6,*) "Instability in determination of fermi-level,"
write(6,*) "doubled temperature broading to continue"
write(*,*) "Instability in determination of fermi-level,"
write(*,*) "doubled temperature broading to continue"
write(oUnit,*) "Instability in determination of fermi-level,"
write(oUnit,*) "doubled temperature broading to continue"
write(*,*) "Instability in determination of fermi-level,"
write(*,*) "doubled temperature broading to continue"
ENDIF
CALL ef_newton(
> n,irank,
......@@ -159,7 +161,7 @@ c
c
c--- > NOT CONVERGED AFTER 50 ITERATIONS
c
IF ( irank == 0 ) WRITE (6,FMT=8000) icnt,sff,-sff/sdff
IF ( irank == 0 ) WRITE (oUnit,FMT=8000) icnt,sff,-sff/sdff
ef=ef+0.001
CALL ef_newton(
> n,irank,
......
......@@ -88,28 +88,30 @@ CONTAINS
END IF
ENDDO
eps = 1.25*eps
IF ( mpi%irank == 0 ) WRITE (6,FMT=8000) eps
IF ( mpi%irank == 0 ) WRITE (oUnit,FMT=8000) eps
8000 FORMAT (10x,'warning: eps has been increased to',e12.5)
ENDDO conv_loop
workf = -hartree_to_ev_const*ef
IF ( mpi%irank == 0 ) THEN
WRITE (6,FMT=8010) ef,workf,s
WRITE (oUnit,FMT=8010) ef,workf,s
END IF
8010 FORMAT (/,10x,'fermi energy=',f10.5,' har',3x,'work function=',&
f10.5,' ev',/,10x,'number of valence electrons=',f10.5)
f10.5,' ev',/,10x,'number of valence electrons=',f10.5)
IF (ABS(zcdiff).GT.5.0e-4) THEN
CALL juDFT_error('Fermi-level determination did not converge'&
,hint ="change temperature or set input = F" ,calledby ="fergwt")
CALL juDFT_error('Fermi-level determination did not converge',&
hint ="change temperature or set input = F", calledby ="fergwt")
ENDIF
DO jspin = 1,input%jspins
IF ( mpi%irank == 0 ) WRITE (6,FMT=8020) jspin
IF ( mpi%irank == 0 ) WRITE (oUnit,FMT=8020) jspin
8020 FORMAT (/,/,5x,'band-weighting factor for spin=',i5)
DO k = 1,kpts%nkpt
nbnd = ne(k,jspin)
IF ( mpi%irank == 0 ) WRITE (6,FMT=8030) k
IF ( mpi%irank == 0 ) WRITE (oUnit,FMT=8030) k
8030 FORMAT (/,5x,'k-point=',i5,/)
w_iks(:,k,jspin) = kpts%wtkpt(k)*w_iks(:,k,jspin)
IF ( mpi%irank == 0) WRITE (6,FMT=8040) (w_iks(i,k,jspin),i=1,nbnd)
IF ( mpi%irank == 0) THEN
WRITE (oUnit,FMT=8040) (w_iks(i,k,jspin),i=1,nbnd)
END IF
8040 FORMAT (5x,16f6.3)
ENDDO
ENDDO
......@@ -136,7 +138,7 @@ CONTAINS
seigv1 = (1/input%jspins)*fact1*s2
chmom = s1 - input%jspins*s
IF ( mpi%irank == 0 ) THEN
WRITE (6,FMT=8050) seigv - seigv1,s1,chmom
WRITE (oUnit,FMT=8050) seigv - seigv1,s1,chmom
END IF
8050 FORMAT (/,10x,'sum of eigenvalues-correction=',f12.5,/,10x,&
'sum of weight =',f12.5,/,10x,&
......
......@@ -7,7 +7,7 @@
MODULE m_ferhis
CONTAINS
SUBROUTINE ferhis(input,kpts,mpi, index,idxeig,idxkpt,idxjsp,nspins,n,&
nstef,ws,spindg,weight, e,ne,we, noco,cell,ef,seigv,w_iks,results)
nstef,ws,spindg,weight, e,ne,we, noco,cell,ef,seigv,w_iks,results)
!***********************************************************************
!
! This subroutine determines the fermi energy and the sum of the
......@@ -50,11 +50,13 @@ CONTAINS
! r.pentcheva, kfa, may 1996
!
!***********************************************************************
USE m_efnewton
USE m_types
USE m_xmlOutput
USE m_constants
USE m_efnewton
USE m_xmlOutput
IMPLICIT NONE
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_input),INTENT(IN) :: input
......@@ -121,8 +123,8 @@ CONTAINS
tkb=input%tkb !might be modified if we have an insulator
IF ( mpi%irank == 0 ) THEN
WRITE (6,FMT='(/)')
WRITE (6,FMT='(''FERHIS: Fermi-Energy by histogram:'')')
WRITE (oUnit,FMT='(/)')
WRITE (oUnit,FMT='(''FERHIS: Fermi-Energy by histogram:'')')
END IF
efermi = ef
......@@ -134,11 +136,11 @@ CONTAINS
WRITE(attributes(1),'(f20.10)') gap*hartree_to_ev_const
WRITE(attributes(2),'(a)') 'eV'
CALL writeXMLElement('bandgap',(/'value','units'/),attributes)
WRITE (6,FMT=8050) gap
WRITE (oUnit,FMT=8050) gap
END IF
END IF
IF ( mpi%irank == 0 ) THEN
WRITE ( 6,FMT=8010) spindg* (ws-weight)
WRITE (oUnit,FMT=8010) spindg* (ws-weight)
END IF
!
!---> DETERMINE OCCUPATION AT THE FERMI LEVEL
......@@ -174,7 +176,7 @@ CONTAINS
ENDDO ink_loop
IF (ink>n) THEN
IF ( mpi%irank == 0 ) THEN
WRITE (6,*) 'CAUTION!!! All calculated eigenvalues ', 'are below ef + 8kt.'
WRITE (oUnit,*) 'CAUTION!!! All calculated eigenvalues ', 'are below ef + 8kt.'
END IF
ENDIF
......@@ -189,14 +191,14 @@ CONTAINS
CALL ef_newton(n,mpi%irank, inkem,nocst,index,tkb,e, w_near_ef,ef,we)
!
IF ( mpi%irank == 0 ) THEN
WRITE (6,FMT=8030) ef,spindg*weight, spindg*w_below_emin,spindg* (w_below_emin+w_near_ef)
WRITE (oUnit,FMT=8030) ef,spindg*weight, spindg*w_below_emin,spindg* (w_below_emin+w_near_ef)
END IF
ELSE
!
!---> NO STATES BETWEEN EF-8kt AND EF+8kt AVAILABLE
!
IF ( mpi%irank == 0 ) WRITE (6,FMT=8020)
IF ( mpi%irank == 0 ) WRITE (oUnit,FMT=8020)
nocst = nstef
we(INDEX(nocst)) = we(INDEX(nocst)) - wfermi
ef = efermi
......@@ -222,9 +224,9 @@ CONTAINS
nocst = nstef
END IF
!
! write(6,*) nocst,' nocst in ferhis'
! write(oUnit,*) nocst,' nocst in ferhis'
! do ink = 1,nocst
! write(6,*) ink,index(ink),we(index(ink)),
! write(oUnit,*) ink,index(ink),we(index(ink)),
! + ' ink,index(ink),we(index(ink)): weights for eigenvalues'
! end do
!
......@@ -234,7 +236,7 @@ CONTAINS
!
w_iks(:,:,:) = 0.0
IF ( mpi%irank == 0 ) WRITE (6,FMT=8080) nocst
IF ( mpi%irank == 0 ) WRITE (oUnit,FMT=8080) nocst
DO i=1,nocst
w_iks(idxeig(INDEX(i)),idxkpt(INDEX(i)),idxjsp(INDEX(i))) = we(INDEX(i))
ENDDO
......@@ -249,7 +251,7 @@ CONTAINS
ENDDO
ENDDO
IF ( mpi%irank == 0 ) WRITE (6,FMT=8070) wvals
IF ( mpi%irank == 0 ) WRITE (oUnit,FMT=8070) wvals
!
!
!=======> DETERMINE ENTROPY
......@@ -277,7 +279,7 @@ CONTAINS
ENDDO
entropy = -spindg*entropy
results%ts = tkb*entropy
IF ( mpi%irank == 0 ) WRITE (6,FMT=8060) entropy,entropy*3.0553e-6 !: boltzmann constant in htr/k
IF ( mpi%irank == 0 ) WRITE (oUnit,FMT=8060) entropy,entropy*3.0553e-6 !: boltzmann constant in htr/k
......@@ -292,7 +294,7 @@ CONTAINS
WRITE(attributes(1),'(f20.10)') seigv
WRITE(attributes(2),'(a)') 'Htr'
CALL writeXMLElement('sumValenceSingleParticleEnergies',(/'value','units'/),attributes)
WRITE (6,FMT=8040) seigv
WRITE (oUnit,FMT=8040) seigv
END IF
......
......@@ -26,7 +26,8 @@ CONTAINS
!
!-----------------------------------------------------------------------
USE m_types
USE m_constants
USE m_eig66_io, ONLY : read_eig,write_eig
#if defined(CPP_MPI)&&defined(CPP_NEVER)
USE m_mpi_col_eigJ
......@@ -36,9 +37,10 @@ CONTAINS
USE m_ferhis
USE m_fergwt
USE m_fertetra
USE m_types
USE m_xmlOutput
IMPLICIT NONE
TYPE(t_results), INTENT(INOUT) :: results
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_input), INTENT(IN) :: input
......@@ -101,7 +103,7 @@ CONTAINS
! initiliaze e
e = 0
IF ( mpi%irank == 0 ) WRITE (6,FMT=8000)
IF ( mpi%irank == 0 ) WRITE (oUnit,FMT=8000)
8000 FORMAT (/,/,1x,'fermi energy and band-weighting factors:')
!
!---> READ IN EIGENVALUES
......@@ -125,9 +127,9 @@ CONTAINS
DO k = 1,kpts%nkpt
IF (mpi%irank == 0) THEN
CALL read_eig(eig_id,k,jsp,neig=ne(k,jsp),eig=eig(:,k,jsp))
WRITE (6,'(a2,3f10.5,f12.6)') 'at',kpts%bk(:,k),kpts%wtkpt(k)
WRITE (6,'(i5,a14)') ne(k,jsp),' eigenvalues :'
WRITE (6,'(8f12.6)') (eig(i,k,jsp),i=1,ne(k,jsp))
WRITE (oUnit,'(a2,3f10.5,f12.6)') 'at',kpts%bk(:,k),kpts%wtkpt(k)
WRITE (oUnit,'(i5,a14)') ne(k,jsp),' eigenvalues :'
WRITE (oUnit,'(8f12.6)') (eig(i,k,jsp),i=1,ne(k,jsp))
IF(.NOT.judft_was_argument("-minimalOutput")) THEN
attributes = ''
WRITE(attributes(1),'(i0)') jsp
......@@ -187,13 +189,12 @@ CONTAINS
! Check if no deep eigenvalue is found
IF (e_min-MINVAL(e(1:n))>1.0) THEN
WRITE(6,*) 'WARNING: Too low eigenvalue detected:'
WRITE(6,*) 'min E=', MINVAL(e(1:n)),' min(enpara)=',&
& e_min
CALL juDFT_warn("Too low eigenvalue detected",calledby="fermi" &
& ,hint ="If the lowest eigenvalue is more than 1Htr below "//&
& "the lowest energy parameter, you probably have picked up"//&
& " a ghoststate")
WRITE(oUnit,*) 'WARNING: Too low eigenvalue detected:'
WRITE(oUnit,*) 'min E=', MINVAL(e(1:n)),' min(enpara)=',e_min
CALL juDFT_warn("Too low eigenvalue detected",calledby="fermi", &
hint ="If the lowest eigenvalue is more than 1Htr below "//&
"the lowest energy parameter, you probably have picked up"//&
" a ghoststate")
END IF
!
!---> DETERMINE EF BY SUMMING WEIGHTS
......@@ -207,14 +208,14 @@ CONTAINS
l = l + 1
IF (l.GT.n) THEN
IF ( mpi%irank == 0 ) THEN
WRITE (6,FMT=8010) n,ws,weight
WRITE (oUnit,FMT=8010) n,ws,weight
END IF
CALL juDFT_error("Not enough wavefunctions",calledby="fermie")
8010 FORMAT (/,10x,'error: not enough wavefunctions.',i10,2d20.10)
END IF
ws = ws + we(INDEX(l))
seigv =seigv + e(INDEX(l))*we(INDEX(l))*spindg
! WRITE (6,FMT='(2f10.7)') e(index(l)),we(index(l))
! WRITE (oUnit,FMT='(2f10.7)') e(index(l)),we(index(l))
END DO
results%ef = -100000.0
IF(l.GT.0) THEN
......@@ -226,15 +227,15 @@ CONTAINS
zc = zc/2.0-(mspin-1.5)*input%fixed_moment
idxjsp = 1 !assume single spin in following calculations
IF (mspin == 1) THEN
WRITE(6,*) "Fixed total moment calculation"
WRITE(6,*) "Moment:",input%fixed_moment
write(6,*) "First Spin:"
WRITE(oUnit,*) "Fixed total moment calculation"
WRITE(oUnit,*) "Moment:",input%fixed_moment
write(oUnit,*) "First Spin:"
ELSE
WRITE(6,*) "Second Spin:"
WRITE(oUnit,*) "Second Spin:"
ENDIF
ENDIF
IF ( mpi%irank == 0 ) WRITE (6,FMT=8020) results%ef,nstef,seigv,ws,results%seigsc,ssc
IF ( mpi%irank == 0 ) WRITE (oUnit,FMT=8020) results%ef,nstef,seigv,ws,results%seigsc,ssc
!+po
results%ts = 0.0
......@@ -256,8 +257,8 @@ CONTAINS
results%seigscv = results%seigsc + results%seigv
IF (mspin == 2) THEN
WRITE(6,*) "Different Fermi-energies for both spins:"
WRITE(6,"(a,f0.3,a,f0.4,a,f0.4,a,f0.4)") "Fixed Moment:" &
WRITE(oUnit,*) "Different Fermi-energies for both spins:"
WRITE(oUnit,"(a,f0.3,a,f0.4,a,f0.4,a,f0.4)") "Fixed Moment:" &
,input%fixed_moment," Difference(EF):",efermi," - ",results%ef,"="&
,efermi-results%ef
ENDIF
......
MODULE m_fertetra
USE m_types
USE m_constants
USE m_juDFT
USE m_tetrahedronInit
......@@ -46,7 +47,7 @@ MODULE m_fertetra
ENDDO
IF (dlow.GT.input%zelec) THEN
WRITE(6,9000) lowBound,dlow,input%zelec
WRITE(oUnit,9000) lowBound,dlow,input%zelec
CALL juDFT_error("valence band too high ",calledby="fertetra")
ENDIF
9000 FORMAT (' valence band too high ',/,&
......@@ -73,7 +74,7 @@ MODULE m_fertetra
upperBound = upperBound + 0.2
it = it + 1
IF(it.GT.10) THEN
WRITE (6,9100) upperBound,dup,input%zelec
WRITE (oUnit,9100) upperBound,dup,input%zelec
9100 FORMAT (' valence band too low ',/,&
' eup ',f10.5,' dup ',f10.5,' nelec ',f10.5)
CALL juDFT_error("valence band too low ",calledby ="fertetra")
......@@ -110,7 +111,7 @@ MODULE m_fertetra
lowBound = ef
ENDIF
ENDDO
WRITE (6,9200) ef,dfermi,input%zelec
WRITE (oUnit,9200) ef,dfermi,input%zelec
9200 FORMAT (//,'Tetrahedron method: ',//,' fermi energy ',f10.5,&
' dtot ',f10.5,' nelec ',f10.5)
......@@ -132,10 +133,10 @@ MODULE m_fertetra
seigv = 2.0/input%jspins*seigv
chmom = s1 - jspins*s
IF ( mpi%irank == 0 ) THEN
WRITE (6,FMT=9300) seigv,s1,chmom
WRITE (oUnit,FMT=9300) seigv,s1,chmom
END IF
9300 FORMAT (/,10x,'sum of valence eigenvalues=',f20.6,5x,&
'sum of weights=',f10.6,/,10x,'moment=',f12.6)
END SUBROUTINE fertetra
END MODULE m_fertetra
\ No newline at end of file
END MODULE m_fertetra
......@@ -10,13 +10,15 @@
X ef,
< seigv,w)
USE m_types
USE m_constants
USE m_triang
USE m_maketetra
USE m_tetraef
USE m_dosef
USE m_dosint
USE m_doswt
USE m_types
! USE m_bzints
IMPLICIT NONE
......@@ -55,7 +57,7 @@
DATA de/5.0e-3/
IF ( irank == 0 ) THEN
WRITE (6,FMT=8000)
WRITE (oUnit,FMT=8000)
END IF
8000 FORMAT (/,/,10x,'linear triangular method')
c
......@@ -104,9 +106,9 @@ c---> write results of triang
atr(i) = atr(i)/as
ENDDO
IF ( irank == 0 ) THEN
WRITE (6,FMT=8010) ntria,as
WRITE (oUnit,FMT=8010) ntria,as
DO i = 1,ntria
WRITE (6,FMT=8020) i, (itria(j,i),j=1,3),atr(i)
WRITE (oUnit,FMT=8020) i, (itria(j,i),j=1,3),atr(i)
ENDDO
END IF
8010 FORMAT (/,10x,'triangular decomposition of brillouin zone:',/,
......@@ -115,7 +117,7 @@ c---> write results of triang
+ 'no.,corners and (normalized) area of each triangle:',/)
8020 FORMAT (10x,i3,3x,3i3,f14.6)
IF ( irank == 0 ) THEN
WRITE (6,FMT=*) 'ef_hist=',ef
WRITE (oUnit,FMT=*) 'ef_hist=',ef
END IF
ei = ef
cjr emin = -9999.9
......@@ -131,7 +133,7 @@ c
> ei,nemax,jspins,sfac,ntria,itria,atr,eig,
< ct)
c
IF ( irank == 0 ) WRITE (6,FMT=*) 'ct=',ct
IF ( irank == 0 ) WRITE (oUnit,FMT=*) 'ct=',ct
IF (ct.LT.zc) THEN ! ei < ef
emin = ei
......@@ -143,7 +145,7 @@ c
IF (emin.GT.emax) GO TO 90
ENDIF
IF (ct.NE.zc) THEN
IF ( irank == 0 ) WRITE (6,FMT=*) '2nd dosint'
IF ( irank == 0 ) WRITE (oUnit,FMT=*) '2nd dosint'
c---> refine ef to a value of 5 mry * (2**-20)
iterate : DO i = 1, 40
ei = 0.5* (emin+emax)
......@@ -152,7 +154,7 @@ c
> ei,nemax,jspins,sfac,ntria,itria,atr,eig,
< ct)
c
IF ( irank == 0 ) WRITE (6,FMT=*) 'i=',i,', ct=',ct
IF ( irank == 0 ) WRITE (oUnit,FMT=*) 'i=',i,', ct=',ct
IF ( ct == zc ) THEN
EXIT iterate
ELSEIF ( ct > zc ) THEN
......@@ -167,7 +169,7 @@ c
dez = zc - ct
workf = -13.6058*2*ef
IF ( irank == 0 ) THEN
WRITE (6,FMT=8030) ef,workf,del,dez
WRITE (oUnit,FMT=8030) ef,workf,del,dez
END IF
8030 FORMAT(/,10x,'fermi energy=',f10.5,' har',/,10x,'work function='
+ ,f10.5,' ev',/,10x,'uncertainity in energy and weights=',
......@@ -192,7 +194,7 @@ c DO 190 jsp = 1,jspins
c neig = nemax(jsp)
c DO 180 i = 1,neig
c DO 170 k = 1,nkpt
c WRITE (6,FMT=*) 'w(',i,',',k,',',jsp,')=',w(i,k,jsp)
c WRITE (oUnit,FMT=*) 'w(',i,',',k,',',jsp,')=',w(i,k,jsp)
c 170 CONTINUE
c 180 CONTINUE
c 190 CONTINUE
......@@ -215,14 +217,14 @@ c
seigv = sfac*seigv
chmom = s1 - jspins*s
IF ( irank == 0 ) THEN
WRITE (6,FMT=8040) seigv,s1,chmom
WRITE (oUnit,FMT=8040) seigv,s1,chmom
END IF
8040 FORMAT (/,10x,'sum of valence eigenvalues=',f20.6,5x,
+ 'sum of weights=',f10.6,/,10x,'moment=',f12.6)
RETURN
c
230 IF ( irank == 0 ) THEN
WRITE (6,FMT=8050) ei,ef,emin,emax,ct,zc
WRITE (oUnit,FMT=8050) ei,ef,emin,emax,ct,zc
END IF
8050 FORMAT (/,/,10x,'error fertri: initial guess of ef off by 25 mry',
+ ' ei,ef,emin,emax,ct,zc',/,10x,6e16.7,/,10x,
......
......@@ -17,6 +17,8 @@
> lb,ub,eig,zc,xfac,
> ntetra,itetra,voltet,
< efermi,w)
USE m_constants
c
IMPLICIT NONE
c
......@@ -128,7 +130,7 @@ c
ENDDO
ENDDO
IF (dlow.GT.nelec) THEN
WRITE (6,180) elow,dlow,nelec
WRITE (oUnit,180) elow,dlow,nelec
CALL juDFT_error("dos: valence band too high ",calledby
+ ="tetra_ef")
ENDIF
......@@ -153,7 +155,7 @@ c
eup = eup + 0.2
it = it + 1
IF( it .gt. 10 ) THEN
WRITE (6,200) eup,dup,nelec
WRITE (oUnit,200) eup,dup,nelec
CALL juDFT_error("dos: valence band too low ",
+ calledby ="tetra_ef")
END IF
......@@ -182,7 +184,7 @@ c
elow = efermi
ENDIF
ENDDO
WRITE (6,220) efermi,dfermi,nelec
WRITE (oUnit,220) efermi,dfermi,nelec
220 FORMAT (//,'>>> D O S <<<',//,' fermi energy ',f10.5,
+ ' dtot ',f10.5,' nelec ',i5)
c
......
......@@ -56,7 +56,8 @@ CONTAINS
! the following two constants should agree with the array dimensions
#ifdef CPP_Singleton
SUBROUTINE cfft(a, b, ntot, n, nspan, isn)
use m_juDFT
USE m_juDFT
USE m_constants
IMPLICIT NONE
! .. Scalar Arguments ..
INTEGER :: isn, n, nspan, ntot
......@@ -75,9 +76,6 @@ CONTAINS
REAL, ALLOCATABLE :: at(:), bt(:), ck(:), sk(:)
INTEGER, ALLOCATABLE :: nfac(:), np(:)
! ..
! .. Intrinsic Functions ..
INTRINSIC cos, real, mod, sin, sqrt
! ..
! .. Equivalences ..
EQUIVALENCE(i, ii)
! ..
......@@ -591,7 +589,7 @@ CONTAINS
! error finish, insufficient array storage
590 CONTINUE
! isn = 0
WRITE (6, FMT=8000)
WRITE (oUnit, FMT=8000)
CALL juDFT_error('array bounds exceeded', calledby='cfft')
8000 FORMAT('array bounds exceeded within subroutine cft')
667 CONTINUE
......
......@@ -32,6 +32,7 @@ CONTAINS
! G.Bihlmayer (UniWien)
! **********************************************************************
USE m_constants
USE m_cfft
IMPLICIT NONE
......@@ -54,15 +55,15 @@ CONTAINS
IF ((isn/=-1) .AND. (isn /= 1)) CALL juDFT_error("choose isn=+/- 1" &
,calledby ="rfft")
IF ((n1d < n1) .OR. (n2d < n2) .OR. (n3d < n3)) THEN
WRITE (6,*) 'n1d,n2d,n3d =',n1d,n2d,n3d
WRITE (6,*) 'n1 ,n2 ,n3 =',n1 ,n2 ,n3
WRITE (oUnit,*) 'n1d,n2d,n3d =',n1d,n2d,n3d
WRITE (oUnit,*) 'n1 ,n2 ,n3 =',n1 ,n2 ,n3
CALL juDFT_error("n(i) > n(i)d",calledby ="rfft")
ENDIF
IF ((n1 <= 2*nw1+1) .OR. &
(n2 <= 2*nw2+1) .OR. &
(n3 <= 2*nw3+1)) THEN
! WRITE (6,*) 'n1 ,n2 ,n3 =',n1 ,n2 ,n3
! WRITE (6,*) 'nw1,nw2,nw3 =',nw1,nw2,nw3
! WRITE (oUnit,*) 'n1 ,n2 ,n3 =',n1 ,n2 ,n3
! WRITE (oUnit,*) 'nw1,nw2,nw3 =',nw1,nw2,nw3
l_nopad= .TRUE.
ELSE
l_nopad= .FALSE.
......
......@@ -5,7 +5,7 @@
!--------------------------------------------------------------------------------
MODULE m_calculator
use m_juDFT
USE m_juDFT
!
! This module implements a parser able to evaluate expressions in
! input files
......@@ -66,7 +66,6 @@
!>
WRITE(*,*) m
WRITE(6,*) m
WRITE(*,*) "Defined variables:"
DO n = 1,n_vars
......
......@@ -459,12 +459,12 @@ SUBROUTINE read_xml_atoms(this,xml)
DO n = 1, this%ntype
IF (this%nlo(n).GE.1) THEN
IF (this%nlo(n).GT.this%nlod) THEN