Skip to content

GitLab

fleur
fleur
Commit 2981f721 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

Removed IO to inf-file (unit=16)

parent 9432d20e
Show whitespace changes
Inline Side-by-side
Showing with 34 additions and 263 deletions
cdn/cdntot.f90
View file @ 2981f721
......@@ -98,8 +98,6 @@ CONTAINS
q = q + qis
WRITE (6,FMT=8000) jspin,q,qis, (qmt(n),n=1,atoms%ntype)
IF (input%film) WRITE (6,FMT=8010) (i,qvac(i),i=1,vacuum%nvac)
WRITE (16,FMT=8000) jspin,q,qis, (qmt(n),n=1,atoms%ntype)
IF (input%film) WRITE (16,FMT=8010) (i,qvac(i),i=1,vacuum%nvac)
mtCharge = SUM(qmt(1:atoms%ntype) * atoms%neq(1:atoms%ntype))
names(1) = 'spin' ; WRITE(attributes(1),'(i0)') jspin ; lengths(1,1)=4 ; lengths(1,2)=1
names(2) = 'total' ; WRITE(attributes(2),'(f14.7)') q ; lengths(2,1)=5 ; lengths(2,2)=14
......@@ -123,7 +121,6 @@ CONTAINS
END DO ! loop over spins
DEALLOCATE (lengths)
WRITE (6,FMT=8020) qtot
WRITE (16,FMT=8020) qtot
IF(l_printData) THEN
CALL writeXMLElementFormPoly('totalCharge',(/'value'/),(/qtot/),reshape((/5,20/),(/1,2/)))
END IF
......
cdn/cdnval.F90
View file @ 2981f721
......@@ -154,7 +154,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF (mpi%irank==0) THEN
WRITE (6,FMT=8000) jspin
WRITE (16,FMT=8000) jspin
CALL openXMLElementPoly('mtCharges',(/'spin'/),(/jspin/))
END IF
8000 FORMAT (/,/,10x,'valence density: spin=',i2)
......
cdn/m_perp.f90
View file @ 2981f721
......@@ -57,11 +57,9 @@ CONTAINS
my = 2*AIMAG(qa21(itype))
mz = chmom(itype,1) - chmom(itype,2)
WRITE (6,8025) mx,my
WRITE (16,8025) mx,my
!---> determine the polar angles of the moment vector in the local frame
CALL pol_angle(mx,my,mz,betah,alphh)
WRITE (6,8026) betah,alphh
WRITE (16,8026) betah,alphh
8025 FORMAT(2x,'--> local frame: ','mx=',f9.5,' my=',f9.5)
8026 FORMAT(2x,'-->',10x,' delta beta=',f9.5,&
& ' delta alpha=',f9.5)
......@@ -79,9 +77,7 @@ CONTAINS
mz = rho11 - rho22
CALL pol_angle(mx,my,mz,betah,alphh)
WRITE (6,8027) noco%beta(itype),noco%alph(itype)-alphdiff
WRITE (16,8027) noco%beta(itype),noco%alph(itype)-alphdiff
WRITE (6,8028) betah,alphh-alphdiff
WRITE (16,8028) betah,alphh-alphdiff
8027 FORMAT(2x,'-->',10x,' input noco%beta=',f9.5, ' input noco%alpha=',f9.5)
8028 FORMAT(2x,'-->',10x,'output noco%beta=',f9.5, ' output noco%alpha=',f9.5)
......@@ -96,7 +92,6 @@ CONTAINS
my_mix = 2*AIMAG(rho21)
mz_mix = rho11 - rho22
WRITE (6,8031) mx_mix,my_mix
WRITE (16,8031) mx_mix,my_mix
8031 FORMAT(2x,'--> global frame: ','mixed mx=',f9.5,' mixed my=',f9.5)
! if magnetic moment (in local frame!) is negative, direction of quantization
! has to be antiparallel!
......@@ -109,7 +104,6 @@ CONTAINS
! calculate angles alpha and beta in global frame
CALL pol_angle(mx_mix,my_mix,mz_mix,betah,alphh)
WRITE (6,8029) betah,alphh-alphdiff
WRITE (16,8029) betah,alphh-alphdiff
8029 FORMAT(2x,'-->',10x,' new noco%beta =',f9.5, ' new noco%alpha =',f9.5)
noco%alph(itype) = alphh
noco%beta(itype) = betah
......@@ -129,9 +123,7 @@ CONTAINS
b_con_outy = scale*my
!---> mix input and output constraint fields
WRITE (6,8100) noco%b_con(1,itype),noco%b_con(2,itype)
WRITE (16,8100) noco%b_con(1,itype),noco%b_con(2,itype)
WRITE (6,8200) b_con_outx,b_con_outy
WRITE (16,8200) b_con_outx,b_con_outy
noco%b_con(1,itype) = noco%b_con(1,itype) + noco%mix_b*b_con_outx
noco%b_con(2,itype) = noco%b_con(2,itype) + noco%mix_b*b_con_outy
ENDIF
......
cdn/pwden.F90
View file @ 2981f721
......@@ -677,7 +677,6 @@ CONTAINS
ENDDO
ENDIF
WRITE ( 6,'(''bad quality of charge density'',2f13.8)')q0, REAL( cwk(1) )
WRITE (16,'(''bad quality of charge density'',2f13.8)')q0, REAL( cwk(1) )
CALL juDFT_warn('pwden: bad quality of charge')
ENDIF
ENDIF
......
cdn/rot_den_mat.f
View file @ 2981f721
......@@ -66,16 +66,13 @@ c---> check wether the diagonal elements of the rotated density
c---> are real.
DO ispin = 1,2
IF (aimag(rho(ispin,ispin)).GT.eps) THEN
WRITE(16,8000)
WRITE( 6,8000)
CALL juDFT_error("rotation of mag. failed",calledby
+ ="rot_den_mat")
ENDIF
ENDDO
8000 FORMAT('After the rotation of the density matrix in the'/
+ ="rot_den_mat",hint='After the rotation of the density matrix in the'/
+ 'muffin-tin sphere one diagonal element of the'/
+ '(hermitian) density matrix is not real. That means'/
+ 'that the density matrix was probably damaged.')
ENDIF
ENDDO
rho11 = real(rho(1,1))
rho22 = real(rho(2,2))
......
cdn/vacden.F90
View file @ 2981f721
......@@ -164,7 +164,6 @@ CONTAINS
eps=0.01
ic = CMPLX(0.,1.)
! ------------------
! WRITE (16,'(a,i2)') 'nstars=',nstars
! -----> set up mapping arrays
IF (noco%l_ss) THEN
......
cdn_mt/cdnmt.F90
View file @ 2981f721
......@@ -225,14 +225,12 @@ CONTAINS
!$OMP END PARALLEL
WRITE (6,FMT=8000)
WRITE (16,FMT=8000)
8000 FORMAT (/,5x,'l-like charge',/,t6,'atom',t15,'s',t24,'p',&
& t33,'d',t42,'f',t51,'total')
DO itype = 1,atoms%ntype
DO ispin = jsp_start,jsp_end
WRITE ( 6,FMT=8100) itype, (qmtl(l,ispin,itype),l=0,3),moments%chmom(itype,ispin)
WRITE (16,FMT=8100) itype, (qmtl(l,ispin,itype),l=0,3),moments%chmom(itype,ispin)
8100 FORMAT (' -->',i3,2x,4f9.5,2x,f9.5)
attributes = ''
WRITE(attributes(1),'(i0)') itype
......
cdn_mt/magMoms.f90
View file @ 2981f721
......@@ -28,13 +28,11 @@ SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,moments)
CHARACTER(LEN=20) :: attributes(4)
WRITE (6,FMT=8000)
WRITE (16,FMT=8000)
DO iType = 1,atoms%ntype
sval = moments%svdn(iType,1) - moments%svdn(iType,input%jspins)
stot = moments%stdn(iType,1) - moments%stdn(iType,input%jspins)
scor = stot - sval
WRITE (6,FMT=8010) iType,stot,sval,scor,moments%svdn(iType,1),moments%stdn(iType,1)
WRITE (16,FMT=8010) iType,stot,sval,scor,moments%svdn(iType,1),moments%stdn(iType,1)
END DO
8000 FORMAT (/,/,10x,'spin density at the nucleus:',/,10x,'type',t25,&
......@@ -43,14 +41,12 @@ SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,moments)
8010 FORMAT (i13,2x,3e20.8,5x,2e20.8)
WRITE (6,FMT=8020)
WRITE (16,FMT=8020)
CALL openXMLElement('magneticMomentsInMTSpheres',(/'units'/),(/'muBohr'/))
iRepAtom = 1
DO iType = 1, atoms%ntype
smom = moments%chmom(iType,1) - moments%chmom(iType,input%jspins)
WRITE (6,FMT=8030) iType,smom, (moments%chmom(iType,j),j=1,input%jspins)
WRITE (16,FMT=8030) iType,smom, (moments%chmom(iType,j),j=1,input%jspins)
attributes = ''
WRITE(attributes(1),'(i0)') iType
WRITE(attributes(2),'(f15.10)') smom
......
cdn_mt/orbMagMoms.f90
View file @ 2981f721
......@@ -29,7 +29,6 @@ SUBROUTINE orbMagMoms(input,atoms,noco,clmom)
thetai = noco%theta
phii = noco%phi
WRITE (6,FMT=9020)
WRITE (16,FMT=9020)
CALL openXMLElement('orbitalMagneticMomentsInMTSpheres',(/'units'/),(/'muBohr'/))
DO iType = 1, atoms%ntype
IF (noco%l_noco) THEN
......@@ -52,7 +51,6 @@ SUBROUTINE orbMagMoms(input,atoms,noco,clmom)
sin(phii)*clmom(2,iType,2))
WRITE (6,FMT=8030) iType,slmom,(clmom(3,iType,j),j=1,2)
WRITE (16,FMT=8030) iType,slmom,(clmom(3,iType,j),j=1,2)
attributes = ''
WRITE(attributes(1),'(i0)') iType
WRITE(attributes(2),'(f15.10)') slmom
......
core/ccdnup.f90
View file @ 2981f721
......@@ -66,8 +66,6 @@ CONTAINS
CALL intgr3(rhoc,atoms%rmsh(1,jatom),atoms%dx(jatom),nm,rhs)
tecs(jatom,jspin) = sume/input%jspins - rhs
WRITE (6,FMT=8010) jatom,jspin,tecs(jatom,jspin),sume/input%jspins
WRITE (16,FMT=8010) jatom,jspin,tecs(jatom,jspin),sume/input%jspins
! write(17) tec
! ---> simpson integration
dxx = atoms%dx(jatom)
......@@ -81,10 +79,7 @@ CONTAINS
q = q + rad*rhoss(nm1+1)
ENDDO
q = 2*q*dxx/3
!+sb
WRITE (6,FMT=8000) q/input%jspins
WRITE (16,FMT=8000) q/input%jspins
!-sb
qints(jatom,jspin) = q*atoms%neq(jatom)
END DO ! end-do-loop input%jspins
......
core/cored.F90
View file @ 2981f721
......@@ -71,7 +71,6 @@ CONTAINS
nm = atoms%jri(n)
CALL intgr3(rhoc,atoms%rmsh(1,n),atoms%dx(n),nm,rhos)
sea = tec(n,jspin) + rhos
WRITE (16,FMT=8030) n,jspin,tec(n,jspin),sea
WRITE (6,FMT=8030) n,jspin,tec(n,jspin),sea
seig = seig + atoms%neq(n)*sea
ENDDO
......@@ -97,7 +96,6 @@ CONTAINS
ncmsh = MIN( ncmsh, DIMENSION%msh )
rn = rnot* (d** (ncmsh-1))
WRITE (6,FMT=8000) z,rnot,dxx,atoms%jri(jatom)
WRITE (16,FMT=8000) z,rnot,dxx,atoms%jri(jatom)
DO j = 1,atoms%jri(jatom)
rhoss(j) = 0.
vrd(j) = vr(j,jatom)
......@@ -144,7 +142,6 @@ CONTAINS
CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,ncmsh,vrd, e, a,b,ierr)
stateEnergies(korb) = e
WRITE (6,FMT=8010) fn,fl,fj,e,weight
WRITE (16,FMT=8010) fn,fl,fj,e,weight
IF (ierr/=0) CALL juDFT_error("error in core-level routine" ,calledby ="cored")
IF (input%gw==1 .OR. input%gw==3) WRITE (15) NINT(fl),weight,e,&
a(1:atoms%jri(jatom)),b(1:atoms%jri(jatom))
......@@ -175,7 +172,6 @@ CONTAINS
CALL intgr3(rhoc,atoms%rmsh(1,jatom),atoms%dx(jatom),nm,rhs)
tec(jatom,jspin) = sume - rhs
WRITE (6,FMT=8030) jatom,jspin,tec(jatom,jspin),sume
WRITE (16,FMT=8030) jatom,jspin,tec(jatom,jspin),sume
! ---> simpson integration
rad = atoms%rmt(jatom)
......@@ -189,7 +185,6 @@ CONTAINS
q = 2*q*dxx/3
!+sb
WRITE (6,FMT=8020) q/input%jspins
WRITE (16,FMT=8020) q/input%jspins
!-sb
qint(jatom,jspin) = q*atoms%neq(jatom)
attributes = ''
......
core/etabinit.F90
View file @ 2981f721
......@@ -59,7 +59,6 @@ CONTAINS
d = EXP(atoms%dx(jatom))
rn = rnot* (d** (ncmsh-1))
WRITE (6,FMT=8000) z,rnot,dxx,atoms%jri(jatom)
WRITE (16,FMT=8000) z,rnot,dxx,atoms%jri(jatom)
DO j = 1,atoms%jri(jatom)
vrd(j) = vr(j,jatom)
ENDDO
......@@ -95,7 +94,6 @@ CONTAINS
e, a,b,ierr)
IF (ierr/=0) CALL juDFT_error("error in core-levels",calledby="etabinit")
WRITE (6,FMT=8010) fn,fl,fj,e,weight
WRITE (16,FMT=8010) fn,fl,fj,e,weight
eig(korb) = e
ENDDO
ic = 0
......
dos/cdninf.f90
View file @ 2981f721
......@@ -76,7 +76,6 @@ CONTAINS
IF (input%film) THEN
WRITE (6,FMT=8000) (bkpt(i),i=1,3)
WRITE (16,FMT=8000) (bkpt(i),i=1,3)
8000 FORMAT (/,3x,'q(atom,l): k=',3f10.5,/,/,t8,'e',t13,'max',t18,&
& 'int',t22,'vac',t28,'spheres(s,p,d,f)')
IF (banddos%dos) THEN
......@@ -89,7 +88,6 @@ CONTAINS
END IF
ELSE
WRITE (6,FMT=8010) (bkpt(i),i=1,3)
WRITE (16,FMT=8010) (bkpt(i),i=1,3)
8010 FORMAT (/,3x,'q(atom,l): k=',3f10.5,/,/,t8,'e',t13,'max',t18,&
& 'int',t24,'spheres(s,p,d,f)')
IF (banddos%dos) THEN
......@@ -102,7 +100,6 @@ CONTAINS
DO iband = 1,nbands
IF (sliceplot%slice) THEN
WRITE (6,FMT=8030) iband,eig(iband)
WRITE (16,FMT=8030) iband,eig(iband)
8030 FORMAT (' cdnval: slice for i=',i4,' and energy',1e12.4)
END IF
......@@ -136,8 +133,6 @@ CONTAINS
IF (input%film) THEN
WRITE (6,FMT=8040) eig(iband),chstat(lqmax),itypqmax,&
& iqispc,iqvacpc, ((iqalpc(l,ityp),l=0,3),ityp=1,atoms%ntype)
WRITE (16,FMT=8040) eig(iband),chstat(lqmax),itypqmax,&
& iqispc,iqvacpc, ((iqalpc(l,ityp),l=0,3),ityp=1,atoms%ntype)
8040 FORMAT (f10.4,2x,a1,i2,2x,2i3, (t26,6 (4i3,1x)))
IF (banddos%dos) THEN
IF (banddos%ndir.NE.0) THEN
......@@ -170,8 +165,6 @@ CONTAINS
ELSE
WRITE (6,FMT=8080) eig(iband),chstat(lqmax),itypqmax,&
& iqispc, ((iqalpc(l,ityp),l=0,3),ityp=1,atoms%ntype)
WRITE (16,FMT=8080) eig(iband),chstat(lqmax),itypqmax,&
& iqispc, ((iqalpc(l,ityp),l=0,3),ityp=1,atoms%ntype)
8080 FORMAT (f10.4,2x,a1,i2,2x,i3, (t26,6 (4i3,1x)))
IF (banddos%dos) THEN
IF (banddos%ndir.NE.0) THEN
......
eigen/vacfun.f90
View file @ 2981f721
......@@ -99,7 +99,6 @@ CONTAINS
phase = stars%rgphs(i1,i2,i3)
ind2 = stars%ig2(ind3)
IF (ind2.EQ.0) THEN
WRITE (16,FMT=8000) ik,jk
WRITE (6,FMT=8000) ik,jk
8000 FORMAT (' **** error in map2 for 2-d stars',2i5)
CALL juDFT_error("error in map2 for 2-d stars",calledby ="vacfun")
......
eigen_soc/eigenso.F90
View file @ 2981f721
......@@ -144,8 +144,8 @@ CONTAINS
input,noco,cell,oneD,nk,usdus,rsoc,nsz,nmat, eig_so,zso)
CALL timestop("eigenso: alineso")
IF (mpi%irank.EQ.0) THEN
WRITE (16,FMT=8010) nk,nsz
WRITE (16,FMT=8020) (eig_so(i),i=1,nsz)
WRITE (6,FMT=8010) nk,nsz
WRITE (6,FMT=8020) (eig_so(i),i=1,nsz)
ENDIF
8010 FORMAT (1x,/,/,' #k=',i6,':',/,&
' the',i4,' SOC eigenvalues are:')
......
fermi/dosef.f
View file @ 2981f721
......@@ -52,7 +52,6 @@ c--- > e1<ei<e2
ENDDO
! gb s = (2./jspins)*s
s = sfac * s
WRITE (16,FMT=8000) ei,jsp,s
WRITE (6,FMT=8000) ei,jsp,s
ENDDO
......
fermi/dosint.f
View file @ 2981f721
......@@ -39,7 +39,6 @@ c
e1 = eig(i,k1,jsp)
e2 = eig(i,k2,jsp)
e3 = eig(i,k3,jsp)
c write(16,*) 'eig=',i,', ntria=',n,', e1,e2,e3=',e1,e2,e3
CALL trisrt(e1,e2,e3,k1,k2,k3)
IF (e1.LE.-9999.0) CYCLE
IF (ei.LE.e1) CYCLE
......
fermi/fergwt.f90
View file @ 2981f721
......@@ -93,7 +93,6 @@ CONTAINS
ENDDO conv_loop
workf = -hartree_to_ev_const*ef
IF ( mpi%irank == 0 ) THEN
WRITE (16,FMT=8010) ef,workf,s
WRITE (6,FMT=8010) ef,workf,s
END IF
8010 FORMAT (/,10x,'fermi energy=',f10.5,' har',3x,'work function=',&
......@@ -138,7 +137,6 @@ CONTAINS
chmom = s1 - input%jspins*s
IF ( mpi%irank == 0 ) THEN
WRITE (6,FMT=8050) seigv - seigv1,s1,chmom
WRITE (16,FMT=8050) seigv - seigv1,s1,chmom
END IF
8050 FORMAT (/,10x,'sum of eigenvalues-correction=',f12.5,/,10x,&
'sum of weight =',f12.5,/,10x,&
......
fermi/ferhis.f90
View file @ 2981f721
......@@ -140,7 +140,6 @@ CONTAINS
END IF
IF ( mpi%irank == 0 ) THEN
WRITE ( 6,FMT=8010) spindg* (ws-weight)
WRITE (16,FMT=8010) spindg* (ws-weight)
END IF
!
!---> DETERMINE OCCUPATION AT THE FERMI LEVEL
......@@ -177,7 +176,6 @@ CONTAINS
IF (ink>n) THEN
IF ( mpi%irank == 0 ) THEN
WRITE (6,*) 'CAUTION!!! All calculated eigenvalues ', 'are below ef + 8kt.'
WRITE (16,*) 'CAUTION!!! All calculated eigenvalues ', 'are below ef + 8kt.'
END IF
ENDIF
......@@ -192,7 +190,6 @@ CONTAINS
CALL ef_newton(n,mpi%irank, inkem,nocst,index,tkb,e, w_near_ef,ef,we)
!
IF ( mpi%irank == 0 ) THEN
WRITE (16,FMT=8030) ef,spindg*weight, spindg*w_below_emin,spindg* (w_below_emin+w_near_ef)
WRITE (6,FMT=8030) ef,spindg*weight, spindg*w_below_emin,spindg* (w_below_emin+w_near_ef)
END IF
......
fermi/fertri.f
View file @ 2981f721
......@@ -55,7 +55,6 @@
DATA de/5.0e-3/
IF ( irank == 0 ) THEN
WRITE (16,FMT=8000)
WRITE (6,FMT=8000)
END IF
8000 FORMAT (/,/,10x,'linear triangular method')
......@@ -96,7 +95,6 @@ c---> write results of triang
ELSE
IF ( irank == 0 ) THEN
WRITE (6,*) 'reading tetrahedrons from file kpts'
WRITE (16,*) 'reading tetrahedrons from file kpts'
END IF
OPEN (41,file='kpts',FORM='formatted',STATUS='old')
DO i = 1, nkpt+1
......@@ -130,11 +128,9 @@ c---> write results of triang
atr(i) = atr(i)/as
ENDDO
IF ( irank == 0 ) THEN
WRITE (16,FMT=8010) ntria,as
WRITE (6,FMT=8010) ntria,as
DO i = 1,ntria
WRITE (6,FMT=8020) i, (itria(j,i),j=1,3),atr(i)
WRITE (16,FMT=8020) i, (itria(j,i),j=1,3),atr(i)
ENDDO
END IF
8010 FORMAT (/,10x,'triangular decomposition of brillouin zone:',/,
......@@ -143,7 +139,6 @@ 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 (16,FMT=*) 'ef_hist=',ef
WRITE (6,FMT=*) 'ef_hist=',ef
END IF
ei = ef
......@@ -172,7 +167,7 @@ c
IF (emin.GT.emax) GO TO 90
ENDIF
IF (ct.NE.zc) THEN
IF ( irank == 0 ) WRITE (16,FMT=*) '2nd dosint'
IF ( irank == 0 ) WRITE (6,FMT=*) '2nd dosint'
c---> refine ef to a value of 5 mry * (2**-20)
iterate : DO i = 1, 40
ei = 0.5* (emin+emax)
......@@ -196,7 +191,6 @@ c
dez = zc - ct
workf = -13.6058*2*ef
IF ( irank == 0 ) THEN
WRITE (16,FMT=8030) ef,workf,del,dez
WRITE (6,FMT=8030) ef,workf,del,dez
END IF
8030 FORMAT(/,10x,'fermi energy=',f10.5,' har',/,10x,'work function='
......@@ -245,7 +239,6 @@ c
seigv = sfac*seigv
chmom = s1 - jspins*s
IF ( irank == 0 ) THEN
WRITE (16,FMT=8040) seigv,s1,chmom
WRITE (6,FMT=8040) seigv,s1,chmom
END IF
8040 FORMAT (/,10x,'sum of valence eigenvalues=',f20.6,5x,
......@@ -253,7 +246,6 @@ c
RETURN
c
230 IF ( irank == 0 ) THEN
WRITE (16,FMT=8050) ei,ef,emin,emax,ct,zc
WRITE (6,FMT=8050) ei,ef,emin,emax,ct,zc
END IF
8050 FORMAT (/,/,10x,'error fertri: initial guess of ef off by 25 mry',
......
force/force_a3.f90
View file @ 2981f721
......@@ -44,7 +44,6 @@ CONTAINS
grd1(3,1) = czero
!
WRITE (6,*)
WRITE (16,*)
spin: DO jsp = 1,input%jspins
na = 1
DO n = 1,atoms%ntype
......@@ -78,8 +77,6 @@ CONTAINS
!+Gu
a3_2 = vr(atoms%jri(n),lh,n,jsp)/(input%jspins*atoms%rmt(n))
!-Gu
! WRITE (16,FMT=8000) a3_1,a3_2,zatom(n),rmt(n)
! 8000 FORMAT (' a3_1,a3_2,zatom(n),rmt(n)',4e12.4)
DO i = 1,3
forc_a3(i) = forc_a3(i) + (a3_1+a3_2)*gv(i)*atoms%zatom(n)
END DO
......@@ -91,9 +88,7 @@ CONTAINS
!
! write result
WRITE (6,FMT=8010) n
WRITE (16,FMT=8010) n
WRITE (6,FMT=8020) (forc_a3(i),i=1,3)
WRITE (16,FMT=8020) (forc_a3(i),i=1,3)
8010 FORMAT (' FORCES: EQUATION A3 FOR ATOM TYPE',i4)
8020 FORMAT (' FX_A3=',2f10.6,' FY_A3=',2f10.6,' FZ_A3=',2f10.6)
......
force/force_a4.f90
View file @ 2981f721
......@@ -62,7 +62,6 @@ CONTAINS
END DO
!
CALL intgr0(rhoc(:,n,jsp),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qcore)
! write(16,1616) qcore
8000 FORMAT (' FORCE_A4: core charge=',1p,e16.8)
!
!
......@@ -135,9 +134,7 @@ CONTAINS
! write result
!
WRITE (6,FMT=8010) n
WRITE (16,FMT=8010) n
WRITE (6,FMT=8020) (forc_a4(i),i=1,3)
WRITE (16,FMT=8020) (forc_a4(i),i=1,3)
8010 FORMAT (' FORCES: EQUATION A4 FOR ATOM TYPE',i4)
8020 FORMAT (' FX_A4=',2f10.6,' FY_A4=',2f10.6,' FZ_A4=',2f10.6)
! type loop ends
......
force/force_a4_add.f90
View file @ 2981f721
......@@ -169,26 +169,10 @@ CONTAINS
! write to out-file
WRITE (6,FMT=8010) n
WRITE (16,FMT=8010) n
WRITE (6,FMT=8020) ((force_a4_is(dir,n,jsp)),dir=1,3) ! 8020
WRITE (16,FMT=8020) ((force_a4_is(dir,n,jsp)),dir=1,3) ! 8020
! WRITE (6,FMT=8020) (real(force_a4_is(dir,n,jsp)),dir=1,3)
! WRITE (16,FMT=8020) (real(force_a4_is(dir,n,jsp)),dir=1,3)
WRITE (6,FMT=8015) n
WRITE (16,FMT=8015) n
WRITE (6,FMT=8020) ((force_a4_mt(dir,n,jsp)),dir=1,3) ! 8020
WRITE (16,FMT=8020) ((force_a4_mt(dir,n,jsp)),dir=1,3) ! 8020
! WRITE (6,FMT=8020) (real(force_a4_mt(dir,n,jsp)),dir=1,3)
! WRITE (16,FMT=8020) (real(force_a4_mt(dir,n,jsp)),dir=1,3)
! IF (film.AND..not.odi%d1) THEN
! WRITE (6,FMT=8025) n
! WRITE (16,FMT=8025) n
! WRITE (6,FMT=8070) ((force_a4_2d(dir,n,jsp)),dir=1,3)
! WRITE (16,FMT=8070) ((force_a4_2d(dir,n,jsp)),dir=1,3)
! ! WRITE (6,FMT=8070) (real(force_a4_2d(dir,n,jsp)),dir=1,3)
! ! WRITE (16,FMT=8070) (real(force_a4_2d(dir,n,jsp)),dir=1,3)
! END IF
8010 FORMAT (' FORCES: IS ADDITION TO EQUATION A4 FOR ATOM TYPE',i4)
FORMAT (' FORCES: IS ADDITION TO EQUATION A4 FOR ATOM TYPE',i4)
8015 FORMAT (' FORCES: MT ADDITION TO EQUATION A4 FOR ATOM TYPE',i4)
! 8025 FORMAT (' FORCES: VACUUM ADD. TO EQUATION A4 FOR ATOM TYPE',i4)
! 8020 FORMAT (' FX_A4=',2f19.15,' FY_A4=',2f19.15,' FZ_A4=',2f19.15)
......
force/force_a8.F90
View file @ 2981f721
......@@ -54,7 +54,6 @@ CONTAINS
CALL timestart("force_a8")
WRITE (6,*)
WRITE (16,*)
na = 1
DO n = 1,atoms%ntype
......@@ -73,7 +72,6 @@ CONTAINS
! components of the density have been multiplied by r**2
! (see for example subr. checkdop which constructs true MT-density at Rmt)
! factor sqrt(4pi) comes from Y_00 * \int d\Omega = 1/sqrt(4pi) * 4pi
! write(16,1616) qval*sfp
8000 FORMAT (' FORCE_A8: valence charge=',1p,e16.8)
! PART I of FORCE_A8
......@@ -240,9 +238,7 @@ CONTAINS
! write result
!
WRITE (6,FMT=8010) n
WRITE (16,FMT=8010) n
WRITE (6,FMT=8020) (forc_a8(i),i=1,3)
WRITE (16,FMT=8020) (forc_a8(i),i=1,3)
8010 FORMAT (' FORCES: EQUATION A8 FOR ATOM TYPE',i4)
8020 FORMAT (' FX_A8=',2f10.6,' FY_A8=',2f10.6,' FZ_A8=',2f10.6)
......@@ -256,51 +252,39 @@ CONTAINS
IF (.NOT.input%l_useapw) THEN
WRITE (6,*)
WRITE (16,*)
DO n=1,atoms%ntype
IF (atoms%l_geo(n)) THEN
WRITE (6,FMT=8030) n
WRITE (16,FMT=8030) n
WRITE (6,FMT=8040) (force%f_a12(i,n),i=1,3)
WRITE (16,FMT=8040) (force%f_a12(i,n),i=1,3)
ENDIF
8030 FORMAT (' FORCES: EQUATION A12 FOR ATOM TYPE',i4)
8040 FORMAT (' FX_A12=',2f10.6,' FY_A12=',2f10.6,' FZ_A12=',2f10.6)
ENDDO
ELSE
WRITE (6,*)
WRITE (16,*)
DO n=1,atoms%ntype
IF (atoms%l_geo(n)) THEN
WRITE (6,FMT=8070) n
WRITE (16,FMT=8070) n
WRITE (6,FMT=8080) (force%f_b4(i,n),i=1,3)
WRITE (16,FMT=8080) (force%f_b4(i,n),i=1,3)
ENDIF
8070 FORMAT (' FORCES: EQUATION B4 FOR ATOM TYPE',i4)
8080 FORMAT (' FX_B4=',2f10.6,' FY_B4=',2f10.6,' FZ_B4=',2f10.6)
ENDDO
WRITE (6,*)
WRITE (16,*)
DO n=1,atoms%ntype
IF (atoms%l_geo(n)) THEN
WRITE (6,FMT=8090) n
WRITE (16,FMT=8090) n
WRITE (6,FMT=8100) (force%f_b8(i,n),i=1,3)
WRITE (16,FMT=8100) (force%f_b8(i,n),i=1,3)
ENDIF
8090 FORMAT (' FORCES: EQUATION B8 FOR ATOM TYPE',i4)
8100 FORMAT (' FX_B8=',2f10.6,' FY_B8=',2f10.6,' FZ_B8=',2f10.6)
ENDDO
ENDIF
WRITE (6,*)
WRITE (16,*)
DO n=1,atoms%ntype
IF (atoms%l_geo(n)) THEN
WRITE (6,FMT=8050) n
WRITE (16,FMT=8050) n
WRITE (6,FMT=8060) (force%f_a21(i,n),i=1,3)
WRITE (16,FMT=8060) (force%f_a21(i,n),i=1,3)