diff --git a/cdn/cdntot.f90 b/cdn/cdntot.f90 index ad16fea5f4aaf678bf48a43f7500c6db5f3062b3..1a943cec586e3ed80c570b03d03859362ca3de5e 100644 --- a/cdn/cdntot.f90 +++ b/cdn/cdntot.f90 @@ -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 diff --git a/cdn/cdnval.F90 b/cdn/cdnval.F90 index 20f912f61010049b99d9af12a7540eee3636acd3..cda145f0a1dbfad82902eb983e4c1e1e48af514c 100644 --- a/cdn/cdnval.F90 +++ b/cdn/cdnval.F90 @@ -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) diff --git a/cdn/m_perp.f90 b/cdn/m_perp.f90 index 280c89b6b42218130e1b2d4bc8aa3f509bb1415c..8226437e96a3fa0f94985aba3c5393cb8f18ea8c 100644 --- a/cdn/m_perp.f90 +++ b/cdn/m_perp.f90 @@ -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 diff --git a/cdn/pwden.F90 b/cdn/pwden.F90 index 1d81c4ed1f519bbb179b54674c7bed228572eede..80b7f1f57e6e9a53203227b262a470574704ba1a 100644 --- a/cdn/pwden.F90 +++ b/cdn/pwden.F90 @@ -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 diff --git a/cdn/rot_den_mat.f b/cdn/rot_den_mat.f index 0ada86bb5e4a3599b33e9390b672e9f1987d7d95..faf5a8b7bfba1d96045095398b697bf08a7aeb7a 100644 --- a/cdn/rot_den_mat.f +++ b/cdn/rot_den_mat.f @@ -66,17 +66,15 @@ 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") + + ="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 - 8000 FORMAT('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.') - + rho11 = real(rho(1,1)) rho22 = real(rho(2,2)) rho21 = rho(2,1) diff --git a/cdn/vacden.F90 b/cdn/vacden.F90 index a9977298554fa438f86192c34ac172f2df45975a..554bcfe277eb32658cf3e3afa034fbd1f5edb234 100644 --- a/cdn/vacden.F90 +++ b/cdn/vacden.F90 @@ -164,8 +164,7 @@ CONTAINS eps=0.01 ic = CMPLX(0.,1.) ! ------------------ - ! WRITE (16,'(a,i2)') 'nstars=',nstars - + ! -----> set up mapping arrays IF (noco%l_ss) THEN jsp_start = 1 diff --git a/cdn_mt/cdnmt.F90 b/cdn_mt/cdnmt.F90 index 393f8dec5606848f743f486e34a252c513970a7e..ae2d24b0b8e0d1cd0025ba01912c97c41c292b99 100644 --- a/cdn_mt/cdnmt.F90 +++ b/cdn_mt/cdnmt.F90 @@ -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 diff --git a/cdn_mt/magMoms.f90 b/cdn_mt/magMoms.f90 index df75569b0319ffd6e71f045f701ab011724bec4e..49c013f54b59716c240642414a3be3fafa5fbb38 100644 --- a/cdn_mt/magMoms.f90 +++ b/cdn_mt/magMoms.f90 @@ -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 diff --git a/cdn_mt/orbMagMoms.f90 b/cdn_mt/orbMagMoms.f90 index 9c10e1c1c934da3bdca4a21c4f4c58b6b8296ca0..1566b73ed2d951ae1de68ce51194fe489b67aca0 100644 --- a/cdn_mt/orbMagMoms.f90 +++ b/cdn_mt/orbMagMoms.f90 @@ -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 diff --git a/core/ccdnup.f90 b/core/ccdnup.f90 index 9cf85eeb04957dad770be455860e37b486ad290c..a9a9e96b2939006835aa62b58cffd0acf1de4524 100644 --- a/core/ccdnup.f90 +++ b/core/ccdnup.f90 @@ -66,9 +66,7 @@ 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) d = EXP(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 diff --git a/core/cored.F90 b/core/cored.F90 index b5d7a2a5c9b05e17fba5db428a4ad1d83c873887..898e88866a7ae5a3727af3ba97c0ad74d7e08fc1 100644 --- a/core/cored.F90 +++ b/core/cored.F90 @@ -68,7 +68,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 @@ -94,7 +93,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.0 vrd(j) = vr(j,jatom) @@ -139,12 +137,13 @@ CONTAINS IF (bmu > 99.) weight = occ(korb) fl = fj + (.5e0)*isign(1,kappa(korb)) + eig = -2* (z/ (fn+fl))**2 CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,ncmsh,vrd, eig, a,b,ierr) stateEnergies(korb) = eig WRITE (6,FMT=8010) fn,fl,fj,eig,weight - WRITE (16,FMT=8010) fn,fl,fj,eig,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,eig,& a(1:atoms%jri(jatom)),b(1:atoms%jri(jatom)) @@ -192,8 +191,7 @@ 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) q = rad*rhoss(nm)/2. @@ -206,7 +204,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 = '' diff --git a/core/etabinit.F90 b/core/etabinit.F90 index 2b0797dc3192375c4fe12dfc94069b89448cd09f..d58b181cd185a244b88a7e55b1d72e0c9bc59886 100644 --- a/core/etabinit.F90 +++ b/core/etabinit.F90 @@ -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 diff --git a/dos/cdninf.f90 b/dos/cdninf.f90 index 2ef9613ad8cd04b74e8cca1aa754910993942413..8a51e275ae0f7c8a67e6c1e5242fe03b6b7ed27b 100644 --- a/dos/cdninf.f90 +++ b/dos/cdninf.f90 @@ -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 diff --git a/eigen/old/lodpot.f90 b/eigen/old/lodpot.f90 index 5cc2738bda4db764d01eac5fe28e0c361614d980..49f97f345cbc817748fdf2d38e2d3eaaa69dae69 100644 --- a/eigen/old/lodpot.f90 +++ b/eigen/old/lodpot.f90 @@ -456,8 +456,6 @@ CONTAINS IF ((obsolete%lepr.EQ.1).AND.(mpi%irank.EQ.0)) THEN WRITE ( 6,'(//,'' Reference energies for energy parameters'')') WRITE ( 6,'('' ----------------------------------------'')') - WRITE (16,'(//,'' Reference energies for energy parameters'')') - WRITE (16,'('' ----------------------------------------'')') ENDIF ! spins: DO jsp = 1,input%jspins @@ -473,7 +471,6 @@ CONTAINS vbar = vr(j,0,n,jsp)/rj IF (mpi%irank.EQ.0) THEN WRITE ( 6,'('' spin'',i2,'', atom type'',i3,'' ='',f12.6,'' r='',f8.5)') jsp,n,vbar,rj - WRITE (16,'('' spin'',i2,'', atom type'',i3,'' ='',f12.6,'' r='',f8.5)') jsp,n,vbar,rj ENDIF ELSE vbar = 0.0 @@ -511,7 +508,6 @@ CONTAINS vz0 = vz(1,ivac,jsp) IF (mpi%irank.EQ.0) THEN WRITE ( 6,'('' spin'',i2,'', vacuum '',i3,'' ='',f12.6)') jsp,ivac,vz0 - WRITE (16,'('' spin'',i2,'', vacuum '',i3,'' ='',f12.6)') jsp,ivac,vz0 ENDIF ENDIF evac(ivac,jsp) = enpara%evac0(ivac,jsp) + vz0 diff --git a/eigen/vacfun.f90 b/eigen/vacfun.f90 index f6daf2f87dacd57509393c5f67ea485ea08f14ef..4fad04570b39d16dc208f2012be2f744fc7dfe59 100644 --- a/eigen/vacfun.f90 +++ b/eigen/vacfun.f90 @@ -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") diff --git a/eigen_soc/eigenso.F90 b/eigen_soc/eigenso.F90 index 93d287e3ba5f1ae4af9a352559b5010710743780..e19dac8912054981f749235753830a6727ffcb74 100644 --- a/eigen_soc/eigenso.F90 +++ b/eigen_soc/eigenso.F90 @@ -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:') diff --git a/eigen_soc/spnorb.f90 b/eigen_soc/spnorb.f90 index 2b868f38a32f6bdc2031a0454950eb506eff0049..e73f3fbfdb5d01032bb85dc0c016888fd3c96100 100644 --- a/eigen_soc/spnorb.f90 +++ b/eigen_soc/spnorb.f90 @@ -50,7 +50,7 @@ CONTAINS !Calculate radial soc-matrix elements DO n = 1,atoms%ntype - CALL sorad(atoms,input,n,vr(:atoms%jri(n),0,n,:),enpara,noco%l_spav,rsoc,usdus) + CALL sorad(atoms,input,n,vr(:,0,n,:),enpara,noco%l_spav,rsoc,usdus) END DO ! diff --git a/eigen_soc/ssomat.F90 b/eigen_soc/ssomat.F90 index 30e115c64f94ee3feff38198fdad313e617e8f17..7939c533c6f3a0278d44a832002fa407065f73c1 100644 --- a/eigen_soc/ssomat.F90 +++ b/eigen_soc/ssomat.F90 @@ -407,7 +407,7 @@ CONTAINS ELSE bandf= 1 ENDIF - IF (ABS(AIMAG(matel(bandf,band2,n)))>1.e-10) THEN + IF (ABS(AIMAG(matel(bandf,band2,n)))>1.e-8) THEN PRINT *,bandf,band2,n,AIMAG(matel(bandf,band2,n)) CALL judft_error('Stop in ssomatel: diagonal matrix element not real') ENDIF diff --git a/external/elpa/install_elpa.sh b/external/elpa/install_elpa.sh index c0e08788bae0c0dbf909d091673f4cc9aa608dbe..58b80b83cb3e1891fe3f722ab4487795123d8672 100644 --- a/external/elpa/install_elpa.sh +++ b/external/elpa/install_elpa.sh @@ -6,8 +6,10 @@ then curl -LO "http://elpa.mpcdf.mpg.de/html/Releases/${elpa_version}/elpa-${elpa_version}.tar.gz" tar xzf elpa-${elpa_version}.tar.gz cd elpa-${elpa_version} - #configure - ./configure --enable-c-tests=no --disable-doxygen-doc --enable-shared=no --disable-mpi-module --disable-legacy --enable-openmp --prefix=$PWD/INSTALL_DIR + #configue + ./configure --enable-c-tests=no --disable-doxygen-doc --enable-shared=no --disable-mpi-module --enable-openmp --prefix=$PWD/INSTALL_DIR \ + --enable-option-checking=fatal SCALAPACK_LDFLAGS="-L$MKLROOT/lib/intel64 -lmkl_scalapack_lp64 -lmkl_gf_lp64 -lmkl_sequential -lmkl_core -lmkl_blacs_intelmpi_lp64 -lpthread "\ + SCALAPACK_FCFLAGS="-I$MKL_HOME/include/intel64/lp64" #Compile&test (This will take a while) make #Do make install diff --git a/fermi/dosef.f b/fermi/dosef.f index 289d4d3e8ff7b77a6b0b985046c7c0b4d0a55371..8bd4eaf2cee227d07d537b04cf8609e9522fe1af 100644 --- a/fermi/dosef.f +++ b/fermi/dosef.f @@ -52,7 +52,6 @@ c--- > e1 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', diff --git a/force/force_a3.f90 b/force/force_a3.f90 index cef713253269503704167edc3aec804ea7dc301c..987f4dc24e4f7584edf002c60bc34ad99a7a2323 100644 --- a/force/force_a3.f90 +++ b/force/force_a3.f90 @@ -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) diff --git a/force/force_a4.f90 b/force/force_a4.f90 index 4a3fffd4b2e0fa84ceb258c4ba3a3a68696bdb25..b0e195b482305dd1b2a18ea1f1d2799ba59e1779 100644 --- a/force/force_a4.f90 +++ b/force/force_a4.f90 @@ -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 diff --git a/force/force_a4_add.f90 b/force/force_a4_add.f90 index a7bcce1bcc864c87361c59eb73e35b5582d6af58..1d36a4c27daef2497caa5dbb360ba95e3c70fa0c 100644 --- a/force/force_a4_add.f90 +++ b/force/force_a4_add.f90 @@ -169,25 +169,9 @@ 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) 8015 FORMAT (' FORCES: MT ADDITION TO EQUATION A4 FOR ATOM TYPE',i4) ! 8025 FORMAT (' FORCES: VACUUM ADD. TO EQUATION A4 FOR ATOM TYPE',i4) diff --git a/force/force_a8.F90 b/force/force_a8.F90 index 68cf8c701869bab7806f093b665f6c6837e36dcc..f49bc1090f8a8cc314e56d03a2f1f7668ff02ddb 100644 --- a/force/force_a8.F90 +++ b/force/force_a8.F90 @@ -54,8 +54,7 @@ CONTAINS CALL timestart("force_a8") WRITE (6,*) - WRITE (16,*) - + na = 1 DO n = 1,atoms%ntype IF (atoms%l_geo(n)) THEN @@ -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) ENDIF 8050 FORMAT (' FORCES: EQUATION A21 FOR ATOM TYPE',i4) 8060 FORMAT (' FX_A21=',2f10.6,' FY_A21=',2f10.6,' FZ_A21=',2f10.6) diff --git a/force/force_sf.F90 b/force/force_sf.F90 index 3c6184c8d6df8e395937ed431cc404bda46fe2cc..c75402d10b9812f11d1b4be08b3b21c00df96ac4 100644 --- a/force/force_sf.F90 +++ b/force/force_sf.F90 @@ -554,12 +554,9 @@ force_sf(:,:) = force_is(:,:) - force_mt(:,:) force(:,:,isp) = force(:,:,isp) + real(force_sf(:,:)) WRITE (6,*) - WRITE (16,*) DO itype = 1,atoms%ntype WRITE (6,FMT=8010) itype - WRITE (16,FMT=8010) itype WRITE (6,FMT=8020) (force_sf(dir,itype),dir=1,3) - WRITE (16,FMT=8020) (force_sf(dir,itype),dir=1,3) END DO ! itype isdone = .false. mtdone = .false. diff --git a/force/force_w.f90 b/force/force_w.f90 index afed9bae0f037e3e0ce865d2293f3bcf99803e72..01d5c0cd845cf7a4f43191ee22d874f646ae2561 100644 --- a/force/force_w.f90 +++ b/force/force_w.f90 @@ -38,8 +38,6 @@ IF (input%jspins.EQ.2) THEN DO jsp = 1,input%jspins WRITE (6,FMT=8000) jsp,n, (atoms%pos(i,nat1),i=1,3),& - & (results%force(i,n,jsp),i=1,3) - WRITE (16,FMT=8000) jsp,n, (atoms%pos(i,nat1),i=1,3),& & (results%force(i,n,jsp),i=1,3) END DO END IF @@ -53,7 +51,6 @@ ! write total forces ! WRITE (6,8005) - WRITE (16,8005) 8005 FORMAT (/,' ***** TOTAL FORCES ON ATOMS ***** ',/) IF (input%l_f) CALL openXMLElement('totalForcesOnRepresentativeAtoms',(/'units'/),(/'Htr/bohr'/)) nat1 = 1 @@ -70,9 +67,7 @@ WRITE (6,FMT=8010) n, (atoms%pos(i,nat1),i=1,3),& & (forcetot(i,n),i=1,3) - WRITE (16,FMT=8010) n, (atoms%pos(i,nat1),i=1,3),& - & (forcetot(i,n),i=1,3) - 8010 FORMAT (' TOTAL FORCE FOR ATOM TYPE=',i3,2x,'X=',f7.3,3x,'Y=',& + 8010 FORMAT (' TOTAL FORCE FOR ATOM TYPE=',i3,2x,'X=',f7.3,3x,'Y=',& & f7.3,3x,'Z=',f7.3,/,22x,' FX_TOT=',f9.6,& & ' FY_TOT=',f9.6,' FZ_TOT=',f9.6) diff --git a/global/checkdop.F90 b/global/checkdop.F90 index 45eb6abc090602afe3ff2ea0c44589e9ba10b884..e9f010562d8d4ece9e8157369e233d4cd82b29ff 100644 --- a/global/checkdop.F90 +++ b/global/checkdop.F90 @@ -86,10 +86,8 @@ ! ---> vacuum part IF (l_cdn) THEN WRITE (6,FMT=9000) ivac - WRITE (16,FMT=9000) ivac ELSE WRITE (6,FMT=8000) ivac - WRITE (16,FMT=8000) ivac ENDIF DO j = 1,np IF (.NOT.oneD%odi%d1) THEN @@ -117,17 +115,14 @@ rcc=MATMUL(cell%bmat,p(:,j))/tpi_const WRITE (6,FMT=8020) rcc,(p(i,j),i=1,3),v1(j),v2(j) - WRITE (16,FMT=8020) rcc,(p(i,j),i=1,3),v1(j),v2(j) ELSE !CALL cotra0(p(1,j),rcc,cell%amat) rcc=MATMUL(cell%amat,p(:,j)) WRITE (6,FMT=8020) (p(i,j),i=1,3),rcc,v1(j),v2(j) - WRITE (16,FMT=8020) (p(i,j),i=1,3),rcc,v1(j),v2(j) ENDIF ENDDO CALL fitchk(v1(:np),v2(:np),av,rms,dms) WRITE (6,FMT=8030) av,rms,dms - WRITE (16,FMT=8030) av,rms,dms RETURN ENDIF ! ----> interstitial part @@ -147,10 +142,8 @@ ! ----> m.t. part IF (l_cdn) THEN WRITE (6,FMT=9010) n - WRITE (16,FMT=9010) n ELSE WRITE (6,FMT=8010) n - WRITE (16,FMT=8010) n ENDIF ir2 = 1.0 IF (l_cdn) ir2 = 1.0 / ( atoms%rmt(n)*atoms%rmt(n) ) @@ -203,12 +196,10 @@ rcc=MATMUL(cell%bmat,p(:,j))/tpi_const WRITE (6,FMT=8020) rcc, (p(i,j),i=1,3),v1(j),v2(j) - WRITE (16,FMT=8020) rcc, (p(i,j),i=1,3),v1(j),v2(j) END IF ENDDO CALL fitchk(v1(:np),v2(:np),av,rms,dms) WRITE (6,FMT=8030) av,rms,dms - WRITE (16,FMT=8030) av,rms,dms 8000 FORMAT (/,' int.-vac. boundary (potential): ivac=',i2,/,t10,& & 'int-coord',t36,'cart-coord',t57,' inter. ',t69,' vacuum ') 8010 FORMAT (/,' int.-m.t. boundary (potential): atom type=',i2,/,& diff --git a/global/convn.f90 b/global/convn.f90 index 4ca9104da1345d3312fa73826aebecba2c545f7b..90887fea81ce8b0b6afff11a98cd5381f491ec9a 100644 --- a/global/convn.f90 +++ b/global/convn.f90 @@ -57,22 +57,18 @@ !---> output and make sure ncv(n).le.ncvd 30 CONTINUE WRITE (6,FMT=8010) - WRITE (16,FMT=8010) DO 40 n = 1,atoms%ntype nc = atoms%ncv(n) l = nc - 1 WRITE (6,FMT=8020) n,nc,l - WRITE (16,FMT=8020) n,nc,l 40 CONTINUE l = dimension%ncvd - 1 WRITE (6,FMT=8030) dimension%ncvd,l - WRITE (16,FMT=8030) dimension%ncvd,l DO 50 n = 1,atoms%ntype atoms%ncv(n) = min0(atoms%ncv(n),dimension%ncvd) 50 CONTINUE RETURN 60 WRITE (6,FMT=8040) n,sck - WRITE (16,FMT=8040) n,sck CALL juDFT_error("ncv",calledby="convn") 8000 FORMAT (10i5) 8010 FORMAT (/,/,10x,'convergence parameters for the pseudocharge',& diff --git a/global/triang.f b/global/triang.f index 27d57218c0989af7c5f36b36497d1db962ac4504..74a29f8b9bea4540f56b9d1798e7623695632491 100644 --- a/global/triang.f +++ b/global/triang.f @@ -221,8 +221,6 @@ c ENDDO ENDDO ELSE -c write(16,1000) ((v(i,j),i=1,2),j=1,nt) -! CALL juDFT_error("triang",calledby="triang") ENDIF c 99001 FORMAT (' $$$ error in triang: collinear k-points'/(5x,2F12.6)) diff --git a/hybrid/read_core.F90 b/hybrid/read_core.F90 index 9f0bfeaf86d34e491b111af5325ec6f4b8800810..1f696eee69805ffb6ff46e2a03876770486a8618 100644 --- a/hybrid/read_core.F90 +++ b/hybrid/read_core.F90 @@ -401,7 +401,6 @@ rn = rnot* (d** (ncmsh-1)) IF ( mpi%irank == 0 ) THEN WRITE(6 ,FMT=8000) z,rnot,dxx,atoms%jri(itype) - WRITE(16,FMT=8000) z,rnot,dxx,atoms%jri(itype) END IF DO j = 1,atoms%jri(itype) vrd(j) = vr0(j,itype,jspin) @@ -453,7 +452,6 @@ IF ( mpi%irank == 0 ) THEN WRITE (6,FMT=8010) fn,fl,fj,e,weight - WRITE (16,FMT=8010) fn,fl,fj,e,weight END IF IF (ierr.NE.0) STOP 'error in core-level routine' diff --git a/init/boxdim.f b/init/boxdim.f index 3e4598280ef86dd13a90eb9a0f8261b812a1e9dd..bb2b6919fc3484d19d99b12ae1d913ace661c83f 100644 --- a/init/boxdim.f +++ b/init/boxdim.f @@ -82,7 +82,7 @@ c---> check on the zeros of some determinants c DO j = 1 , 3 IF ( det(j,j) .lt. eps ) THEN - WRITE (16, + WRITE (6, + '('' problem with det('',i1,'','',i1,'')'')') j,j CALL juDFT_error(" boxdim: determinant",calledby ="boxdim") END IF diff --git a/init/inpeig.f90 b/init/inpeig.f90 index 7e37bd7212dc2d673199d706cffff3f56ec4ad16..61038344b0f291e393f0c0ebcd1e563dc55c423f 100644 --- a/init/inpeig.f90 +++ b/init/inpeig.f90 @@ -142,10 +142,8 @@ kpts%wtkpt(:) = kpts%wtkpt(:)/wt WRITE (6,FMT=8120) kpts%nkpt - WRITE (16,FMT=8120) kpts%nkpt DO nk = 1,kpts%nkpt WRITE (6,FMT=8040) kpts%bk(:,nk),kpts%wtkpt(nk) - WRITE (16,FMT=8040) kpts%bk(:,nk),kpts%wtkpt(nk) ENDDO 8120 FORMAT (1x,/,' number of k-points for this window =',i5,/,t12,& & 'coordinates',t34,'weights') diff --git a/init/old_inp/inped.F90 b/init/old_inp/inped.F90 index 937b2f8319c825e393e04265c4a6c5b5dbc1913b..701898cf6190862a675f41e7876936d39ae63bfd 100644 --- a/init/old_inp/inped.F90 +++ b/init/old_inp/inped.F90 @@ -114,7 +114,6 @@ 8010 FORMAT (/,/,4x,10a8,/,/) !---> the menu for namgrp can be found in subroutine spgset WRITE (6,FMT=8030) cell%latnam,sym%namgrp,sym%invs,sym%zrfs,sym%invs2,input%jspins - WRITE (16,FMT=8030) cell%latnam,sym%namgrp,sym%invs,sym%zrfs,sym%invs2,input%jspins 8030 FORMAT (' lattice=',a3,/,' name of space group=',a4,/,' inversion symmetry= ',l1& ,/,' z-reflection symmetry=',l1,/,' vacuum-inversion symm=',l1,/,' jspins=',i1) @@ -161,13 +160,10 @@ a2(:) = input%scaleCell*a2(:) a3(:) = input%scaleCell*a3(:) WRITE (6,FMT=8050) input%scaleCell - WRITE (16,FMT=8050) input%scaleCell 8050 FORMAT (' unit cell scaled by ',f10.6) WRITE (6,FMT=8060) cell%z1 - WRITE (16,FMT=8060) cell%z1 8060 FORMAT (' the vacuum begins at z=',f10.6) WRITE (6,FMT=8070) dtild/2. - WRITE (16,FMT=8070) dtild/2. 8070 FORMAT (' dtilda/2= ',f10.6) ! set up bravais matrices of real and reciprocal lattices cell%amat(:,1) = a1(:) @@ -271,8 +267,6 @@ ! idsprs set to be zero. - WRITE (16,FMT=8122) 1,obsolete%lwb,obsolete%ndvgrd,0,obsolete%chng - WRITE (16,'(/)') WRITE (6,FMT=8122) 1,obsolete%lwb,obsolete%ndvgrd,0,obsolete%chng WRITE (6,'(/)') 8122 FORMAT ('igrd=',i1,',lwb=',l1,',ndvgrd=',i1,',idsprs=',i1, ',chng=',d10.3) @@ -280,11 +274,7 @@ ENDIF !-guta ! specification of atoms - IF (atoms%ntype.GT.atoms%ntype) THEN - WRITE (6,FMT='(a)') 'ntype > ntypd !!!' - WRITE (16,FMT='(a)') 'ntype > ntypd !!!' - CALL juDFT_error("ntypd",calledby ="inped") - END IF + cell%volint = cell%vol DO n = 1,atoms%ntype @@ -292,13 +282,11 @@ CALL trans(namat_const(n),str_up,str_do) IF ( (TRIM(ADJUSTL(noel(n))).NE.TRIM(ADJUSTL(str_up))) .OR.& & (TRIM(ADJUSTL(noel(n))).NE.TRIM(ADJUSTL(str_do))) ) THEN - WRITE(16,*) 'Element ',noel(n),' does not match Z = ',atoms%nz(n) WRITE( 6,*) 'Element ',noel(n),' does not match Z = ',atoms%nz(n) CALL juDFT_warn ("Element name and nuclear number do not match!" ,calledby ="inped") ENDIF ENDIF WRITE (6,8140) noel(n),atoms%nz(n),atoms%ncst(n),atoms%lmax(n),atoms%jri(n),atoms%rmt(n),atoms%dx(n) - WRITE (16,8140) noel(n),atoms%nz(n),atoms%ncst(n),atoms%lmax(n),atoms%jri(n),atoms%rmt(n),atoms%dx(n) 8140 FORMAT (a3,i3,3i5,2f10.6) IF (atoms%jri(n)>atoms%jmtd) CALL juDFT_error("jmtd",calledby ="inped") atoms%zatom(n) = atoms%nz(n) @@ -337,7 +325,6 @@ !---> i.e. they are given in internal units scaled by 'scpos' ! WRITE (6,FMT=8170) (atoms%taual(i,na),i=1,3),1.0 - WRITE (16,FMT=8170) (atoms%taual(i,na),i=1,3),1.0 8170 FORMAT (4f10.6) ! !---> for films, the z-coordinates are given in absolute values: @@ -397,12 +384,9 @@ !---> nwd = number of energy windows; lepr = 0 (1) for energy !---> parameters given on absolute (floating) scale - WRITE (16,FMT=*) 'nwd=',1,'lepr=',obsolete%lepr IF (ALL(obsolete%lepr .NE. (/0,1/))) CALL judft_error("Wrong choice of lepr",calledby="inped") WRITE (6,FMT=8320) input%l_f,input%eonly,1,llr(obsolete%lepr) - WRITE (16,FMT=8320) input%l_f,input%eonly,1,llr(obsolete%lepr) WRITE (6,FMT=8330) atoms%ntype, (atoms%lnonsph(n),n=1,atoms%ntype) - WRITE (16,FMT=8330) atoms%ntype, (atoms%lnonsph(n),n=1,atoms%ntype) 8320 FORMAT (1x,/,/,/,' input of parameters for eigenvalues:',/,t5,& & 'calculate Pulay-forces = ',l1,/,t5,'eigenvalues ',& & 'only = ',l1,/,t5,'number of energy windows =',i2,/,t5,& @@ -414,7 +398,6 @@ ! IF (obsolete%lepr.EQ.1) THEN WRITE ( 6,'(//,'' Floating energy parameters: relative'', '' window(s):'')') - WRITE (16,'(//,'' Floating energy parameters: relative'', '' window(s):'')') ENDIF !---> energy window @@ -426,18 +409,15 @@ ENDIF ! WRITE (6,FMT=8350) input%ellow,input%elup,input%zelec - WRITE (16,FMT=8350) input%ellow,input%elup,input%zelec 8350 FORMAT (1x,/,/,' energy window from',f8.3,' to', f8.3,' hartrees; nr. of electrons=',f6.1) !---> input of wavefunction cutoffs: input is a scaled quantity !---> related to the absolute value by rscale (e.g. a muffin-tin !---> radius) WRITE (6,FMT=8290) input%rkmax - WRITE (16,FMT=8290) input%rkmax 8290 FORMAT (1x,/,' wavefunction cutoff =',f10.5) ! IF ((input%tria) .AND. (input%gauss)) THEN WRITE (6,FMT='(a)') 'choose: either gaussian or triangular!' - WRITE (16,FMT='(a)') 'choose: either gaussian or triangular!' CALL juDFT_error("integration method",calledby ="inped") END IF WRITE (6,FMT=8230) input%gauss,input%delgau @@ -446,9 +426,7 @@ 8240 FORMAT (/,10x,'number of valence electrons=',f10.5,/,10x, 'temperature broadening =',f10.5) WRITE (6,FMT=*) 'itmax=',input%itmax,' broy_sv=',input%maxiter,' imix=',input%imix WRITE (6,FMT=*) 'alpha=',input%alpha,' spinf=',input%spinf - WRITE (16,FMT=*) 'itmax=',input%itmax,' broy_sv=',input%maxiter,' imix=',input%imix - WRITE (16,FMT=*) 'alpha=',input%alpha,' spinf=',input%spinf - + IF ((.NOT.sym%invs).AND.input%secvar) THEN WRITE(6,*)'The second variation is not implemented in the' WRITE(6,*)'complex version of the program.' @@ -468,7 +446,6 @@ IF (sliceplot%slice) THEN input%cdinf = .FALSE. WRITE (6,FMT=8390) sliceplot%kk,sliceplot%e1s,sliceplot%e2s - WRITE (16,FMT=8390) sliceplot%kk,sliceplot%e1s,sliceplot%e2s END IF 8390 FORMAT (' slice: k=',i3,' e1s=',f10.6,' e2s=',f10.6) ! diff --git a/init/old_inp/setup.f90 b/init/old_inp/setup.f90 index 1de4491bdf471ded63277183f70669690c53c27b..5b2c338971b691464d8d50f9fad9d5d2497664f2 100644 --- a/init/old_inp/setup.f90 +++ b/init/old_inp/setup.f90 @@ -41,7 +41,6 @@ USE m_stepf USE m_cdn_io USE m_mapatom - USE m_writegw USE m_convn USE m_prpqfft USE m_prpxcfft @@ -165,11 +164,6 @@ ! CALL prp_qfft(stars, cell,noco, input) - IF (input%gw.GE.1) CALL write_gw(& - atoms%ntype,sym%nop,1,input%jspins,atoms%nat,& - atoms%ncst,atoms%neq,atoms%lmax,sym%mrot,cell%amat,cell%bmat,input%rkmax,& - atoms%taual,atoms%zatom,cell%vol,1.0,DIMENSION%neigd,atoms%lmaxd,& - atoms%nlod,atoms%llod,atoms%nlo,atoms%llo,noco%l_soc) ! !-----> prepare dimensions for xc fft-box in visxc(g).f ! diff --git a/init/postprocessInput.F90 b/init/postprocessInput.F90 index e5a0796ddd53e336baac5505a32499c508da22e4..6450d7f038bacdfd526bd1d0e0a71b16f6fad593 100644 --- a/init/postprocessInput.F90 +++ b/init/postprocessInput.F90 @@ -28,7 +28,6 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts USE m_strgn USE m_od_strgn1 USE m_prpqfft - USE m_writegw USE m_prpxcfft USE m_stepf USE m_convn @@ -534,12 +533,6 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts CALL prp_qfft(stars,cell,noco,input) - IF (input%gw.GE.1) THEN - CALL write_gw(atoms%ntype,sym%nop,1,input%jspins,atoms%nat,& - atoms%ncst,atoms%neq,atoms%lmax,sym%mrot,cell%amat,cell%bmat,input%rkmax,& - atoms%taual,atoms%zatom,cell%vol,1.0,DIMENSION%neigd,atoms%lmaxd,& - atoms%nlod,atoms%llod,atoms%nlo,atoms%llo,noco%l_soc) - END IF CALL prp_xcfft(stars,input,cell,xcpot) diff --git a/init/prp_qfft.f90 b/init/prp_qfft.f90 index 8662ae1589ee27023fed40333c65d94eef53eeb4..9fe9eaa757f3299e3964ceab0b0ae1a733dc4ad9 100644 --- a/init/prp_qfft.f90 +++ b/init/prp_qfft.f90 @@ -140,9 +140,6 @@ WRITE (6,'('' rkmax and true gmax recalculated '')') WRITE (6,2100) input%rkmax, rknew, rknew*rknew WRITE (6,2200) gmaxp*rknew, gmaxp*rknew*gmaxp*rknew - WRITE (16,'('' rkmax and true gmax recalculated '')') - WRITE (16,2100) input%rkmax, rknew, rknew*rknew - WRITE (16,2200) gmaxp*rknew, gmaxp*rknew*gmaxp*rknew input%rkmax = rknew ENDIF ! @@ -184,9 +181,6 @@ IF ( stars%ng3_fft.EQ.0 ) THEN WRITE(6,'('' presumably ng3 too small '')') WRITE(6,'('' sk3max, gmaxp*rkmax '', 2f10.6)') & - & stars%sk3(stars%ng3),gmaxp*input%rkmax - WRITE(16,'('' presumably ng3 too small '')') - WRITE(16,'('' sk3max, gmaxp*rkmax '', 2f10.6)')& & stars%sk3(stars%ng3),gmaxp*input%rkmax CALL juDFT_error("presumably ng3 too small","prp_qfft") ENDIF @@ -194,8 +188,6 @@ IF ( stars%ng3_fft.GT.stars%ng3 ) THEN WRITE(6,'('' nq3_fft > n3d '')') WRITE(6,'('' nq3_fft, n3d '',2i10)') stars%ng3_fft, stars%ng3 - WRITE(16,'('' nq3_fft > n3d '')') - WRITE(16,'('' nq3_fft, n3d '',2i10)') stars%ng3_fft, stars%ng3 CALL juDFT_error("nq3_fft > n3d",calledby="prp_qfft") ENDIF ! @@ -209,11 +201,6 @@ WRITE (6,'('' inconsistency in def.s see also strgn1'')') WRITE (6,'('' mq1d,mq2d,mq3d,kv1,kv2,kv3 '',6i5)')& & stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,2*stars%kv3(1,istr),2*stars%kv3(2,istr),& - & 2*stars%kv3(3,istr) - WRITE (16,'('' not all nq3_fft stars in chg. den. FFT box'')') - WRITE (16,'('' inconsistency in def.s see also strgn1'')') - WRITE (16,'('' mq1d,mq2d,mq3d,kv1,kv2,kv3 '',6i5)')& - & stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,2*stars%kv3(1,istr),2*stars%kv3(2,istr),& & 2*stars%kv3(3,istr) CALL juDFT_error("not all nq3_fft stars in chg. den. FFT box",& & calledby ="prp_qfft") diff --git a/init/prp_xcfft.f90 b/init/prp_xcfft.f90 index 9e4b25fb5d9dce7574885bcbc01fca3fa54b918e..8e5452ccd236372f221d05bde64b1e7c8a72bfb3 100644 --- a/init/prp_xcfft.f90 +++ b/init/prp_xcfft.f90 @@ -140,8 +140,6 @@ IF (gmxxc_new.LT.xcpot%gmaxxc) THEN WRITE (6,'('' gmaxxc recalculated '')') WRITE (6,2100) xcpot%gmaxxc, gmxxc_new, gmxxc_new*gmxxc_new - WRITE (16,'('' gmaxxc recalculated '')') - WRITE (16,2100) xcpot%gmaxxc, gmxxc_new, gmxxc_new*gmxxc_new xcpot%gmaxxc = gmxxc_new ENDIF ! @@ -162,8 +160,6 @@ & stars%kxc3_fft.gt.stars%kxc3_fft) THEN WRITE (6,'('' box dim. for fft too small'')') WRITE (6,2110) stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft - WRITE(16,'('' box dim. for fft too small'')') - WRITE(16,2110) stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft CALL juDFT_error("mxc[1,2,3]d>kxc[1,2,3]d ",calledby& & ="prp_xcfft") ENDIF @@ -183,17 +179,12 @@ WRITE (6,'('' presumably ng3 too small '')') WRITE (6,'('' sk3max, gmaxxc '', 2f10.6)')& & stars%sk3(stars%ng3),xcpot%gmaxxc - WRITE(16,'('' presumably ng3 too small '')') - WRITE(16,'('' sk3max, gmaxxc '', 2f10.6)')& - & stars%sk3(stars%ng3),xcpot%gmaxxc CALL juDFT_error("nxc3_fft==0",calledby ="prp_xcfft") ENDIF ! IF ( stars%nxc3_fft.GT.stars%ng3 ) THEN WRITE (6,'('' nxc3_fft > n3d '')') WRITE (6,'('' nxc3_fft, n3d '',2i10)') stars%nxc3_fft, stars%ng3 - WRITE (16,'('' nxc3_fft > n3d '')') - WRITE (16,'('' nxc3_fft, n3d '',2i10)') stars%nxc3_fft, stars%ng3 CALL juDFT_error("nxc3_fft>n3d ",calledby ="prp_xcfft") ENDIF ! @@ -208,12 +199,6 @@ WRITE(6,'('' kxc1_fft,kxc2_fft,kxc3_fft,kv1,kv2,kv3 '',6i5)')& & stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,2*stars%kv3(1,istr),& & 2*stars%kv3(2,istr),2*stars%kv3(3,istr) - write(16,'('' not all nxc3_fft stars in xc-pot/eng fft box''& - & )') - WRITE(16,'('' inconsistency in def.s see also strgn1'')') - WRITE(16,'('' kxc1_fft,kxc2_fft,kxc3_fft,kv1,kv2,kv3 '',6i5)')& - & stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,2*stars%kv3(1,istr),& - & 2*stars%kv3(2,istr),2*stars%kv3(3,istr) CALL juDFT_error("2*stars([1,2,3],istr)>mxc[1,2,3]d",calledby& & ="prp_xcfft") ENDIF diff --git a/init/strgn.f90 b/init/strgn.f90 index ed48bd9dc2cac377754d6e6be97b48fc33ae0adc..c1953937e392612a431768492a8500ed26c1fdef 100644 --- a/init/strgn.f90 +++ b/init/strgn.f90 @@ -195,7 +195,6 @@ CONTAINS IF (stars%mx3.GT.stars%mx3) THEN WRITE ( 6,FMT=8000) stars%mx3,stars%mx3 - WRITE (16,FMT=8000) stars%mx3,stars%mx3 CALL juDFT_error("mx3.gt.k3d",calledby="strgn") ENDIF 8000 FORMAT(' mx3.gt.k3d:',2i6) @@ -468,9 +467,7 @@ CONTAINS ! !--> listing ! - WRITE (16,FMT=8010) stars%gmax,stars%ng3,stars%ng2 8010 FORMAT (' gmax=',f10.6,/,' nq3= ',i5,/,' nq2= ',i5,/) - WRITE (16,FMT=8020) stars%mx1,stars%mx2 8020 FORMAT (' mx1= ',i5,/,' mx2= ',i5,/) WRITE (6,FMT=8030) 8030 FORMAT (/,/,/,' s t a r l i s t',/) @@ -798,9 +795,7 @@ CONTAINS ! !--> listing - WRITE (16,FMT=8010) stars%gmax,stars%ng3 8010 FORMAT (' gmax=',f10.6,/,' nq3= ',i7,/) - WRITE (16,FMT=8020) stars%mx1,stars%mx2,stars%mx3 8020 FORMAT (' mx1= ',i5,/,' mx2= ',i5,' mx3= ',i5,/) WRITE (6,FMT=8030) 8030 FORMAT (/,/,/,' s t a r l i s t',/) diff --git a/io/CMakeLists.txt b/io/CMakeLists.txt index 65c7f32a1fe2b0e1787fdbf5f41830d952abf5e6..500c3d7bb660176bc7f5aa724834520974586526 100644 --- a/io/CMakeLists.txt +++ b/io/CMakeLists.txt @@ -2,7 +2,6 @@ set(fleur_F77 ${fleur_F77} io/calculator.f io/cdn_read.F io/rw_symfile.f -io/write_gw.F ) set(fleur_F90 ${fleur_F90} io/io_matrix.F90 diff --git a/io/write_gw.F b/io/write_gw.F deleted file mode 100644 index 07c7a5d1108c1e43ee7a7076ed81d0c99f70fbe1..0000000000000000000000000000000000000000 --- a/io/write_gw.F +++ /dev/null @@ -1,225 +0,0 @@ -!-------------------------------------------------------------------------------- -! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany -! This file is part of FLEUR and available as free software under the conditions -! of the MIT license as expressed in the LICENSE file in more detail. -!-------------------------------------------------------------------------------- - - MODULE m_writegw - CONTAINS - SUBROUTINE write_gw( - > ntype,nop,nwd,jspins,natd, - > ncst,neq,lmax,mrot,amat,bmat,rkmax, - > taual,zatom,vol,scale,neigd,lmaxd, - > nlod,llod,nlo,llo,l_soc) - - USE m_constants, ONLY : tpi_const - IMPLICIT NONE - - INTEGER, INTENT (IN) :: ntype,nop,nwd,jspins,natd,neigd,lmaxd - INTEGER, INTENT (IN) :: neq(ntype),lmax(ntype),mrot(3,3,nop) - INTEGER, INTENT (IN) :: ncst(ntype) - INTEGER, INTENT (IN) :: nlod,llod,nlo(ntype),llo(nlod,ntype) - REAL, INTENT (IN) :: vol,scale - REAL, INTENT (IN) :: amat(3,3),bmat(3,3),rkmax - REAL, INTENT (IN) :: zatom(ntype),taual(3,natd) - LOGICAL, INTENT (IN) :: l_soc - - INTEGER na,itype,i,iop,lmaxx,isp,j,lc,lsum,ll,ilo,nindx,lc_prev - INTEGER , ALLOCATABLE :: l(:,:) - REAL bbmat(3,3) - -! -! Generate input file CLASS for subsequent GW calculation -! 19.9.2003 Arno Schindlmayr -! - WRITE(6,'(A)') 'Info: Write out CLASS for GW.' - OPEN(15,file='CLASS',status='unknown',action='write') - na = 1 - DO itype = 1, ntype - DO i = 1, neq(itype) - WRITE(15,'(2(1x,i3))') na,itype - na = na + 1 - ENDDO - ENDDO - CLOSE(15) -! -! Generate input file SYMOPS for subsequent GW calculation -! 19.9.2003 Arno Schindlmayr -! - WRITE(6,'(A)') 'Info: Write out SYMOPS for GW.' - bbmat = bmat/tpi_const - OPEN(15,file='SYMOPS',status='unknown',action='write') - WRITE(15,*) nop - DO iop = 1, nop - WRITE(15,*) iop - DO i = 1, 3 - WRITE(15,*) MATMUL(amat(i,:),MATMUL(mrot(:,:,iop),bbmat)) - ENDDO - ENDDO - CLOSE(15) -! -! Generate input file LATTC for subsequent GW calculation -! 22.9.2003 Arno Schindlmayr -! - WRITE(6,'(A)') 'Info: Write out LATTC for GW.' - OPEN(15,file='LATTC',status='unknown',action='write') - WRITE(15,'(e24.16)') scale - WRITE(15,'(3e24.16)') amat(:,:)/scale - WRITE(15,'(e24.16)') rkmax - WRITE(15,*) ' ------------------------------------------- ' - lmaxx = MAXVAL(lmax(1:ntype)) - ALLOCATE (l(0:lmaxx,ntype)) - WRITE(15,'(2i4," ! nbas lmxamx (max l for augmentation)")') - & sum(neq(1:ntype)),lmaxx - WRITE(15,*) ' ------------------------------------------- ' - DO isp = 1, jspins - WRITE(15,'(" -- ibas lmxa konf(s) konf(p) konf(d)... ", - & " isp=",i2)') isp - na = 1 - DO itype = 1, ntype - DO i = 0, lmax(itype) - l(i,itype) = i+1 - ENDDO - SELECT CASE (ncst(itype)) - CASE (0) - CONTINUE - CASE (1) - l(0,itype) = 2 - CASE (2) - l(0,itype) = 3 - CASE (4) - l(0:1,itype) = (/3,3/) - CASE (5) - l(0:1,itype) = (/4,3/) - CASE (7) - l(0:1,itype) = (/4,4/) - CASE (9) - l(0:2,itype) = (/4,4,4/) - CASE (10) - l(0:2,itype) = (/5,4,4/) - CASE (12) - l(0:2,itype) = (/5,5,4/) - CASE (14) - l(0:2,itype) = (/5,5,5/) - CASE (15) - l(0:2,itype) = (/6,5,5/) - CASE (17) - l(0:2,itype) = (/6,6,5/) - CASE (19) - l(0:3,itype) = (/6,6,5,5/) - CASE (21) - l(0:3,itype) = (/6,6,6,5/) - CASE (22) - l(0:3,itype) = (/7,6,6,5/) - CASE (24) - l(0:3,itype) = (/7,7,6,5/) - CASE (26) - l(0:3,itype) = (/7,7,6,6/) - CASE DEFAULT - l(:,itype) = 0 - END SELECT - DO i = 1, neq(itype) - IF (l(0,itype).GT.0) THEN - WRITE(15,'(3x,99i4)') na,lmax(itype), - & l(0:lmax(itype),itype) - ELSE - WRITE(15,'(3x,2i4,3x,a)') na,lmax(itype), - & 'WARNING: Unrecognized number of core levels!' - ENDIF - na = na + 1 - ENDDO - ENDDO - ENDDO - CLOSE(15) -c do i=1,ntype -c write(*,*) ncst(i),sum(l(0:lmax(i),i))-(lmaxx+1)*(lmaxx+2)/2 -c enddo -! -! Generate input file NLAindx for subsequent GW calculation -! 29.9.2003 Arno Schindlmayr -! - WRITE(6,'(A)') 'Info: Write out NLAindx for GW.' - OPEN(15,file='NLAindx',status='unknown',action='write') - WRITE(15,'(a)') '----NLAindx start---------------' - lsum = 0 - DO itype = 1, ntype - lsum = lsum + neq(itype)*2*(lmax(itype)+1)**2 - DO j = 1, nlo(itype) - lsum = lsum + neq(itype)*(2*llo(j,itype)+1) - ENDDO - ENDDO - WRITE(15,'(i6)') lsum - lsum = 0 - DO j = 1, 2 - na = 0 - DO itype = 1, ntype - DO i = 1, neq(itype) - na = na + 1 - DO lc = 0, lmax(itype) - ll=l(lc,itype) - DO ilo = 1, nlo(itype) ! Here, LOs are assumed to represent lowest valence states. - IF(llo(ilo,itype).eq.lc) ll=ll+1 ! states. This only concerns the basis function label - ENDDO ! at the end of each line which is not read in. - WRITE(15,'(i6,i3,i4,i6,3x,i2,a)') j,lc,na,lsum, - & ll,'SPDFGHIJKLMNO'(lc+1:lc+1)//'_'//'pd'(j:j) - lsum = lsum + 2*lc+1 - ENDDO - ENDDO - ENDDO - ENDDO - ! now for the local orbitals - na = 0 - DO itype = 1, ntype - DO i = 1, neq(itype) - lc_prev = -1 - DO j = 1, nlo(itype) - lc=llo(j,itype) - IF(lc.eq.lc_prev) THEN - nindx=nindx+1 - ELSE - nindx=3 - ENDIF - WRITE(15,'(i6,i3,i4,i6,3x,i2,a)') nindx,lc,na+i,lsum, - & l(lc,itype),'SPDFGHIJKLMNO'(lc+1:lc+1)//'_'//'l' - lsum = lsum + 2*lc+1 - lc_prev = lc - ENDDO - ENDDO - na = na + neq(itype) - ENDDO - ! - CLOSE(15) -! -! Generate input file gwa for subsequent GW calculation -! 10.10.2003 Arno Schindlmayr -! - WRITE(6,'(A)') 'Info: Write out gwa for GW.' - OPEN(15,file='gwa',status='unknown',action='write', - & form='unformatted') - WRITE(15) jspins, ! nsp - & na, ! nbas - & ntype, ! nclass - & lmaxx, ! lmxamx - & nlod - WRITE(15) ((itype,i=1,neq(itype)),itype=1,ntype), ! iclass - & lmax(1:ntype), ! lmxa - & l(0:lmaxx,1:ntype), ! konf - & zatom(1:ntype), ! zz - & taual(:,1:na), ! bas - & scale, ! alat - & amat, ! plat - & vol,neigd,lmaxd, - & nlo(1:ntype),(llo(1:nlo(i),i),i=1,ntype) - WRITE(15) -#ifdef CPP_INVERSION - & .true., -#else - & .false., -#endif - & l_soc - CLOSE(15) ! Subroutine eigen will append an additional record to gwa if gw=2. - DEALLOCATE (l) - - - END SUBROUTINE write_gw - END MODULE m_writegw diff --git a/juDFT/init.F90 b/juDFT/init.F90 index ef189eb399dd519eb5b66ddc749d753997d2bd6a..d50224e5d51e2d5aa0c3914780ac643c0dfda9d1 100644 --- a/juDFT/init.F90 +++ b/juDFT/init.F90 @@ -49,18 +49,18 @@ INTEGER:: irank,ierr CALL MPI_COMM_RANK (MPI_COMM_WORLD,irank,ierr) - WRITE(*,*) "Signal ",signal," detected on PE:",irank + WRITE(0,*) "Signal ",signal," detected on PE:",irank #else - WRITE(*,*) "Signal detected:",signal + WRITE(0,*) "Signal detected:",signal #endif - WRITE(*,*) "This might be due to either:" - WRITE(*,*) " - A bug in FLEUR" - WRITE(*,*) " - Your job running out of memory" - WRITE(*,*) " - Your job got killed externally (e.g. no cpu-time left)" - WRITE(*,*) " - ...." - WRITE(*,*) "Please check and report if you believe you found a bug" + WRITE(0,*) "This might be due to either:" + WRITE(0,*) " - A bug" + WRITE(0,*) " - Your job running out of memory" + WRITE(0,*) " - Your job got killed externally (e.g. no cpu-time left)" + WRITE(0,*) " - ...." + WRITE(0,*) "Please check and report if you believe you found a bug" CALL writetimes() - CALL PRINT_memory_info() + CALL PRINT_memory_info(0,.true.) #ifdef CPP_MPI CALL MPI_ABORT(MPI_COMM_WORLD,ierr) #endif diff --git a/juDFT/stop.F90 b/juDFT/stop.F90 index 196d3569890baec3b7e5f38286cd5513608f3b36..524cca5a3f8f2599dd3f62b49d3c50020a9e2f1a 100644 --- a/juDFT/stop.F90 +++ b/juDFT/stop.F90 @@ -45,11 +45,12 @@ CONTAINS LOGICAL :: l_exist INQUIRE(file=filename,exist=l_exist) - IF (.not.l_exist) CALL judft_error("File not readable:"//filename,hint="FLEUR wants to read a file that is not present",warning=warning) + IF (.not.l_exist) CALL judft_error("File not readable:"//filename,hint="You tried to read a file that is not present",warning=warning) END SUBROUTINE judfT_file_readable SUBROUTINE juDFT_error(message,calledby,hint,no,warning,file,line) USE m_judft_usage + USE m_xmloutput IMPLICIT NONE CHARACTER*(*),INTENT(IN) :: message CHARACTER*(*),OPTIONAL,INTENT(IN) :: calledby,hint @@ -58,18 +59,18 @@ CONTAINS CHARACTER*(*),OPTIONAL,INTENT(IN) :: file INTEGER,INTENT(IN),OPTIONAL :: line - LOGICAL :: callstop,warn - CHARACTER(LEN=4)::PE - !store all output in variable for single call to write in MPI case - CHARACTER(len=300)::text(10) - INTEGER ::linenr,n + LOGICAL :: callstop,warn,first_pe + INTEGER :: isize,irank,e,i + CHARACTER(len=100),ALLOCATABLE::message_list(:) #ifdef CPP_MPI include 'mpif.h' - INTEGER :: irank,e + LOGICAL :: first_parallel CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,e) - WRITE(PE,"(i4)") irank + CALL MPI_COMM_SIZE(MPI_COMM_WORLD,isize,e) #else - PE=" ****" + first_pe=.TRUE. + isize=1 + irank=0 #endif warn = .FALSE. IF (PRESENT(warning)) warn = warning @@ -79,60 +80,83 @@ CONTAINS callstop=.false. ELSE INQUIRE(FILE ="JUDFT_WARN_ONLY",EXIST= callstop) - callstop = .NOT.callstop ENDIF ELSE callstop = .TRUE. ENDIF - IF (.NOT.warn) THEN - WRITE(text(1),*) PE,"**************juDFT-Error*****************" - ELSE - WRITE(text(1),*) PE,"************juDFT-Warning*****************" - ENDIF - WRITE(text(2),"(3a)") PE,"Error message:",message - linenr=3 - IF (PRESENT(calledby)) THEN - WRITE(text(3),"(3a)") PE,"Error occurred in subroutine:",calledby - linenr=4 - ENDIF - IF (PRESENT(hint)) THEN - WRITE(text(linenr),"(3a)") PE,"Hint:",hint - linenr=linenr+1 - ENDIF - IF (PRESENT(no)) THEN - WRITE(text(linenr),"(2a,i0)") PE,"Error number:",no - linenr=linenr+1 - ENDIF - IF (present(file)) THEN - if (present(line)) THEN - write(text(linenr),"(4a,i0)") PE,"Source:",file,":",line +#ifdef CPP_MPI + CALL collect_messages(message,message_list,first_pe) +#endif + + IF (first_pe) THEN + IF (.NOT.warn) THEN + WRITE(0,'(a)') "**************juDFT-Error*****************" ELSE - write(text(linenr),"(3a)") PE,"Source:",file + WRITE(0,'(a)') "************juDFT-Warning*****************" + ENDIF + WRITE(0,"(3a)") "Error message:",message + IF (PRESENT(calledby)) THEN + WRITE(0,"(3a)") "Error occurred in subroutine:",calledby + ENDIF + IF (PRESENT(hint)) THEN + WRITE(0,"(3a)") "Hint:",hint + ENDIF + IF (PRESENT(no)) THEN + WRITE(0,"(1a,i0)") "Error number:",no ENDIF - linenr=linenr+1 + IF (PRESENT(file)) THEN + IF (PRESENT(line)) THEN + WRITE(0,"(3a,i0)") "Source:",file,":",line + ELSE + WRITE(0,"(3a)") "Source:",file + ENDIF + ENDIF +#ifdef CPP_MPI + WRITE(0,'(a,i0,a,i0)') "Error from PE:",irank,"/",isize + first_parallel=.TRUE. + DO i=0,isize-1 + IF (i==irank) CYCLE + IF (LEN_TRIM(message_list(i))>1)THEN + IF (first_parallel) THEN + WRITE(0,'(2a)') "Other PEs with error messages:" + first_parallel=.FALSE. + END IF + WRITE(0,'(a,i4,2a)') " ",i,"-",message_list(i) + END IF + END DO +#endif + WRITE(0,'(2a)') "*****************************************" + + IF (.NOT.warn) CALL juDFT_time_lastlocation() + IF (callstop.and.warn) WRITE(0,'(a)')"Warnings not ignored. Touch 'JUDFT_WARN_ONLY' to make the warning nonfatal" + IF (callstop) THEN + CALL writetimes() + CALL print_memory_info(0,.TRUE.) + IF (irank==0) THEN + !Error on PE0 write info to out and out.xml + WRITE(6,*) "***************ERROR***************" + WRITE(6,*) message + WRITE(6,*) "***************ERROR***************" + CALL writeXMLElement('ERROR',(/"Message"/),(/message/)) + !try closing the out file + CLOSE(6,iostat=e) + !Try closing the xml-out + CALL endXMLOutput() + ENDIF + END IF + ELSE + CALL priv_wait(2.0) ENDIF - WRITE(text(linenr),*) PE,"*****************************************" - - if (.not.warn) CALL juDFT_time_lastlocation(PE) IF (callstop) THEN - IF (warn) THEN - linenr=linenr+1 - WRITE(text(linenr),'(a)')"Warnings not ignored. Touch 'JUDFT_WARN_ONLY' to make the warning nonfatal" - ENDIF - WRITE(0,*) - WRITE(0,"(10(a,/))") (TRIM(text(n)),n=1,linenr) - CALL add_usage_data("Error",message) !$OMP MASTER CALL send_usage_data() !$OMP END MASTER CALL juDFT_STOP() ENDIF - WRITE(0,*) - write(0,"(10(a,/))") (trim(text(n)),n=1,linenr) END SUBROUTINE juDFT_error SUBROUTINE juDFT_warn(message,calledby,hint,no,file,line) @@ -184,7 +208,7 @@ CONTAINS WRITE(0,*) " ",message WRITE(0,*) "*****************************************" CALL writetimes() - CALL print_memory_info() + CALL print_memory_info(0,.true.) CALL send_usage_data() #ifdef CPP_MPI IF(PRESENT(irank)) THEN @@ -209,7 +233,7 @@ CONTAINS INTEGER, OPTIONAL, INTENT(IN) :: errorCode INTEGER :: error LOGICAL :: calltrace - LOGICAL,ALLOCATABLE:: a(:) + LOGICAL,ALLOCATABLE::a(:) #ifdef CPP_MPI INTEGER :: ierr #endif @@ -218,10 +242,7 @@ CONTAINS IF(PRESENT(errorCode)) THEN error = errorCode END IF - !try to print times - call writelocation() - CALL writetimes(.TRUE.) - CALL print_memory_info() + !Now try to generate a stack-trace if requested INQUIRE(FILE="JUDFT_TRACE",EXIST=calltrace) IF (judft_was_argument("-trace")) calltrace=.TRUE. IF (error.EQ.1) calltrace = .TRUE. @@ -248,6 +269,59 @@ CONTAINS END SUBROUTINE juDFT_stop +#ifdef CPP_MPI + SUBROUTINE collect_messages(mymessage,message_list,first_pe) + !This routine collects all error messages from all PE into an array + !As not all PE might call this routine we use non-blocking communication + !The integer first_pe is true if this pe is the one with the lowest rank among + !all having error messages to report + IMPLICIT NONE + CHARACTER(len=*),INTENT(IN) :: mymessage + CHARACTER(len=100),ASYNCHRONOUS,ALLOCATABLE,INTENT(OUT) :: message_list(:) + LOGICAL,INTENT(OUT) :: first_pe + INCLUDE 'mpif.h' + INTEGER:: irank,isize,ierr,i + LOGICAL:: completed + INTEGER,ALLOCATABLE::ihandle(:) + CHARACTER(len=100):: message + REAL :: t1,t2 + + message=mymessage + + CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr) + CALL MPI_COMM_SIZE(MPI_COMM_WORLD,isize,ierr) + ALLOCATE(message_list(0:isize-1)) + ALLOCATE(ihandle(0:isize-1)) + message_list="" + !Announce that I have a message to all PE + DO i=0,isize-1 + CALL MPI_ibsend(message,100,MPI_CHARACTER,i,999,MPI_COMM_WORLD,ihandle(0),ierr) + ENDDO + !Collect all message + DO i=0,isize-1 + CALL MPI_irecv(message_list(i),100,MPI_CHARACTER,i,999,MPI_COMM_WORLD,ihandle(i),ierr) + ENDDO + !Wait for 2 seconds + CALL priv_wait(2.0) + !Check if any PE with a lower rank also reports an error + first_pe=.TRUE. + DO i=0,isize-1 + CALL MPI_TEST(ihandle(i),completed,MPI_STATUS_IGNORE,ierr) + IF (i0) THEN + memory_usage_string=TRIM(memory_usage_string)//"/"//TRIM(ADJUSTL(line(8:))) + CLOSE(544) + RETURN + ENDIF + ENDDO + CLOSE(544) + END IF + END IF + END IF + END FUNCTION memory_usage_string - SUBROUTINE checkstack() - CHARACTER(LEN=10):: l1,l2,l3,l4 - INTEGER :: err - LOGICAL :: unlimited - unlimited=.TRUE. !set to true by default. - !If /proc/self/limits does not exist - !or parsing fails no warning is issued - OPEN(99,FILE="/proc/self/limits",ERR=999) - DO - READ(99,*,ERR=999,END=999) l1,l2,l3,l4 - IF (ALL((/INDEX(l1,"Max"),INDEX(l2,"stack"),INDEX(l3,"size")/)==1)) THEN - unlimited=INDEX(l4,"unlim")==1 - ENDIF - ENDDO -999 CLOSE(99,IOSTAT=err) - IF (.NOT.unlimited) THEN - WRITE(*,*) "*********** WARNING! ************" - WRITE(*,*) "Your stacksize seems to be small" - WRITE(*,*) "FLEUR might crash without further" + SUBROUTINE checkstack() + CHARACTER(LEN=10):: l1,l2,l3,l4 + INTEGER :: err + LOGICAL :: unlimited +#ifdef CPP_MPI + include 'mpif.h' + INTEGER:: ierr,irank +#endif + unlimited=.TRUE. !set to true by default. + !If /proc/self/limits does not exist + !or parsing fails no warning is issued + OPEN(99,FILE="/proc/self/limits",ERR=999) + DO + READ(99,*,ERR=999,END=999) l1,l2,l3,l4 + IF (ALL((/INDEX(l1,"Max"),INDEX(l2,"stack"),INDEX(l3,"size")/)==1)) THEN + unlimited=INDEX(l4,"unlim")==1 + ENDIF + ENDDO +999 CLOSE(99,IOSTAT=err) +#ifdef CPP_MPI + CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr) + IF (irank.NE.0) THEN + IF (.NOT.unlimited) WRITE(*,*)"Warning, stacksize limited at PE:",irank + RETURN + ENDIF +#endif + IF (.NOT.unlimited) THEN + WRITE(*,*) "*********** WARNING! ************" + WRITE(*,*) "Your stacksize seems to be small" + WRITE(*,*) "FLEUR might crash without further" WRITE(*,*) "notice. Try 'ulimit -s unlimited'" WRITE(*,*) "*********** WARNING! ************" ENDIF diff --git a/juDFT/time.F90 b/juDFT/time.F90 index a7da8fa72e99a6bdd42a319c197beec0e1b66b7d..e7ba4cf5e49dbe14fcead3c6e54692eb3d7efec8 100644 --- a/juDFT/time.F90 +++ b/juDFT/time.F90 @@ -26,7 +26,8 @@ MODULE m_juDFT_time TYPE t_timer REAL :: starttime - REAL :: time + REAL :: time,mintime,maxtime + INTEGER :: no_calls CHARACTER(LEN=60) :: name INTEGER :: n_subtimers TYPE(t_p),ALLOCATABLE :: subtimer(:) @@ -38,9 +39,9 @@ MODULE m_juDFT_time CHARACTER(LEN=256),SAVE :: lastfile="" INTEGER ,SAVE :: lastline=0 - PUBLIC timestart,timestop,writetimes,writelocation,writeTimesXML + PUBLIC timestart,timestop,writetimes,writeTimesXML PUBLIC resetIterationDependentTimers,check_time_for_next_iteration - PUBLIC juDFT_time_lastlocation !should not be used + PUBLIC juDFT_time_lastlocation !should be used for error handling only CONTAINS @@ -49,9 +50,6 @@ CONTAINS SUBROUTINE priv_new_timer(name) IMPLICIT NONE CHARACTER(LEN=*),INTENT(IN) ::name - - - TYPE(t_timer),POINTER ::t TYPE(t_p),ALLOCATABLE :: tmp(:) @@ -59,6 +57,9 @@ CONTAINS ALLOCATE(t) t%starttime=cputime() t%time=0.0 + t%mintime=1E99 + t%maxtime=0.0 + t%no_calls=0 t%name=name t%n_subtimers=0 t%parenttimer=>null() @@ -131,6 +132,8 @@ CONTAINS SUBROUTINE timestop(ttimer) CHARACTER(LEN =*),INTENT(IN) :: ttimer + REAL::time + IF (.NOT.TRIM(ttimer)==TRIM(current_timer%name)) THEN WRITE(*,*)"Current timer:",current_timer%name," could not stop:",ttimer STOP "BUG:timestop" @@ -139,7 +142,11 @@ CONTAINS WRITE(*,*) "Timer not initialized:"//ttimer STOP "BUG:timestop" ENDIF - current_timer%time=current_timer%time+cputime()-current_timer%starttime + time=cputime()-current_timer%starttime !This runtime + current_timer%time=current_timer%time+time + current_timer%no_calls=current_timer%no_calls+1 + current_timer%mintime=MIN(current_timer%mintime,time) + current_timer%maxtime=MAX(current_timer%maxtime,time) current_timer%starttime=-1 CALL priv_debug_output(" stopped ",current_timer%name) @@ -168,7 +175,7 @@ CONTAINS RECURSIVE SUBROUTINE priv_writetimes_longest(timer,fid,timernames,timertimes) IMPLICIT NONE - TYPE(t_timer),INTENT(IN) :: timer + TYPE(t_timer),INTENT(IN) :: timer INTEGER,INTENT(IN),OPTIONAL :: fid CHARACTER(LEN=60),INTENT(INOUT),OPTIONAL ::timernames(10) REAL,INTENT(INOUT),OPTIONAL ::timertimes(10) @@ -236,8 +243,12 @@ CONTAINS time=timer%time timername=timer%name ENDIF - IF (time1) THEN + WRITE(fid,"(a,T7,a,T46,a,T85,a,i0,a,f9.0,a,f9.0,a)") TRIM(indentstring),TRIM(timername),TRIM(timestring(time,globaltimer%time,level)),"(",timer%no_calls,"calls:",timer%mintime,"sec -",timer%maxtime,"sec)" + ELSE + WRITE(fid,"(a,T7,a,T46,a)") TRIM(indentstring),TRIM(timername),timestring(time,globaltimer%time,level) + END IF FLUSH(fid) IF (PRESENT(debug).OR.timer%n_subtimers==0) RETURN @@ -245,7 +256,7 @@ CONTAINS DO n=1,timer%n_subtimers time=time+timer%subtimer(n)%p%time ENDDO - WRITE(fid,"(a,a,T46,a)") TRIM(indentstring)," measured in submodules:",timestring(time,-.1,level) + WRITE(fid,"(a,a,T46,3a)") TRIM(indentstring)," measured in submodules:",TRIM(timestring(time,-.1,level)) FLUSH(fid) DO n=1,timer%n_subtimers CALL priv_writetimes(timer%subtimer(n)%p,level+1,fid) @@ -263,7 +274,7 @@ CONTAINS IF (.NOT.PRESENT(location)) THEN IF (ASSOCIATED(current_timer)) CALL writelocation(current_timer) ELSE - WRITE(*,*) "Timer:",location%name + WRITE(0,*) "Timer:",location%name IF (ASSOCIATED(location%parenttimer)) CALL writelocation(location%parenttimer) ENDIF END SUBROUTINE writelocation @@ -292,11 +303,7 @@ CONTAINS fn=2 OPEN(2,FILE ='juDFT_times',STATUS="replace") ENDIF - !Stop globaltimer if still running - IF (globaltimer%starttime>-1) THEN - globaltimer%time=cputime()-globaltimer%starttime - globaltimer%starttime=-1 - ENDIF + globaltimer%time=cputime()-globaltimer%starttime WRITE(fn,"('Total execution time: ',i0,'sec')") INT(globaltimer%time) CALL add_usage_data("Runtime",globaltimer%time) CALL priv_writetimes_longest(globaltimer,fid=fn) @@ -515,22 +522,17 @@ CONTAINS ! .. Local Scalars .. REAL :: rest,seconds INTEGER :: ihours,iminutes - CHARACTER(LEN=90)::formatstring - rest = time + rest = time ihours = INT(rest/3600.0) rest = rest - REAL(ihours)*3600 - iminutes = INT(rest/60.0) seconds = rest - REAL(iminutes)*60 IF (ttime<0) THEN - formatstring="(f9.2,'sec = ',i3,'h ',i2,'min ',i2,'sec')" - WRITE (timestring,FMT = formatstring) time,ihours,iminutes,INT(seconds) + WRITE (timestring,"(f9.2,'sec= ',i3,'h ',i2,'min ',i2,'sec')") time,ihours,iminutes,INT(seconds) ELSE - WRITE(formatstring,"(a,i0,a)") "(f9.2,'sec= ',i3,'h ',i2,'min ',i2,'sec ->',",(2*level-1),"x,f5.1,'%')" - WRITE (timestring,FMT = formatstring) time,ihours,iminutes,INT(seconds),time/ttime*100.0 + WRITE (timestring,"(f9.2,'sec= ',i3,'h ',i2,'min ',i2,'sec ->',1x,f5.1,'%')") time,ihours,iminutes,INT(seconds),time/ttime*100.0 ENDIF - END FUNCTION timestring !> @@ -560,13 +562,19 @@ CONTAINS #endif END FUNCTION cputime !> - SUBROUTINE juDFT_time_lastlocation(PE) - CHARACTER(LEN=4),INTENT(IN):: PE - IF (lastline>0) THEN - WRITE(0,*) PE,"Last kown location:" - WRITE(0,*) PE,"File:",TRIM(lastfile),":",lastline - WRITE(0,*) PE,"*****************************************" - ENDIF + SUBROUTINE juDFT_time_lastlocation() + IF (ASSOCIATED(current_timer)) THEN + WRITE(0,*) "Last kown location:" + WRITE(0,*) "Last timer:",current_timer%name + IF (lastline>0) THEN + WRITE(0,*) "File:",TRIM(lastfile),":",lastline + ENDIF + IF (ASSOCIATED(current_timer%parenttimer)) THEN + WRITE(0,*) "Timerstack:" + CALL writelocation(current_timer%parenttimer) + ENDIF + WRITE(0,*) "*****************************************" + END IF END SUBROUTINE juDFT_time_lastlocation END MODULE m_juDFT_time diff --git a/main/fleur.F90 b/main/fleur.F90 index cf6341c9f00df6ad5a54d5bc9574a4fbc3332849..6a3b6ac27c921afff52f6cfd7511d2c0203cfb73 100644 --- a/main/fleur.F90 +++ b/main/fleur.F90 @@ -186,11 +186,10 @@ CONTAINS !!$ input%alpha = input%alpha - NINT(input%alpha) !!$ END IF - CALL resetIterationDependentTimers() + !CALL resetIterationDependentTimers() CALL timestart("Iteration") IF (mpi%irank.EQ.0) THEN WRITE (6,FMT=8100) iter - WRITE (16,FMT=8100) iter 8100 FORMAT (/,10x,' iter= ',i5) ENDIF !mpi%irank.eq.0 input%total = .TRUE. @@ -422,7 +421,6 @@ CONTAINS IF(mpi%irank == 0) THEN WRITE (6,FMT=8130) iter - WRITE (16,FMT=8130) iter 8130 FORMAT (/,5x,'******* it=',i3,' is completed********',/,/) WRITE(*,*) "Iteration:",iter," Distance:",results%last_distance CALL timestop("Iteration") @@ -452,7 +450,7 @@ CONTAINS CALL check_time_for_next_iteration(iter,l_cont) END IF - CALL writeTimesXML() + !CALL writeTimesXML() IF ((mpi%irank.EQ.0).AND.(isCurrentXMLElement("iteration"))) THEN CALL closeXMLElement('iteration') diff --git a/main/fleur_init.F90 b/main/fleur_init.F90 index 3ad22d9541f5a6d7589b73bf59de0951b7f67f1c..a6cf92cc42dd35508deab57d3e49c81cec984824 100644 --- a/main/fleur_init.F90 +++ b/main/fleur_init.F90 @@ -126,11 +126,7 @@ OPEN (6,file='out',form='formatted',status='unknown') ENDIF CALL writeOutHeader() - IF (judft_was_argument("-info")) THEN - OPEN (16,status='SCRATCH') - ELSE - OPEN (16,file='inf',form='formatted',status='unknown') - ENDIF + !OPEN (16,status='SCRATCH') ENDIF input%l_wann = .FALSE. diff --git a/main/fleur_job.F90 b/main/fleur_job.F90 index 2266c25336ca63524df90f72cc2cb0a5af39a632..5a2c020b015138aad31f03f71bb18aede7a2ed8c 100644 --- a/main/fleur_job.F90 +++ b/main/fleur_job.F90 @@ -135,6 +135,7 @@ CONTAINS INCLUDE 'mpif.h' INTEGER ierr(3), i CALL MPI_INIT_THREAD(MPI_THREAD_SERIALIZED,i,ierr) + CALL judft_init() CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr) IF(irank.EQ.0) THEN !$ IF (i sum of eigenvalues (core, semicore and valence states) @@ -92,29 +91,25 @@ CONTAINS eigSum = results%seigscv + results%seigc results%tote = eigSum WRITE (6,FMT=8010) results%tote - WRITE (16,FMT=8010) results%tote 8010 FORMAT (/,10x,'sum of eigenvalues =',t40,f20.10) ! ! ---> add contribution of coulomb potential ! results%tote = results%tote + 0.5e0*results%te_vcoul WRITE (6,FMT=8020) results%te_vcoul - WRITE (16,FMT=8020) results%te_vcoul 8020 FORMAT (/,10x,'density-coulomb potential integral =',t40,f20.10) ! ! ---> add contribution of effective potential ! results%tote = results%tote - results%te_veff WRITE (6,FMT=8030) results%te_veff - WRITE (16,FMT=8030) results%te_veff 8030 FORMAT (/,10x,'density-effective potential integral =',t40,f20.10) ! ! ---> add contribution of exchange-correlation energy ! results%tote = results%tote + results%te_exc WRITE (6,FMT=8040) results%te_exc - WRITE (16,FMT=8040) results%te_exc -8040 FORMAT (/,10x,'charge density-ex.-corr.energy density integral=', t40,ES20.10) +8040 FORMAT (/,10x,'charge density-ex.-corr.energy density integral=', t40,f20.10) ! ! ---> Fock exchange contribution ! @@ -126,9 +121,7 @@ CONTAINS !END IF ENDIF WRITE (6,FMT=8100) 0.5e0*results%te_hfex%valence - WRITE (16,FMT=8100) 0.5e0*results%te_hfex%valence WRITE (6,FMT=8101) 0.5e0*results%te_hfex%core - WRITE (16,FMT=8101) 0.5e0*results%te_hfex%core 8100 FORMAT (/,10x,'Fock-exchange energy (valence)=',t40,f20.10) 8101 FORMAT (10x,'Fock-exchange energy (core)=',t40,f20.10) @@ -175,26 +168,21 @@ CONTAINS ! zintn_r(n) = atoms%neq(n)*atoms%zatom(n)*sfp_const*rhs/2. WRITE (6,FMT=8045) zintn_r(n) - WRITE (16,FMT=8045) zintn_r(n) CALL intgr3(mt(1,n),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),totz) vmd(n) = atoms%rmt(n)*vCoul%mt(atoms%jri(n),0,n,1)/sfp_const + atoms%zatom(n) - totz*sfp_const vmd(n) = -atoms%neq(n)*atoms%zatom(n)*vmd(n)/ (2.*atoms%rmt(n)) WRITE (6,FMT=8050) n,vmd(n) - WRITE (16,FMT=8050) n,vmd(n) results%tote = results%tote + vmd(n) ENDDO IF (atoms%n_u.GT.0) THEN WRITE ( 6,FMT=8090) results%e_ldau - WRITE (16,FMT=8090) results%e_ldau results%tote = results%tote - results%e_ldau ! gu test ENDIF ! print 'HF' before total energy to make it grepable IF ( .NOT. hybrid%l_calhf ) THEN WRITE ( 6,FMT=8060) results%tote - WRITE (16,FMT=8060) results%tote ELSE WRITE ( 6,FMT=8061) results%tote - WRITE (16,FMT=8061) results%tote END IF CALL force_w(input,atoms,sym,results,cell,oneD,vacuum) @@ -205,18 +193,12 @@ CONTAINS ! print 'HF' before all energies to make them grepable IF ( .NOT. hybrid%l_calhf ) THEN WRITE ( 6,FMT=8065) results%ts - WRITE (16,FMT=8065) results%ts WRITE ( 6,FMT=8070) results%tote-results%ts - WRITE (16,FMT=8070) results%tote-results%ts WRITE ( 6,FMT=8080) results%tote-0.5e0*results%ts - WRITE (16,FMT=8080) results%tote-0.5e0*results%ts ELSE WRITE ( 6,FMT=8066) results%ts - WRITE (16,FMT=8066) results%ts WRITE ( 6,FMT=8071) results%tote-results%ts - WRITE (16,FMT=8071) results%tote-results%ts WRITE ( 6,FMT=8081) results%tote-0.5e0*results%ts - WRITE (16,FMT=8081) results%tote-0.5e0*results%ts END IF WRITE(attributes(1),'(f20.10)') results%tote diff --git a/mix/potdis.f90 b/mix/potdis.f90 index f6602f3e26d1f2cb2c079de31746dcee81158778..5c6bf4865dad2042e112a907687c4beb86d97608 100644 --- a/mix/potdis.f90 +++ b/mix/potdis.f90 @@ -221,7 +221,6 @@ CONTAINS dis(:) = SQRT(dis(:)/cell%vol)*1000. WRITE (6,FMT=8000) iter,dis(1) - WRITE (16,FMT=8000) iter,dis(1) 8000 FORMAT (/,'----> distance of the potential for it=',i3,':',f11.6, ' mhtr/bohr**3') WRITE(6,*) "Details of potential differences for each atom type" WRITE(6,*) "Atom: total difference: difference of first sphhar" @@ -231,7 +230,6 @@ CONTAINS WRITE(6,*) "Difference of interstitial:",pdis(0,0,1) IF (input%jspins.EQ.2) THEN WRITE (6,FMT=8010) iter,dis(2) - WRITE (16,FMT=8010) iter,dis(2) 8010 FORMAT (/,'----> distance of spin potential for it=',i3,':', f11.6,' mhtr/bohr**3') WRITE(6,*) "Details of potential differences for each atom type" WRITE(6,*) "Atom: total difference: difference of first sphhar" diff --git a/mix/stdmix.f90 b/mix/stdmix.f90 index 2be6037b28631f33698b7f56b85a1bc8c13227c5..5753af965591801569aab32be856503bf423739f 100644 --- a/mix/stdmix.f90 +++ b/mix/stdmix.f90 @@ -34,10 +34,10 @@ CONTAINS REAL,PARAMETER:: tol_6=1.0e-6 ! .. ! - WRITE (16,FMT='(a)') 'STRAIGHT MIXING' - IF (input%jspins.EQ.1) WRITE (16,FMT='(a,2f10.5)')& + WRITE (6,FMT='(a)') 'STRAIGHT MIXING' + IF (input%jspins.EQ.1) WRITE (6,FMT='(a,2f10.5)')& & 'charge density mixing parameter:',input%alpha - IF (input%jspins.EQ.2) WRITE (16,FMT='(a,2f10.5)')& + IF (input%jspins.EQ.2) WRITE (6,FMT='(a,2f10.5)')& & 'spin density mixing parameter:',input%alpha*input%spinf IF ( ABS(input%spinf-1.0e0).LE.tol_6 .OR. input%jspins.EQ.1 ) THEN ! --> perform simple mixing diff --git a/optional/cdnsp.f90 b/optional/cdnsp.f90 index 936768e45d1a7bb73b51b991a48c1096c0831595..f38b2966e457630b38ce9dc7e5d467399f85a7a5 100644 --- a/optional/cdnsp.f90 +++ b/optional/cdnsp.f90 @@ -72,7 +72,6 @@ DO j = 1,atoms%jri(n) den%mt(j,0,n,1) = den%mt(j,0,n,1) - rhoc(j,n,1)/sfp ENDDO - ! WRITE (16,FMT='(8f10.4)') (den%mt(i,0,n,1),i=1,16) CALL intgr3(den%mt(1,0,n,1),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qval) p = (atoms%bmu(n)+sfp*qval)/ (2.*sfp*qval) pp = 1. - p diff --git a/types/types_cdnval.f90 b/types/types_cdnval.f90 index 340d895caa94981c8bd93d478aacea104cd6701c..7ba6bb12ab0f2b94511ef7cf946a59b480bb3b0e 100644 --- a/types/types_cdnval.f90 +++ b/types/types_cdnval.f90 @@ -516,13 +516,13 @@ SUBROUTINE cdnvalJob_init(thisCdnvalJob,mpi,input,kpts,noco,results,jspin,slicep IF (sliceplot%slice.AND.thisCdnvalJob%noccbd(ikpt).GT.0) THEN thisCdnvalJob%nStart(ikpt) = 1 thisCdnvalJob%nEnd(ikpt) = -1 - IF (mpi%irank==0) WRITE (16,FMT=*) 'NNNE',sliceplot%nnne - IF (mpi%irank==0) WRITE (16,FMT=*) 'sliceplot%kk',sliceplot%kk + IF (mpi%irank==0) WRITE (6,FMT=*) 'NNNE',sliceplot%nnne + IF (mpi%irank==0) WRITE (6,FMT=*) 'sliceplot%kk',sliceplot%kk nslibd = 0 IF (sliceplot%kk.EQ.0) THEN IF (mpi%irank==0) THEN - WRITE (16,FMT='(a)') 'ALL K-POINTS ARE TAKEN IN SLICE' - WRITE (16,FMT='(a,i2)') ' sliceplot%slice: k-point nr.',ikpt + WRITE (6,FMT='(a)') 'ALL K-POINTS ARE TAKEN IN SLICE' + WRITE (6,FMT='(a,i2)') ' sliceplot%slice: k-point nr.',ikpt END IF iBand = 1 @@ -540,11 +540,11 @@ SUBROUTINE cdnvalJob_init(thisCdnvalJob,mpi,input,kpts,noco,results,jspin,slicep END IF thisCdnvalJob%nEnd(ikpt) = iBand nslibd = MAX(0,thisCdnvalJob%nEnd(ikpt) - thisCdnvalJob%nStart(ikpt) + 1) - IF (mpi%irank==0) WRITE (16,'(a,i3)') ' eigenvalues in sliceplot%slice:', nslibd + IF (mpi%irank==0) WRITE (6,'(a,i3)') ' eigenvalues in sliceplot%slice:', nslibd ELSE IF (sliceplot%kk.EQ.ikpt) THEN - IF (mpi%irank==0) WRITE (16,FMT='(a,i2)') ' sliceplot%slice: k-point nr.',ikpt + IF (mpi%irank==0) WRITE (6,FMT='(a,i2)') ' sliceplot%slice: k-point nr.',ikpt IF ((sliceplot%e1s.EQ.0.0) .AND. (sliceplot%e2s.EQ.0.0)) THEN - IF (mpi%irank==0) WRITE (16,FMT='(a,i5,f10.5)') 'slice: eigenvalue nr.',& + IF (mpi%irank==0) WRITE (6,FMT='(a,i5,f10.5)') 'slice: eigenvalue nr.',& sliceplot%nnne,results%eig(sliceplot%nnne,ikpt,jsp) nslibd = 1 thisCdnvalJob%nStart(ikpt) = sliceplot%nnne @@ -565,7 +565,7 @@ SUBROUTINE cdnvalJob_init(thisCdnvalJob,mpi,input,kpts,noco,results,jspin,slicep END IF thisCdnvalJob%nEnd(ikpt) = iBand nslibd = MAX(0,thisCdnvalJob%nEnd(ikpt) - thisCdnvalJob%nStart(ikpt) + 1) - IF (mpi%irank==0) WRITE (16,FMT='(a,i3)')' eigenvalues in sliceplot%slice:',nslibd + IF (mpi%irank==0) WRITE (6,FMT='(a,i3)')' eigenvalues in sliceplot%slice:',nslibd END IF END IF thisCdnvalJob%noccbd(ikpt) = nslibd diff --git a/types/types_enpara.F90 b/types/types_enpara.F90 index f6c7da66d71d274ac1e73fdce6d86c8f753f7858..8cccf869f456f0d39644a172d0382728a057284b 100644 --- a/types/types_enpara.F90 +++ b/types/types_enpara.F90 @@ -191,7 +191,6 @@ CONTAINS vbar = v%mt(j,0,n,jsp)/rj IF (mpi%irank.EQ.0) THEN WRITE ( 6,'('' spin'',i2,'', atom type'',i3,'' ='',f12.6,'' r='',f8.5)') jsp,n,vbar,rj - WRITE (16,'('' spin'',i2,'', atom type'',i3,'' ='',f12.6,'' r='',f8.5)') jsp,n,vbar,rj ENDIF DO l = 0,atoms%lmax(n) IF ( .NOT.l_done(l,n,jsp) ) THEN @@ -226,7 +225,6 @@ CONTAINS vz0 = v%vacz(1,ivac,jsp) IF (mpi%irank.EQ.0) THEN WRITE ( 6,'('' spin'',i2,'', vacuum '',i3,'' ='',f12.6)') jsp,ivac,vz0 - WRITE (16,'('' spin'',i2,'', vacuum '',i3,'' ='',f12.6)') jsp,ivac,vz0 ENDIF ENDIF enpara%evac(ivac,jsp) = enpara%evac0(ivac,jsp) + vz0 diff --git a/vgen/int_nv.F90 b/vgen/int_nv.F90 index e046286380870794f6a375d593a9de1a3b9bfa02..db3aa1aae5de84bf9097cf32e45548f0ff1f0ec6 100644 --- a/vgen/int_nv.F90 +++ b/vgen/int_nv.F90 @@ -44,8 +44,7 @@ CONTAINS tis = cell%omtil * REAL( DOT_PRODUCT(vpot%pw_w(:stars%ng3,ispin),den%pw(:stars%ng3,ispin))) WRITE (6,FMT=8020) tis - WRITE (16,FMT=8020) tis -8020 FORMAT (/,10x,'interstitial :',t40,ES20.10) +8020 FORMAT (/,10x,'interstitial :',t40,f20.10) RESULT = RESULT + tis ! @@ -64,8 +63,7 @@ CONTAINS nat = nat + atoms%neq(n) ENDDO WRITE (6,FMT=8030) tmt - WRITE (16,FMT=8030) tmt -8030 FORMAT (/,10x,'muffin tin spheres :',t40,ES20.10) +8030 FORMAT (/,10x,'muffin tin spheres :',t40,f20.10) RESULT = RESULT + tmt ! ! *********** VACUUM REGION************** @@ -98,8 +96,7 @@ CONTAINS tvact = tvact + cell%area*tvac*facv ENDDO WRITE (6,FMT=8040) tvact - WRITE (16,FMT=8040) tvact -8040 FORMAT (/,10x,'vacuum :',t40,ES20.10) +8040 FORMAT (/,10x,'vacuum :',t40,f20.10) RESULT = RESULT + tvact ELSEIF (oneD%odi%d1) THEN !-odim @@ -126,8 +123,7 @@ CONTAINS CALL intgz0(dpz,vacuum%delz,vacuum%nmz,tvac,tail) tvact = tvact + cell%area*tvac WRITE (6,FMT=8041) tvact - WRITE (16,FMT=8041) tvact -8041 FORMAT (/,10x,'vacuum :',t40,ES20.10) +8041 FORMAT (/,10x,'vacuum :',t40,f20.10) RESULT = RESULT + tvact !+odim END IF diff --git a/vgen/psqpw.F90 b/vgen/psqpw.F90 index 2659d1c587116f15cc8d0a2b716ccee7f222ce87..059e7118bb942ecb32db703f134e22654e48531e 100644 --- a/vgen/psqpw.F90 +++ b/vgen/psqpw.F90 @@ -181,7 +181,6 @@ contains psint = psq(1) * stars%nstr(1) * cell%omtil end if write( 6, fmt=8000 ) psint - write( 16, fmt=8000 ) psint 8000 format (/,10x,'integral of pseudo charge density inside the slab='& & ,5x,2f11.6) if ( .not. input%film .or. potdenType == POTDEN_TYPE_POTYUK ) return @@ -207,7 +206,6 @@ contains fact = ( qvac + psint ) / ( stars%nstr(1) * cell%vol ) psq(1) = psq(1) - fact write( 6, fmt=8010 ) fact * 1000 - write( 16, fmt=8010 ) fact * 1000 8010 format (/,10x,' 1000 * normalization const. ='& & ,5x,2f11.6) end if ! mpi%irank == 0 diff --git a/vgen/vgen_coulomb.F90 b/vgen/vgen_coulomb.F90 index b6bd46efbdaec870aaa48459602c994e122f4d98..f502fc5c5a27094863be23c6f81e2e0c024e229d 100644 --- a/vgen/vgen_coulomb.F90 +++ b/vgen/vgen_coulomb.F90 @@ -207,7 +207,6 @@ contains call timestart( "den-pot integrals" ) ! CALCULATE THE INTEGRAL OF n*Vcoulomb write( 6, fmt=8020 ) - write( 16, fmt=8020 ) 8020 format (/,10x,'density-coulomb potential integrals',/) ! interstitial first ! convolute ufft and pot: F(G) = \sum_(G') U(G - G') V(G') @@ -217,7 +216,6 @@ contains vCoul, den, results%te_vcoul ) write( 6, fmt=8030 ) results%te_vcoul - write( 16, fmt=8030 ) results%te_vcoul 8030 format (/,10x,'total density-coulomb potential integral :', t40,f20.10) call timestop( "den-pot integrals" ) diff --git a/vgen/vvacxc.f90 b/vgen/vvacxc.f90 index 3c429834d4dd8291e9f5a6d8c950f5825f4ae6f3..b1f126e287a17f5cafb492280ade6a34be0c65d9 100644 --- a/vgen/vvacxc.f90 +++ b/vgen/vvacxc.f90 @@ -154,7 +154,6 @@ CONTAINS ENDDO ! WRITE (6,FMT=8020) ivac, (vxc%vacz(vacuum%nmz,ivac,js),js=1,input%jspins) - WRITE (16,FMT=8020) ivac, (vxc%vacz(vacuum%nmz,ivac,js),js=1,input%jspins) 8020 FORMAT (/,5x,'vacuum zero for vacuum',i3,' = ',2f10.5) ! ! calculate the ex.-corr. energy density now beyond warping region diff --git a/vgen/vvacxcg.f90 b/vgen/vvacxcg.f90 index f259f956959f2d563a5602dc1306716ae5090681..b09aebbf75646319ba8a04e948540129c82c49b4 100644 --- a/vgen/vvacxcg.f90 +++ b/vgen/vvacxcg.f90 @@ -540,7 +540,6 @@ CONTAINS ! WRITE (6,fmt=8020) ivac, (vxc%vacz(vacuum%nmz,ivac,js),js=1,input%jspins) - WRITE(16,fmt=8020) ivac, (vxc%vacz(vacuum%nmz,ivac,js),js=1,input%jspins) 8020 FORMAT(/,5x,'vacuum zero for vacuum',i3,' = ',2f14.10) ! ! calculate the ex-corr. energy density now beyond warping region diff --git a/xc-pot/grdchlh.f90 b/xc-pot/grdchlh.f90 index d8d671bd306de1ebee911b25fbe088184c718cd0..b256389f0ea83cdd53b6d073e00f2201929fa60d 100644 --- a/xc-pot/grdchlh.f90 +++ b/xc-pot/grdchlh.f90 @@ -29,7 +29,6 @@ CONTAINS IF (ied-ist < 3) RETURN IF (ndvgrd < 3 .OR. ndvgrd>6) THEN - WRITE (16,fmt=126) ndvgrd CALL juDFT_error("ndvgrd<3 .or. ndvgrd>6",calledby="grdchlh") ENDIF 126 FORMAT (/,' ndvgrd should be ge.4 .or. le.6. ndvgrd=',i3) @@ -104,7 +103,7 @@ CONTAINS nred = REAL(ndvgrd)/2 + 0.1 IF (ied-nred.LE.ist) THEN - WRITE(16,fmt='(/'' ied-nred < ist. ied,nred,ist='',3i4)') ied,nred,ist + WRITE(6,fmt='(/'' ied-nred < ist. ied,nred,ist='',3i4)') ied,nred,ist CALL juDFT_error("ied-nred.le.ist",calledby="grdchlh") ENDIF