scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Unit stdout (set in Modules/io_global.f90) is used to write on standard output 

instead of 6 or *.
C.S.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@365 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
sbraccia 2003-11-04 10:53:05 +00:00
parent d5030e787e
commit 24ce939aeb
91 changed files with 750 additions and 660 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Gamma/allocate_wfc.f90
View File

@ -13,6 +13,7 @@ subroutine allocate_wfc
! dynamical allocation of arrays: wavefunctions and eigenvectors
!
#include "machine.h"
USE io_global, ONLY : stdout
USE wvfct, ONLY : npwx, nbnd, nbndx, et, wg
USE klist, ONLY : nkstot, nelec
USE basis, ONLY : natomwfc
@ -33,7 +34,7 @@ subroutine allocate_wfc
if (lda_plus_u) allocate (swfcatom( npwx, natomwfc))
et(:,:) = 0.d0
write (6, 100) nbndx, nbnd, natomwfc, npwx, nelec, nkb, ngl
WRITE( stdout, 100) nbndx, nbnd, natomwfc, npwx, nelec, nkb, ngl
100 format (/5x,'nbndx = ',i5,' nbnd = ',i5,' natomwfc = ',i5, &
& ' npwx = ',i7, &

7
Gamma/c_bands.f90
View File

@ -17,6 +17,7 @@ subroutine c_bands (iter, ik_, dr2)
! iterative diagonalization.
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY: evc
USE rbecmod, ONLY: becp, becp_
@ -65,7 +66,7 @@ subroutine c_bands (iter, ik_, dr2)
allocate (becp( nkb,nbnd), becp_(nkb,nbnd))
if (isolve == 0) then
write (6, '(" Davidson diagonalization with overlap")')
WRITE( stdout, '(" Davidson diagonalization with overlap")')
else
call errore ('c_bands', 'CG and DIIS diagonalization not implemented', 1)
endif
@ -146,7 +147,7 @@ subroutine c_bands (iter, ik_, dr2)
if (ntry.le.5.and. ( &
.not.lscf.and.notconv.gt.0.or.lscf.and.notconv.gt.5) ) goto 15
if (notconv.ne.0) write (6, '(" warning : ",i3," eigenvectors not",&
if (notconv.ne.0) WRITE( stdout, '(" warning : ",i3," eigenvectors not",&
&" converged after ",i3," attemps")') notconv, ntry
if (notconv.gt.max (5, nbnd / 4) ) stop
20 continue
@ -161,7 +162,7 @@ subroutine c_bands (iter, ik_, dr2)
call poolreduce (1, avg_iter)
#endif
avg_iter = avg_iter / nkstot
write (6, 9000) ethr, avg_iter
WRITE( stdout, 9000) ethr, avg_iter
!
! deallocate work space
!

45
Gamma/cg_summary.f90
View File

@ -14,46 +14,47 @@ subroutine cg_summary
!%%%%%%%%%% summarize input data %%%%%%%%%%%%%%%%%%%
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
USE io_global, ONLY : stdout
use pwcom
use cgcom
!
implicit none
integer :: nu, mu, i,l, na, nt
!
write (6,'(/5x,a75)') title
write (6,9010) crystal,alat,omega,nat,ecutwfc,gcutm,tr2_ph
WRITE( stdout,'(/5x,a75)') title
WRITE( stdout,9010) crystal,alat,omega,nat,ecutwfc,gcutm,tr2_ph
!
write (6,9020) (i,celldm(i),i=1,6)
write (6,9030) ngm,nr1,nr2,nr3,nks
write (6,9040)
write (6,9050) (na,atm(ityp(na)),amass(ityp(na))/amconv, &
WRITE( stdout,9020) (i,celldm(i),i=1,6)
WRITE( stdout,9030) ngm,nr1,nr2,nr3,nks
WRITE( stdout,9040)
WRITE( stdout,9050) (na,atm(ityp(na)),amass(ityp(na))/amconv, &
& (tau(i,na),i=1,3),na=1,nat)
do nt = 1,ntyp
write (6,9060) nlc(nt), nnl(nt)
write (6,9070) nt,psd(nt),zp(nt),lmax(nt),lloc(nt)
write (6,9080)
write (6,'(/5x,"core")')
write (6,9090) (alpc(i,nt),i=1,2)
write (6,9100) (cc(i,nt),i=1,2)
WRITE( stdout,9060) nlc(nt), nnl(nt)
WRITE( stdout,9070) nt,psd(nt),zp(nt),lmax(nt),lloc(nt)
WRITE( stdout,9080)
WRITE( stdout,'(/5x,"core")')
WRITE( stdout,9090) (alpc(i,nt),i=1,2)
WRITE( stdout,9100) (cc(i,nt),i=1,2)
do l = 0,lmax(nt)
write (6,'(/5x,"l = ",i2)') l
write (6,9090) (alps(i,l,nt),i=1,3)
write (6,9100) (aps(i,l,nt),i=1,3)
write (6,9110) (aps(i,l,nt),i=4,6)
WRITE( stdout,'(/5x,"l = ",i2)') l
WRITE( stdout,9090) (alps(i,l,nt),i=1,3)
WRITE( stdout,9100) (aps(i,l,nt),i=1,3)
WRITE( stdout,9110) (aps(i,l,nt),i=4,6)
end do
end do
write (6,9115)
WRITE( stdout,9115)
do nt = 1,ntyp
write (6,9116) atm(nt),zv(nt),psd(nt)
WRITE( stdout,9116) atm(nt),zv(nt),psd(nt)
end do
write (6, &
WRITE( stdout, &
&'(//5x,"atomic displacements are normalized to unity"/)')
if (nmodes.lt.3*nat) then
write (6, &
WRITE( stdout, &
& '(5x,"phonon polarizations are as follows:"/)')
do nu = 1,nmodes
write (6,'(" mode # ",i3)') nu
write (6,'(3(" (",f6.3,2f7.3,") "))') &
WRITE( stdout,'(" mode # ",i3)') nu
WRITE( stdout,'(3(" (",f6.3,2f7.3,") "))') &
& ( u(mu,nu), mu = 1,3*nat)
end do
end if

3
Gamma/cgsolve.f90
View File

@ -17,6 +17,7 @@ subroutine cgsolve (operator,npw,evc,npwx,nbnd,overlap, &
! x = solution, u = gradient, h = conjugate gradient, Ah = operator*h
!
#include "machine.h"
USE io_global, ONLY : stdout
use parameters, only : DP
implicit none
integer npw, npwx, nbnd, nbndx, niter, iter
@ -126,7 +127,7 @@ subroutine cgsolve (operator,npw,evc,npwx,nbnd,overlap, &
!
if( u_u .le. eps) go to 10
if (iter.eq.niter) then
write(6,'(" *** Conjugate Gradient minimization", &
WRITE( stdout,'(" *** Conjugate Gradient minimization", &
& " not converged after ",i3," iterations"/ &
& " residual norm |Ax-b|^2 : ",e10.4)') iter,u_u
go to 10

3
Gamma/d2ion.f90
View File

@ -16,6 +16,7 @@ subroutine d2ion (nat,ntyp,ityp,zv,tau,alat,omega, &
!
#include "machine.h"
use parameters, only : DP
USE io_global, ONLY : stdout
implicit none
integer :: nat, ntyp, ngm, ityp(nat), nmodes, has_equivalent(nat)
real(kind=DP):: tau(3,nat), g(3,ngm), gg(ngm), zv(ntyp), &
@ -40,7 +41,7 @@ subroutine d2ion (nat,ntyp,ityp,zv,tau,alat,omega, &
!
alpha=0.5
! appropriate for c60
write(6,'(" d2ion: alpha = ",f6.2)') alpha
WRITE( stdout,'(" d2ion: alpha = ",f6.2)') alpha
!
dyn (:,:) = 0.d0
!

13
Gamma/dyndiar.f90
View File

@ -15,6 +15,7 @@ subroutine dyndiar (dyn,nat3,nmodes,u,nat,ityp,amass,w2,dynout)
!
#include "machine.h"
use parameters, only : DP
USE io_global, ONLY : stdout
implicit none
integer :: nmodes, nat3, nat,ityp(nat), iudyn
real(kind=DP):: dyn(nat3,nmodes), u(nat3,nmodes), amass(*)
@ -39,7 +40,7 @@ subroutine dyndiar (dyn,nat3,nmodes,u,nat,ityp,amass,w2,dynout)
dynout(nu_i,nu_j) = dynout(nu_j,nu_i)
end do
end do
write (6,9000) dif
WRITE( stdout,9000) dif
!
! Impose Acoustic Sum Rule
!
@ -56,7 +57,7 @@ subroutine dyndiar (dyn,nat3,nmodes,u,nat,ityp,amass,w2,dynout)
end do
end do
end do
write (6,9005) dif
WRITE( stdout,9005) dif
!
! fill the mass matrix
!
@ -84,14 +85,14 @@ subroutine dyndiar (dyn,nat3,nmodes,u,nat,ityp,amass,w2,dynout)
!
! write frequencies
!
write (6,'(5x,"diagonalizing the dynamical matrix ..."//)')
write (6,'(1x,74("*"))')
WRITE( stdout,'(5x,"diagonalizing the dynamical matrix ..."//)')
WRITE( stdout,'(1x,74("*"))')
!
dynout (:,:) = 0.0
do nu_i = 1,nmodes
w1 = sqrt(abs(w2(nu_i)))
if (w2(nu_i).lt.0.0) w1 = -w1
write (6,9010) nu_i, w1*rydthz, w1*rydcm1
WRITE( stdout,9010) nu_i, w1*rydthz, w1*rydcm1
! bring eigendisplacements in cartesian axis
do mu = 1,3*nat
do i = 1,nmodes
@ -99,7 +100,7 @@ subroutine dyndiar (dyn,nat3,nmodes,u,nat,ityp,amass,w2,dynout)
end do
end do
end do
write(6,'(1x,74("*"))')
WRITE( stdout,'(1x,74("*"))')
!
deallocate(z)
deallocate(m)

51
Gamma/raman.f90
View File

@ -114,6 +114,7 @@ subroutine cg_deps(deps_dtau)
! calculate d eps0/d tau with finite differences
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
use cgcom
#ifdef __PARA
@ -139,10 +140,10 @@ subroutine cg_deps(deps_dtau)
read(iunres,*,err=1,end=1) deps_dtau
close(unit=iunres)
if (na_.le.na) then
write(6,'(5x,"Restarting from atom ",i2,", pol ",i1, &
WRITE( stdout,'(5x,"Restarting from atom ",i2,", pol ",i1, &
& ", nd=",i1)') na_,ipol_,nd_
else
write(6,'(5x,"Reading saved data")')
WRITE( stdout,'(5x,"Reading saved data")')
end if
go to 2
1 close(unit=iunres)
@ -150,7 +151,7 @@ subroutine cg_deps(deps_dtau)
ipol_=1
nd_ =1
deps_dtau(:,:,:,:) = 0.d0
write(6,'(5x,"Starting over from the beginning")')
WRITE( stdout,'(5x,"Starting over from the beginning")')
2 continue
!
do na=na_,nat
@ -217,11 +218,11 @@ subroutine cg_deps(deps_dtau)
!
iudyn = 20
open(unit=iudyn,file=fildyn,form='formatted',status='old',position='append')
write (6,'(/5x, "Raman tensors (atomic)"/)')
WRITE( stdout,'(/5x, "Raman tensors (atomic)"/)')
write (iudyn,'(/5x,"Raman: D eps_{alpha,beta}/D tau_{s,gamma}"/)')
do na=1,nat
do ipol=1,3
write(6,'(/5x,"D eps(i,j)",5x,3e14.6 &
WRITE( stdout,'(/5x,"D eps(i,j)",5x,3e14.6 &
& /5x,"---------- = ",3e14.6 &
& /5x,"D tau(",i2,")_",i1,4x,3e14.6)') &
& (( deps_dtau(kpol,jpol,ipol,na), jpol=1,3), kpol=1,2),&
@ -231,7 +232,7 @@ subroutine cg_deps(deps_dtau)
( (deps_dtau(kpol,jpol,ipol,na), jpol=1,3), kpol=1,3)
end do
end do
write(6,*)
WRITE( stdout,*)
close (unit=iudyn)
!
return
@ -242,6 +243,7 @@ subroutine cg_eps0dyn(w2,dynout)
!-----------------------------------------------------------------------
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
use cgcom
#ifdef __PARA
@ -287,9 +289,9 @@ subroutine cg_eps0dyn(w2,dynout)
end if
#endif
!
write (6,'(/5x,"estimated dielectric constants =",3f10.3, &
WRITE( stdout,'(/5x,"estimated dielectric constants =",3f10.3, &
& /37x,3f10.3/37x,3f10.3)') ((epsilon0(i,j),j=1,3),i=1,3)
write (6,'(/5x,"z*(",i2,")",3f10.3,/11x,3f10.3/11x,3f10.3)') &
WRITE( stdout,'(/5x,"z*(",i2,")",3f10.3,/11x,3f10.3/11x,3f10.3)') &
(na, ((zstar(i,j,na),j=1,3),i=1,3), na=1,nat)
end if
!
@ -350,6 +352,7 @@ subroutine cg_neweps
!-----------------------------------------------------------------------
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
use cgcom
!
@ -381,12 +384,12 @@ subroutine cg_neweps
!
call dielec(.false.)
!
write (6,'(/5x,"displaced atomic positions :")')
write (6,'(5x,3f12.6)') ((tau(i,j),i=1,3),j=1,nat)
WRITE( stdout,'(/5x,"displaced atomic positions :")')
WRITE( stdout,'(5x,3f12.6)') ((tau(i,j),i=1,3),j=1,nat)
!
write (6,'(/5x,"estimated dielectric constants =",3f10.3, &
WRITE( stdout,'(/5x,"estimated dielectric constants =",3f10.3, &
& /37x,3f10.3/37x,3f10.3)') ((epsilon0(i,j),j=1,3),i=1,3)
write (6,*)
WRITE( stdout,*)
!
end subroutine cg_neweps
!
@ -453,6 +456,7 @@ subroutine raman_cs(dynout,deps_dtau)
! calculate Raman cross section
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
use cgcom
!
@ -463,7 +467,7 @@ subroutine raman_cs(dynout,deps_dtau)
!
!
allocate ( raman_activity( 3, 3, nmodes))
write (6,'(/5x, "Raman tensor for mode nu : dX_{alpha,beta}/d nu"/)')
WRITE( stdout,'(/5x, "Raman tensor for mode nu : dX_{alpha,beta}/d nu"/)')
do nu=1,nmodes
!
do jpol=1,3
@ -477,7 +481,7 @@ subroutine raman_cs(dynout,deps_dtau)
end do
end do
end do
write (6,'(i5,3x,3e14.6,2(/8x,3e14.6))') &
WRITE( stdout,'(i5,3x,3e14.6,2(/8x,3e14.6))') &
nu,( ( raman_activity(ipol,jpol,nu),jpol=1,3), ipol=1,3)
end do
deallocate(raman_activity)
@ -492,6 +496,7 @@ subroutine raman_cs2(w2,dynout)
! calculate d eps0/d u (u=phonon mode) with finite differences
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
use cgcom
#ifdef __PARA
@ -521,17 +526,17 @@ subroutine raman_cs2(w2,dynout)
read(iunres,*,err=1,end=1) raman_activity
close(unit=iunres)
if (nu_.le.nu) then
write(6,'(5x,"Restarting from mode ",i3,", nd=",i1)') &
WRITE( stdout,'(5x,"Restarting from mode ",i3,", nd=",i1)') &
nu_,nd_
else
write(6,'(5x,"Reading saved data")')
WRITE( stdout,'(5x,"Reading saved data")')
end if
go to 2
1 close(unit=iunres)
nu_=1
nd_=1
raman_activity(:,:,:) = 0.d0
write(6,'(5x,"Starting over from the beginning")')
WRITE( stdout,'(5x,"Starting over from the beginning")')
2 continue
!
do nu=first,last
@ -619,7 +624,7 @@ subroutine raman_cs2(w2,dynout)
end do
!
do nu=first,last
write (6,'(i5,3x,3e14.6,2(/8x,3e14.6))') &
WRITE( stdout,'(i5,3x,3e14.6,2(/8x,3e14.6))') &
nu,( ( raman_activity(ipol,jpol,nu-first+1),jpol=1,3), ipol=1,3)
end do
!
@ -669,10 +674,10 @@ subroutine raman_cs2(w2,dynout)
!
end do
!
write (6,'(/5x,"IR cross sections are in (D/A)^2/amu units")')
write (6,'(/5x,"(multiplied by 1000)")')
write (6,'(5x,"Raman cross sections are in A^4/amu units")')
write (6,'(/"# mode [cm-1] [THz] IR Raman")')
WRITE( stdout,'(/5x,"IR cross sections are in (D/A)^2/amu units")')
WRITE( stdout,'(/5x,"(multiplied by 1000)")')
WRITE( stdout,'(5x,"Raman cross sections are in A^4/amu units")')
WRITE( stdout,'(/"# mode [cm-1] [THz] IR Raman")')
!
do nu = 1,3*nat
!
@ -696,7 +701,7 @@ subroutine raman_cs2(w2,dynout)
alpha = 0
beta2 = 0
end if
write (6,'(i5,f10.2,f12.4,2f10.4)') &
WRITE( stdout,'(i5,f10.2,f12.4,2f10.4)') &
nu, freq, freq*cm1thz, infrared(nu)*irfac*1000, &
(45.d0*alpha**2 + 7.0d0*beta2)*r1fac*r2fac
end do

5
Gamma/regterg.f90
View File

@ -20,6 +20,7 @@ subroutine regterg (ndim, ndmx, nvec, nvecx, evc, ethr, overlap, gstart, &
! (real wavefunctions with only half plane waves stored)
!
#include "machine.h"
USE io_global, ONLY : stdout
use parameters, only : DP
use g_psi_mod
implicit none
@ -287,11 +288,11 @@ subroutine regterg (ndim, ndmx, nvec, nvecx, evc, ethr, overlap, gstart, &
!
#ifdef DEBUG_DAVIDSON
do n = 1, nvec
if ( .not.conv (n) ) write (6, '(" WARNING: e(",i3,") =",&
if ( .not.conv (n) ) WRITE( stdout, '(" WARNING: e(",i3,") =",&
f10.5," is not converged to within ",1pe8.1)') n, e(n), ethr
enddo
#else
write (6, '(" WARNING: ",i5," eigenvalues not converged")') &
WRITE( stdout, '(" WARNING: ",i5," eigenvalues not converged")') &
notcnv
#endif
call stop_clock ('last')

5
Gamma/solve_e.f90
View File

@ -11,6 +11,7 @@ subroutine solve_e
!-----------------------------------------------------------------------
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY: evc
USE rbecmod, ONLY: becp, becp_
@ -55,7 +56,7 @@ subroutine solve_e
if (info.ne.0) call errore('solve_e','cannot factorize',info)
end if
!
write (6,'(/" *** Starting Conjugate Gradient minimization", &
WRITE( stdout,'(/" *** Starting Conjugate Gradient minimization", &
& 9x,"***")')
nrec=0
!
@ -89,7 +90,7 @@ subroutine solve_e
write (iudwf) dpsi
close(unit=iudwf)
!
write (6,'(" *** pol. # ",i3," : ",i3," iterations")') &
WRITE( stdout,'(" *** pol. # ",i3," : ",i3," iterations")') &
& ipol, iter
end do
!

11
Gamma/solve_ph.f90
View File

@ -11,6 +11,7 @@ subroutine solve_ph
!-----------------------------------------------------------------------
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY : evc
USE rbecmod, ONLY : becp, becp_
@ -54,7 +55,7 @@ subroutine solve_ph
if (info.ne.0) call errore('solve_ph','cannot factorize',info)
end if
!
write (6,'(/" *** Starting Conjugate Gradient minimization", &
WRITE( stdout,'(/" *** Starting Conjugate Gradient minimization", &
& 9x,"***")')
!
! check if a restart file exists
@ -75,17 +76,17 @@ subroutine solve_ph
do nu = 1, nmodes
if ( has_equivalent((nu-1)/3+1).eq.1) then
! calculate only independent modes
write (6,'(" *** mode # ",i3," : using symmetry")') nu
WRITE( stdout,'(" *** mode # ",i3," : using symmetry")') nu
goto 10
end if
if ( nu.le.mode_done) then
! do not recalculate modes already done
write (6,'(" *** mode # ",i3," : using previous run")') nu
WRITE( stdout,'(" *** mode # ",i3," : using previous run")') nu
goto 10
end if
if ( asr .and. (nu-1)/3+1.eq.nasr ) then
! impose ASR on last atom instead of calculating mode
write (6,'(" *** mode # ",i3," : using asr")') nu
WRITE( stdout,'(" *** mode # ",i3," : using asr")') nu
goto 10
end if
! calculate |b> = dV/dtau*psi
@ -112,7 +113,7 @@ subroutine solve_ph
#ifdef __PARA
end if
#endif
write (6,'(" *** mode # ",i3," : ",i3," iterations")') &
WRITE( stdout,'(" *** mode # ",i3," : ",i3," iterations")') &
& nu, iter
10 continue
end do

2
Gamma/stres_us.f90
View File

@ -92,7 +92,7 @@ subroutine stres_us (ik, gk, sigmanlc)
enddo
enddo
! write (6,*) ' non local energy ', evps, evps*uakbar/omega
! WRITE( stdout,*) ' non local energy ', evps, evps*uakbar/omega
100 continue
!
! non diagonal contribution - derivative of the bessel function

2
Gamma/sum_band.f90
View File

@ -110,7 +110,7 @@ subroutine sum_band
!
do ibnd = 1, nbnd
eband = eband+et (ibnd, ik) * wg (ibnd, ik)
! write(6,'(4x, " ibnd = ", i5, " ik= ",i5,
! WRITE( stdout,'(4x, " ibnd = ", i5, " ik= ",i5,
! + f15.5)') ibnd, ik,wg(ibnd,ik)
!
! the sum of eband and demet is the integral for e < ef of e n(e)

13
Gamma/wfcinit.f90
View File

@ -14,6 +14,7 @@ subroutine wfcinit
! from superposition of atomic wavefunctions.
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY: evc
USE rbecmod, only: becp, becp_
@ -34,7 +35,7 @@ subroutine wfcinit
! state what is going to happen
!
if (startingwfc == 'file') then
write (6, '(5x,a)') 'Starting wfc from file'
WRITE( stdout, '(5x,a)') 'Starting wfc from file'
!
! read the wavefunction into memory (if it is not done in c_bands)
!
@ -45,14 +46,14 @@ subroutine wfcinit
call start_clock ('wfcinit')
if (startingwfc == 'atomic') then
if (natomwfc >= nbnd) then
write (6, '(5x,a)') 'Starting wfc are atomic'
WRITE( stdout, '(5x,a)') 'Starting wfc are atomic'
else
write (6, '(5x,a,i3,a)') 'Starting wfc are atomic + ',&
WRITE( stdout, '(5x,a,i3,a)') 'Starting wfc are atomic + ',&
nbnd-natomwfc, ' random wfc'
endif
n_starting_wfc = max (natomwfc, nbnd)
else
write (6, '(5x,a)') 'Starting wfc are random'
WRITE( stdout, '(5x,a)') 'Starting wfc are random'
n_starting_wfc = nbnd
endif
!
@ -144,8 +145,8 @@ subroutine wfcinit
call poolrecover (et, nbnd, nkstot, nks)
#endif
do ik = 1, nkstot
write (6, 9010) (xk (ipol, ik), ipol = 1, 3)
write (6, '(2x,8f9.4)') (et (ibnd, ik) * rytoev, ibnd = 1, nbnd)
WRITE( stdout, 9010) (xk (ipol, ik), ipol = 1, 3)
WRITE( stdout, '(2x,8f9.4)') (et (ibnd, ik) * rytoev, ibnd = 1, nbnd)
enddo
endif
#ifdef FLUSH

17
PW/add_efield.f90
View File

@ -36,6 +36,7 @@
!
#include "machine.h"
use pwcom
USE io_global, ONLY : stdout
#ifdef __PARA
use para
use mp
@ -134,16 +135,16 @@
vamp=2.0d0*(eamp-dip)*length*real(npoints-ndesc,dp)&
/real(npoints,dp)
if (first) then
write(6,*)
write(6,'(5x,"Adding an external electric field")')
write(6,'(5x,"Intensity [a.u.]: ",f15.8)') eamp
WRITE( stdout,*)
WRITE( stdout,'(5x,"Adding an external electric field")')
WRITE( stdout,'(5x,"Intensity [a.u.]: ",f15.8)') eamp
endif
if (dipfield) write(6,'(5x,"Dipole field [a.u.]: ", f15.8)') dip
if (dipfield) WRITE( stdout,'(5x,"Dipole field [a.u.]: ", f15.8)') dip
if (first) then
write(6,'(5x,"Potential amplitude [Ry]: ", f15.8)') vamp
write(6,'(5x,"Total length [points]: ", i5)') npoints
write(6,'(5x,"Total length [bohr rad]: ", f15.8)') length
write(6,'(5x,"Field is reversed between points: ",2i6)')nmax, nmax+ndesc
WRITE( stdout,'(5x,"Potential amplitude [Ry]: ", f15.8)') vamp
WRITE( stdout,'(5x,"Total length [points]: ", i5)') npoints
WRITE( stdout,'(5x,"Total length [bohr rad]: ", f15.8)') length
WRITE( stdout,'(5x,"Field is reversed between points: ",2i6)')nmax, nmax+ndesc
endif
!
! in this case x direction

8
PW/addusforce.f90
View File

@ -100,13 +100,13 @@ subroutine addusforce (forcenl)
#ifdef __PARA
call reduce (3 * nhm * (nhm + 1) * nat * nspin / 2, ddeeq)
#endif
! write(6,'( "dmatrix atom ",i4)') na
! WRITE( stdout,'( "dmatrix atom ",i4)') na
! do ih = 1, nh(nt)
! write(6,'(8f9.4)') (ddeeq(ipol,ih,jh,na),jh=1,nh(nt))
! WRITE( stdout,'(8f9.4)') (ddeeq(ipol,ih,jh,na),jh=1,nh(nt))
! end do
! write(6,'( "dion pseudo ",i4)') nt
! WRITE( stdout,'( "dion pseudo ",i4)') nt
! do ih = 1, nh(nt)
! write(6,'(8f9.4)') (dvan(ih,jh,nt),jh=1,nh(nt))
! WRITE( stdout,'(8f9.4)') (dvan(ih,jh,nt),jh=1,nh(nt))
! end do
do is = 1, nspin
do na = 1, nat

5
PW/allocate_fft.f90
View File

@ -14,6 +14,7 @@ subroutine allocate_fft
! these dimensions
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY : psic
implicit none
@ -23,13 +24,13 @@ subroutine allocate_fft
call data_structure( gamma_only )
!
if (nrxx.lt.ngm) then
write (6, '(/,4x," nr1=",i4," nr2= ", i4, " nr3=",i4, &
WRITE( stdout, '(/,4x," nr1=",i4," nr2= ", i4, " nr3=",i4, &
&" nrxx = ",i8," ngm=",i8)') nr1, nr2, nr3, nrxx, ngm
call errore ('allocate_fft', 'the nr"s are too small!', 1)
endif
if (nrxxs.lt.ngms) then
write (6, '(/,4x," nr1s=",i4," nr2s= ", i4, " nr3s=",i4, &
WRITE( stdout, '(/,4x," nr1s=",i4," nr2s= ", i4, " nr3s=",i4, &
&" nrxxs = ",i8," ngms=",i8)') nr1s, nr2s, nr3s, nrxxs, ngms
call errore ('allocate_fft', 'the nrs"s are too small!', 1)

3
PW/allocate_wfc.f90
View File

@ -14,6 +14,7 @@ subroutine allocate_wfc
!
#include "machine.h"
use pwcom
USE io_global, ONLY : stdout
USE wavefunctions, ONLY : evc
use becmod
implicit none
@ -30,7 +31,7 @@ subroutine allocate_wfc
if (lda_plus_u) allocate (swfcatom( npwx, natomwfc))
et(:,:) = 0.d0
write (6, 100) nbndx, nbnd, natomwfc, npwx, nelec, nkb, ngl
WRITE( stdout, 100) nbndx, nbnd, natomwfc, npwx, nelec, nkb, ngl
100 format (/5x,'nbndx = ',i5,' nbnd = ',i5,' natomwfc = ',i5, &
& ' npwx = ',i7, &

4
PW/atomic_rho.f90
View File

@ -22,7 +22,7 @@ subroutine atomic_rho (rhoa, nspina)
!
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY : psic
implicit none
@ -121,7 +121,7 @@ subroutine atomic_rho (rhoa, nspina)
call reduce (1, rhoima)
#endif
if ( rhoneg < -1.0d-4 .or. rhoima > 1.0d-4 ) &
write (6,'(/" Warning: negative or imaginary starting charge ",&
WRITE( stdout,'(/" Warning: negative or imaginary starting charge ",&
&2f12.6,i3)') rhoneg, rhoima, is
enddo

13
PW/bfgs.f90
View File

@ -22,6 +22,7 @@ SUBROUTINE bfgs
starting_scf_threshold, dtau_ref
USE ener, ONLY : etot
USE klist, ONLY : nelec
USE io_global, ONLY : stdout
USE io_files, ONLY : prefix
#ifdef __PARA
USE para, ONLY : me, mypool
@ -87,7 +88,7 @@ SUBROUTINE bfgs
CLOSE( UNIT = iunit, STATUS = 'DELETE' )
minimum_ok = .FALSE.
CALL estimate( hessm1, nax3, nat, nat3 )
WRITE(6, '(/5X,"EPSE = ",E9.2," EPSF = ",E9.2, &
WRITE( stdout, '(/5X,"EPSE = ",E9.2," EPSF = ",E9.2, &
& " UPSCALE = ",F6.2)') epse, epsf, upscale
ELSE
!
@ -168,8 +169,8 @@ SUBROUTINE bfgs
detot = - DDOT( nat3, force, 1, dtau, 1 )
!
IF ( detot > 0.D0 ) THEN
WRITE(6, '("uphill direction! de/dx =",E10.4)') detot
WRITE(6, '("try steepest descent direction instead!")')
WRITE( stdout, '("uphill direction! de/dx =",E10.4)') detot
WRITE( stdout, '("try steepest descent direction instead!")')
!
CALL DCOPY( nat3, force, 1, dtau, 1 )
xnew = SQRT( DDOT( nat3, dtau, 1, dtau, 1 ) )
@ -207,10 +208,10 @@ SUBROUTINE bfgs
! ... report
!
IF ( conv_ions ) THEN
WRITE(6, '(/5X,"BFGS: convergence achieved, Efinal=",F15.8)') etot
WRITE(6, '(/72("-")//5X,"Final estimate of positions")')
WRITE( stdout, '(/5X,"BFGS: convergence achieved, Efinal=",F15.8)') etot
WRITE( stdout, '(/72("-")//5X,"Final estimate of positions")')
ELSE
WRITE(6, '(/72("-")//5X, &
WRITE( stdout, '(/72("-")//5X, &
&"Search of equilibrium positions: iteration # ",I4, &
&", scf threshold ",1PE8.2/)') istep, tr2
END IF

105
PW/bp_c_phase.f90
View File

@ -148,6 +148,7 @@ SUBROUTINE c_phase
#include "machine.h"
! --- Make use of the module with common information ---
USE io_global, ONLY : stdout
USE pwcom
USE wavefunctions, ONLY : evc
@ -263,9 +264,9 @@ SUBROUTINE c_phase
! ------------------------------------------------------------------------- !
! --- Write header ---
WRITE(6,"(/,/,/,15X,50('='))")
WRITE(6,"(28X,'POLARIZATION CALCULATION')")
WRITE(6,"(15X,50('-'),/)")
WRITE( stdout,"(/,/,/,15X,50('='))")
WRITE( stdout,"(28X,'POLARIZATION CALCULATION')")
WRITE( stdout,"(15X,50('-'),/)")
! --- Check that we are working with an insulator with no empty bands ---
IF ((degauss > 0.01) .OR. (nbnd /= nelec/2)) CALL errore('c_phase', &
@ -479,23 +480,23 @@ SUBROUTINE c_phase
IF ((ABS(g(1,ng)-gtr(1)) > eps) .OR. &
(ABS(g(2,ng)-gtr(2)) > eps) .OR. &
(ABS(g(3,ng)-gtr(3)) > eps)) THEN
WRITE(6,*) ' error: translated G=', &
WRITE( stdout,*) ' error: translated G=', &
gtr(1),gtr(2),gtr(3), &
' with crystal coordinates',n1,n2,n3, &
' corresponds to ng=',ng,' but G(ng)=', &
g(1,ng),g(2,ng),g(3,ng)
WRITE(6,*) ' probably because G_par is NOT', &
WRITE( stdout,*) ' probably because G_par is NOT', &
' a reciprocal lattice vector '
WRITE(6,*) ' Possible choices as smallest ', &
WRITE( stdout,*) ' Possible choices as smallest ', &
' G_par:'
DO i=1,50
WRITE(6,*) ' i=',i,' G=', &
WRITE( stdout,*) ' i=',i,' G=', &
g(1,i),g(2,i),g(3,i)
ENDDO
STOP
ENDIF
ELSE
WRITE(6,*) ' |gtr| > gcutm for gtr=', &
WRITE( stdout,*) ' |gtr| > gcutm for gtr=', &
gtr(1),gtr(2),gtr(3)
STOP
END IF
@ -686,59 +687,59 @@ SUBROUTINE c_phase
! ------------------------------------------------------------------------- !
! --- Information about the k-points string used ---
WRITE(6,"(/,21X,'K-POINTS STRINGS USED IN CALCULATIONS')")
WRITE(6,"(21X,37('~'),/)")
WRITE(6,"(7X,'G-vector along string (2 pi/a):',3F9.5)") &
WRITE( stdout,"(/,21X,'K-POINTS STRINGS USED IN CALCULATIONS')")
WRITE( stdout,"(21X,37('~'),/)")
WRITE( stdout,"(7X,'G-vector along string (2 pi/a):',3F9.5)") &
gpar(1),gpar(2),gpar(3)
WRITE(6,"(7X,'Modulus of the vector (1/bohr):',F9.5)") &
WRITE( stdout,"(7X,'Modulus of the vector (1/bohr):',F9.5)") &
gvec
WRITE(6,"(7X,'Number of k-points per string:',I4)") nppstr
WRITE(6,"(7X,'Number of different strings :',I4)") nkort
WRITE( stdout,"(7X,'Number of k-points per string:',I4)") nppstr
WRITE( stdout,"(7X,'Number of different strings :',I4)") nkort
! --- Information about ionic polarization phases ---
WRITE(6,"(2/,31X,'IONIC POLARIZATION')")
WRITE(6,"(31X,18('~'),/)")
WRITE(6,"(8X,'Note: (mod 1) means that the phases (angles ranging from' &
WRITE( stdout,"(2/,31X,'IONIC POLARIZATION')")
WRITE( stdout,"(31X,18('~'),/)")
WRITE( stdout,"(8X,'Note: (mod 1) means that the phases (angles ranging from' &
& /,8X,'-pi to pi) have been mapped to the interval [-1/2,+1/2) by',&
& /,8X,'dividing by 2*pi; (mod 2) refers to the interval [-1,+1)',&
& /)")
WRITE(6,"(2X,76('='))")
WRITE(6,"(4X,'Ion',4X,'Species',4X,'Charge',14X, &
WRITE( stdout,"(2X,76('='))")
WRITE( stdout,"(4X,'Ion',4X,'Species',4X,'Charge',14X, &
& 'Position',16X,'Phase')")
WRITE(6,"(2X,76('-'))")
WRITE( stdout,"(2X,76('-'))")
DO na=1,nat
WRITE(6,"(3X,I3,8X,A2,F12.3,5X,3F8.4,F12.5,' (mod ',I1,')')") &
WRITE( stdout,"(3X,I3,8X,A2,F12.3,5X,3F8.4,F12.5,' (mod ',I1,')')") &
& na,atm(ityp(na)),zv(ityp(na)), &
& tau(1,na),tau(2,na),tau(3,na),pdl_ion(na),mod_ion(na)
END DO
WRITE(6,"(2X,76('-'))")
WRITE(6,"(47X,'IONIC PHASE: ',F9.5,' (mod ',I1,')')") pdl_ion_tot,mod_ion_tot
WRITE(6,"(2X,76('='))")
WRITE( stdout,"(2X,76('-'))")
WRITE( stdout,"(47X,'IONIC PHASE: ',F9.5,' (mod ',I1,')')") pdl_ion_tot,mod_ion_tot
WRITE( stdout,"(2X,76('='))")
! --- Information about electronic polarization phases ---
WRITE(6,"(2/,28X,'ELECTRONIC POLARIZATION')")
WRITE(6,"(28X,23('~'),/)")
WRITE(6,"(8X,'Note: (mod 1) means that the phases (angles ranging from' &
WRITE( stdout,"(2/,28X,'ELECTRONIC POLARIZATION')")
WRITE( stdout,"(28X,23('~'),/)")
WRITE( stdout,"(8X,'Note: (mod 1) means that the phases (angles ranging from' &
& /,8X,'-pi to pi) have been mapped to the interval [-1/2,+1/2) by',&
& /,8X,'dividing by 2*pi; (mod 2) refers to the interval [-1,+1)',&
& /)")
WRITE(6,"(2X,76('='))")
WRITE(6,"(3X,'Spin',4X,'String',5X,'Weight',6X, &
WRITE( stdout,"(2X,76('='))")
WRITE( stdout,"(3X,'Spin',4X,'String',5X,'Weight',6X, &
& 'First k-point in string',9X,'Phase')")
WRITE(6,"(2X,76('-'))")
WRITE( stdout,"(2X,76('-'))")
DO istring=1,nstring/nspin
ind1=1+(istring-1)*nppstr
WRITE(6,"(3X,' up ',3X,I5,F14.6,4X,3(F8.4),F12.5,' (mod ',I1,')')") &
WRITE( stdout,"(3X,' up ',3X,I5,F14.6,4X,3(F8.4),F12.5,' (mod ',I1,')')") &
& istring,wstring(istring), &
& xk(1,ind1),xk(2,ind1),xk(3,ind1),pdl_elec(istring),mod_elec(istring)
END DO
WRITE(6,"(2X,76('-'))")
WRITE( stdout,"(2X,76('-'))")
! --- Treat unpolarized/polarized spin cases ---
IF (nspin == 1) THEN
! --- In unpolarized spin, just copy again the same data ---
DO istring=1,nstring
ind1=1+(istring-1)*nppstr
WRITE(6,"(3X,'down',3X,I5,F14.6,4X,3(F8.4),F12.5,' (mod ',I1,')')") &
WRITE( stdout,"(3X,'down',3X,I5,F14.6,4X,3(F8.4),F12.5,' (mod ',I1,')')") &
istring,wstring(istring), xk(1,ind1),xk(2,ind1),xk(3,ind1), &
pdl_elec(istring),mod_elec(istring)
END DO
@ -746,34 +747,34 @@ SUBROUTINE c_phase
! --- If there is spin polarization, write information for new strings ---
DO istring=nstring/2+1,nstring
ind1=1+(istring-1)*nppstr
WRITE(6,"(3X,'down',3X,I4,F15.6,4X,3(F8.4),F12.5,' (mod ',I1,')')") &
WRITE( stdout,"(3X,'down',3X,I4,F15.6,4X,3(F8.4),F12.5,' (mod ',I1,')')") &
& istring,wstring(istring), xk(1,ind1),xk(2,ind1),xk(3,ind1), &
& pdl_elec(istring),mod_elec(istring)
END DO
END IF
WRITE(6,"(2X,76('-'))")
WRITE(6,"(40X,'Average phase (up): ',F9.5,' (mod ',I1,')')") &
WRITE( stdout,"(2X,76('-'))")
WRITE( stdout,"(40X,'Average phase (up): ',F9.5,' (mod ',I1,')')") &
pdl_elec_up,mod_elec_up
WRITE(6,"(38X,'Average phase (down): ',F9.5,' (mod ',I1,')')")&
WRITE( stdout,"(38X,'Average phase (down): ',F9.5,' (mod ',I1,')')")&
pdl_elec_dw,mod_elec_dw
WRITE(6,"(42X,'ELECTRONIC PHASE: ',F9.5,' (mod ',I1,')')") &
WRITE( stdout,"(42X,'ELECTRONIC PHASE: ',F9.5,' (mod ',I1,')')") &
pdl_elec_tot,mod_elec_tot
WRITE(6,"(2X,76('='))")
WRITE( stdout,"(2X,76('='))")
! --- Information about total phase ---
WRITE(6,"(2/,31X,'SUMMARY OF PHASES')")
WRITE(6,"(31X,17('~'),/)")
WRITE(6,"(26X,'Ionic Phase:',F9.5,' (mod ',I1,')')") &
WRITE( stdout,"(2/,31X,'SUMMARY OF PHASES')")
WRITE( stdout,"(31X,17('~'),/)")
WRITE( stdout,"(26X,'Ionic Phase:',F9.5,' (mod ',I1,')')") &
pdl_ion_tot,mod_ion_tot
WRITE(6,"(21X,'Electronic Phase:',F9.5,' (mod ',I1,')')") &
WRITE( stdout,"(21X,'Electronic Phase:',F9.5,' (mod ',I1,')')") &
pdl_elec_tot,mod_elec_tot
WRITE(6,"(26X,'TOTAL PHASE:',F9.5,' (mod ',I1,')')") &
WRITE( stdout,"(26X,'TOTAL PHASE:',F9.5,' (mod ',I1,')')") &
pdl_tot,mod_tot
! --- Information about the value of polarization ---
WRITE(6,"(2/,29X,'VALUES OF POLARIZATION')")
WRITE(6,"(29X,22('~'),/)")
WRITE(6,"( &
WRITE( stdout,"(2/,29X,'VALUES OF POLARIZATION')")
WRITE( stdout,"(29X,22('~'),/)")
WRITE( stdout,"( &
& 8X,'The calculation of phases done along the direction of vector ',I1, &
& /,8X,'of the reciprocal lattice gives the following contribution to', &
& /,8X,'the polarization vector (in different units, and being Omega', &
@ -786,22 +787,22 @@ SUBROUTINE c_phase
rmod=alat*rmod
! --- Give polarization in units of (e/Omega).bohr ---
fac=rmod
WRITE(6,"(/,11X,'P = ',F11.7,' (mod ',F11.7,') (e/Omega).bohr')") &
WRITE( stdout,"(/,11X,'P = ',F11.7,' (mod ',F11.7,') (e/Omega).bohr')") &
fac*pdl_tot,fac*float(mod_tot)
! --- Give polarization in units of e.bohr ---
fac=rmod/omega
WRITE(6,"(/,11X,'P = ',F11.7,' (mod ',F11.7,') e/bohr^2')") &
WRITE( stdout,"(/,11X,'P = ',F11.7,' (mod ',F11.7,') e/bohr^2')") &
fac*pdl_tot,fac*float(mod_tot)
! --- Give polarization in SI units (C/m^2) ---
fac=(rmod/omega)*(1.60097E-19_dp/5.29177E-11_dp**2)
WRITE(6,"(/,11X,'P = ',F11.7,' (mod ',F11.7,') C/m^2')") &
WRITE( stdout,"(/,11X,'P = ',F11.7,' (mod ',F11.7,') C/m^2')") &
fac*pdl_tot,fac*float(mod_tot)
! --- Write polarization direction ---
WRITE(6,"(/,8X,'The polarization direction is: ( ', &
WRITE( stdout,"(/,8X,'The polarization direction is: ( ', &
& F7.5,' , ',F7.5,' , ',F7.5,' )'))") upol(1),upol(2),upol(3)
! --- End of information relative to polarization calculation ---
WRITE(6,"(/,/,15X,50('=')/,/)")
WRITE( stdout,"(/,/,15X,50('=')/,/)")
! ------------------------------------------------------------------------- !

2
PW/bp_calc_btq.f90
View File

@ -74,7 +74,7 @@
qr_k(iv,jv,l+1,np) = sum*fpi/omega
qr_k(jv,iv,l+1,np) = qr_k(iv,jv,l+1,np)
!c write(6,*) 'qr_k=',qr_k(iv,jv,l+1,np)
!c WRITE( stdout,*) 'qr_k=',qr_k(iv,jv,l+1,np)
end do
end do

2
PW/bp_qvan3.f90
View File

@ -59,7 +59,7 @@
!odl Write(*,*) 'QVAN3 -- sig = ',sig
! write(*,*) 'qvan3',ng1,LP,L,ivs,jvs
! WRITE( stdout,*) 'qvan3',ng1,LP,L,ivs,jvs
qg = qg + sig * ylm_k(lp) * qr(ivs,jvs,l,is)

17
PW/c_bands.f90
View File

@ -21,6 +21,7 @@ subroutine c_bands (iter, ik_, dr2)
! c) DIIS algorithm
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom, ONLY: g, g2kin, tpiba2, ecfixed, qcutz, lda_plus_u, &
iunwfc, swfcatom, iunat, nwordatwfc, q2sigma, diis_ndim, wg, nbndx, nkstot, &
okvan, et, istep, ethr, lscf, max_cg_iter, vltot, nrxx, nr1, nr3, nr2, nbnd, &
@ -74,13 +75,13 @@ subroutine c_bands (iter, ik_, dr2)
allocate (s_diag( npwx))
if (isolve == 0) then
write (6, '(" Davidson diagonalization (with overlap)")')
WRITE( stdout, '(" Davidson diagonalization (with overlap)")')
elseif (isolve == 1) then
write (6, '(" Conjugate-gradient style diagonalization")')
WRITE( stdout, '(" Conjugate-gradient style diagonalization")')
elseif (isolve == 2) then
write (6, '(" DIIS style diagonalization")')
WRITE( stdout, '(" DIIS style diagonalization")')
if (ethr > diis_ethr_cg) &
write (6,5) diis_ethr_cg
WRITE( stdout,5) diis_ethr_cg
5 format(6x,"use conjugate-gradient method until ethr <",1pe9.2)
else
call errore ('c_bands', 'isolve not implemented', 1)
@ -181,8 +182,8 @@ subroutine c_bands (iter, ik_, dr2)
do ibnd = 1, nbnd
if ( wg(ibnd, ik) < 1.0d-4 ) btype (ibnd) = 1
end do
! write(*,'(5f12.6)')(et(ibnd,ik),ibnd=1,nbnd)
! write(*,'(20i3)')(btype(ibnd),ibnd=1,nbnd)
! WRITE( stdout,'(5f12.6)')(et(ibnd,ik),ibnd=1,nbnd)
! WRITE( stdout,'(20i3)')(btype(ibnd),ibnd=1,nbnd)
!
end if
12 continue
@ -225,7 +226,7 @@ subroutine c_bands (iter, ik_, dr2)
if (ntry.le.5.and. ( &
.not.lscf.and.notconv.gt.0.or.lscf.and.notconv.gt.5) ) goto 15
endif
if (notconv.ne.0) write (6, '(" warning : ",i3," eigenvectors not",&
if (notconv.ne.0) WRITE( stdout, '(" warning : ",i3," eigenvectors not",&
&" converged after ",i3," attemps")') notconv, ntry
if (notconv.gt.max (5, nbnd / 4) ) stop
20 continue
@ -241,7 +242,7 @@ subroutine c_bands (iter, ik_, dr2)
call poolreduce (1, avg_iter)
#endif
avg_iter = avg_iter / nkstot
write (6, 9000) ethr, avg_iter
WRITE( stdout, 9000) ethr, avg_iter
!
! deallocate work space
!

2
PW/c_gemm.f90
View File

@ -130,7 +130,7 @@ subroutine c_transpose (a, lda, b, ldb, n, m, itype, info)
s3 = irtc ()
else
write (6, * ) '*** c_transpose : parameter itype out of range'
WRITE( stdout, * ) '*** c_transpose : parameter itype out of range'
stop

4
PW/ccgdiagg.f90
View File

@ -144,7 +144,7 @@ subroutine ccgdiagg (nmax, n, nbnd, psi, e, precondition, eps, &
#endif
! Here one can test on the norm of the gradient
! if (sqrt(gg).lt. eps.or. iter.eq.maxter) go to 10
! write(6,*) iter, gg
! WRITE( stdout,*) iter, gg
if (iter.eq.1) then
!
! starting iteration, the conjugate gradient |cg> = |g>
@ -233,7 +233,7 @@ subroutine ccgdiagg (nmax, n, nbnd, psi, e, precondition, eps, &
call DAXPY (2 * n, sin (theta) / cg0, ppsi, 1, hpsi, 1)
enddo
#ifdef DEBUG
write ( * , '(" WARNING: e(",i3,") =",f10.5, &
WRITE( stdout , '(" WARNING: e(",i3,") =",f10.5, &
& "eV, is not converged to within ",1pe8.1)') m,e(m)*13.6058,eps
#endif
notconv = notconv + 1

33
PW/cdiisg.f90
View File

@ -20,6 +20,7 @@ subroutine cdiisg (ndim, ndmx, nvec, nvecx, evc, e, ethr, &
! S is an overlap matrix, evc is a complex vector.
! The band-by-band RMM-DIIS method is used.
#include "machine.h"
USE io_global, ONLY : stdout
use parameters, only : DP
use g_psi_mod
use pwcom, only : nelec, lgauss, ltetra, okvan
@ -251,13 +252,13 @@ subroutine cdiisg (ndim, ndmx, nvec, nvecx, evc, e, ethr, &
enddo
enddo
if (verb) then
write(6,*) 'overlap'
write(6,*) ((m,n,sc(n,m), n=1,nbase), m=1,nbase)
write(6,*)
write(6,*) 'rc'
write(6,*) ((m,n,rc(n,m), n=1,nbase), m=1,nbase)
write(6,*)
write(6,*) 'eigval'
WRITE( stdout,*) 'overlap'
WRITE( stdout,*) ((m,n,sc(n,m), n=1,nbase), m=1,nbase)
WRITE( stdout,*)
WRITE( stdout,*) 'rc'
WRITE( stdout,*) ((m,n,rc(n,m), n=1,nbase), m=1,nbase)
WRITE( stdout,*)
WRITE( stdout,*) 'eigval'
endif
@ -269,14 +270,14 @@ subroutine cdiisg (ndim, ndmx, nvec, nvecx, evc, e, ethr, &
if (verb) then
do n=1, nbase
write(6,*) n,ew(n)
WRITE( stdout,*) n,ew(n)
enddo
write(6,*)
WRITE( stdout,*)
do n=1,nbase
enddo
write(6,*) 'eigvec'
WRITE( stdout,*) 'eigvec'
do n=1, nbase
write(6,*) n, vc(n)
WRITE( stdout,*) n, vc(n)
enddo
endif
@ -292,7 +293,7 @@ subroutine cdiisg (ndim, ndmx, nvec, nvecx, evc, e, ethr, &
nvecx, vc , nvecx, (0.d0, 0.d0), vcn (1, 1), nvecx)
ec = ec / DREAL( ZDOTC (nvecx, vc, 1, vcn (1, 1), 1) )
if (verb) write(6,*) 'NORM RES=',snorm,'DELTA EIG=',ec-e(ib)
if (verb) WRITE( stdout,*) 'NORM RES=',snorm,'DELTA EIG=',ec-e(ib)
!
! Convergence?
@ -320,7 +321,7 @@ subroutine cdiisg (ndim, ndmx, nvec, nvecx, evc, e, ethr, &
call ZGEMM ('n', 'n', ndim, 1, nbase, (1.d0, 0d0), psi, &
ndmx, vc , nvecx, (0.d0, 0.d0), evc (1, ib), ndmx)
if (verb) write(6,*) 'rotate band ',ib
if (verb) WRITE( stdout,*) 'rotate band ',ib
minter = kter + 1
goto 10
endif
@ -332,14 +333,14 @@ subroutine cdiisg (ndim, ndmx, nvec, nvecx, evc, e, ethr, &
diis_iter = diis_iter + kter
if (kter .gt. maxter) then
write (6, '(" WARNING: eigenvalue ",i5," not converged")') &
WRITE( stdout, '(" WARNING: eigenvalue ",i5," not converged")') &
ib
else
notcnv = notcnv - 1
minter = 1
if (verb) then
write(6,*) 'BAND ',ib, ' CONVERGED'
write(6,*)
WRITE( stdout,*) 'BAND ',ib, ' CONVERGED'
WRITE( stdout,*)
endif
endif
!

15
PW/cegterg.f90
View File

@ -19,6 +19,7 @@ subroutine cegterg (ndim, ndmx, nvec, nvecx, evc, ethr, overlap, &
! S is an overlap matrix, evc is a complex vector
!
#include "machine.h"
USE io_global, ONLY : stdout
use parameters, only : DP
use g_psi_mod
@ -99,7 +100,7 @@ subroutine cegterg (ndim, ndmx, nvec, nvecx, evc, ethr, overlap, &
allocate(ew (nvecx))
allocate(conv (nvec))
! write(6,*) 'eneter cegter',hc,vc,hpsi
! WRITE( stdout,*) 'eneter cegter',hc,vc,hpsi
if (nvec > nvecx / 2) call errore ('cegter', 'nvecx is too small',1)
!
! prepare the hamiltonian for the first iteration
@ -202,7 +203,7 @@ subroutine cegterg (ndim, ndmx, nvec, nvecx, evc, ethr, overlap, &
#ifdef __PARA
call reduce (nvec, ew)
#endif
write (6,'(a,18f10.6)') 'NRM=',(ew(n),n=1,nvec)
WRITE( stdout,'(a,18f10.6)') 'NRM=',(ew(n),n=1,nvec)
#endif
!
! "normalize" correction vectors psi(*,nbase+1:nbase+notcnv) in order
@ -268,9 +269,9 @@ subroutine cegterg (ndim, ndmx, nvec, nvecx, evc, ethr, overlap, &
enddo
call cdiaghg (nbase, nvec, hc, sc, nvecx, ew, vc)
#ifdef DEBUG_DAVIDSON
write (6,'(a,18f10.6)') 'EIG=',(e(n),n=1,nvec)
write (6,'(a,18f10.6)') 'EIG=',(ew(n),n=1,nvec)
write (6,*)
WRITE( stdout,'(a,18f10.6)') 'EIG=',(e(n),n=1,nvec)
WRITE( stdout,'(a,18f10.6)') 'EIG=',(ew(n),n=1,nvec)
WRITE( stdout,*)
#endif
!
! test for convergence
@ -306,11 +307,11 @@ subroutine cegterg (ndim, ndmx, nvec, nvecx, evc, ethr, overlap, &
!
#ifdef DEBUG_DAVIDSON
do n = 1, nvec
if ( .not.conv (n) ) write (6, '(" WARNING: e(",i3,") =",&
if ( .not.conv (n) ) WRITE( stdout, '(" WARNING: e(",i3,") =",&
f10.5," is not converged to within ",1pe8.1)') n, e(n), ethr
enddo
#else
write (6, '(" WARNING: ",i5," eigenvalues not converged")') &
WRITE( stdout, '(" WARNING: ",i5," eigenvalues not converged")') &
notcnv
#endif
call stop_clock ('last')

18
PW/cft_3.f90
View File

@ -388,15 +388,15 @@ subroutine cft_3(f,nr1,nr2,nr3,nrx1,nrx2,nrx3,igrid,sign)
if (first(igrid)) then
isw=0
first(igrid)=.false.
! write(6,*)'________________________________________________________'
! write(6,*) 'igrid = ',igrid
! write(6,*) ' nrxs => ',nrx1,nrx2,nrx3
! write(6,*) ' nrzs => ',nrz1(igrid),nrz2(igrid),nrz3(igrid)
! write(6,*) ' nrs => ',nr1,nr2,nr3
! write(6,*)'size(auxp)',size(auxp,1),size(auxp,2)
! write(6,*)'size(cw1)',size(cw1)
! write(6,*)'size(iw)',size(iw)
! write(6,*)'________________________________________________________'
! WRITE( stdout,*)'________________________________________________________'
! WRITE( stdout,*) 'igrid = ',igrid
! WRITE( stdout,*) ' nrxs => ',nrx1,nrx2,nrx3
! WRITE( stdout,*) ' nrzs => ',nrz1(igrid),nrz2(igrid),nrz3(igrid)
! WRITE( stdout,*) ' nrs => ',nr1,nr2,nr3
! WRITE( stdout,*)'size(auxp)',size(auxp,1),size(auxp,2)
! WRITE( stdout,*)'size(cw1)',size(cw1)
! WRITE( stdout,*)'size(iw)',size(iw)
! WRITE( stdout,*)'________________________________________________________'
#ifdef ASL
#if defined MICRO
call hfc3fb(nr1,nr2,nr3,f1,nrz1(igrid),nrz2(igrid),nrz3(igrid),&

2
PW/cft_t3e.f90
View File

@ -91,7 +91,7 @@ subroutine cft_2 (f, mplane, n1, n2, nx1, nx2, sgn)
scale = 1.d0
! write(6,*)'in cft_2 ',n1,n2,nx1,nx2
! WRITE( stdout,*)'in cft_2 ',n1,n2,nx1,nx2
if (isign.gt.0) then

5
PW/check.f90
View File

@ -11,6 +11,7 @@
subroutine check (size, ps)
!-----------------------------------------------------------------------
#include "machine.h"
USE io_global, ONLY : stdout
use parameters, only : DP
#ifdef __PARA
use para
@ -45,8 +46,8 @@ subroutine check (size, ps)
if (chisq.ne.0.d0) then
! call errore('check','WARNING, using first proc. data',-1)
write (6, * ) '*** WARNING, using first proc. data ***'
write (6, '(5x,"chisq = ",1pe9.2)') chisq
WRITE( stdout, * ) '*** WARNING, using first proc. data ***'
WRITE( stdout, '(5x,"chisq = ",1pe9.2)') chisq
call mpi_bcast (ps, size, MPI_REAL8, 0, MPI_COMM_WORLD, info)
call errore ('check', 'at the first broadcast', info)

7
PW/compute_dip.f90
View File

@ -12,6 +12,7 @@ subroutine compute_dip(dip, dipion, z0)
! the electric field. (This routine is called only if tefield is true)
! The direction is the reciprocal lattice vector bg(.,edir)
!
USE io_global, ONLY : stdout
use pwcom
#ifdef __PARA
use para
@ -88,9 +89,9 @@ subroutine compute_dip(dip, dipion, z0)
enddo
dipol=dipol*alat*omega/nr1/nr2/nr3
write(6,'(5x,"electron", 3f15.5)') dipol(1), dipol(2), dipol(3)
write(6,'(5x,"ion ", 3f15.5)') dipol_ion(1), dipol_ion(2), dipol_ion(3)
write(6,'(5x,"total ", 3f15.5)') dipol_ion(1)-dipol(1), &
WRITE( stdout,'(5x,"electron", 3f15.5)') dipol(1), dipol(2), dipol(3)
WRITE( stdout,'(5x,"ion ", 3f15.5)') dipol_ion(1), dipol_ion(2), dipol_ion(3)
WRITE( stdout,'(5x,"total ", 3f15.5)') dipol_ion(1)-dipol(1), &
dipol_ion(2)-dipol(2), &
dipol_ion(3)-dipol(3)

17
PW/data_structure.f90
View File

@ -13,6 +13,7 @@ subroutine data_structure( lgamma )
! This version computes also the smooth and hard mesh
!
#include "machine.h"
USE io_global, ONLY : stdout
use sticks, only: dfftp, dffts
use pwcom, only: dp, bg, xk, nks, tpiba, ecutwfc, ngm, ngms, ngm_l, ngm_g, &
ngms_l, ngms_g, nrxx, nrxxs, gcutm, gcutms, &
@ -123,7 +124,7 @@ subroutine data_structure( lgamma )
!
#ifdef DEBUG
write (6, '(5x,"ecutrho & ecutwfc",2f12.2)') tpiba2 * gcutm, &
WRITE( stdout, '(5x,"ecutrho & ecutwfc",2f12.2)') tpiba2 * gcutm, &
tpiba2 * gkcut
#endif
!
@ -232,24 +233,24 @@ subroutine data_structure( lgamma )
npp ( 1 : nproc_pool ) = dfftp%npp ( 1 : nproc_pool )
npps( 1 : nproc_pool ) = dffts%npp ( 1 : nproc_pool )
write (6, '(/5x,"Planes per process (thick) : nr3 =", &
WRITE( stdout, '(/5x,"Planes per process (thick) : nr3 =", &
& i3," npp = ",i3," ncplane =",i5)') nr3, npp (me_pool + 1) , ncplane
if ( nr3s /= nr3 ) write (6, '(/5x,"Planes per process (smooth): nr3s=",&
if ( nr3s /= nr3 ) WRITE( stdout, '(/5x,"Planes per process (smooth): nr3s=",&
&i3," npps= ",i3," ncplanes=",i5)') nr3s, npps (me_pool + 1) , ncplanes
write(6,*)
write(6,'( &
WRITE( stdout,*)
WRITE( stdout,'( &
& '' Proc/ planes cols G planes cols G columns G''/ &
& '' Pool (dense grid) (smooth grid) (wavefct grid)'')')
do i=1,nproc_pool
write(6,'(i3,2x,3(i5,2i7))') i, npp(i), ncp(i), ngp(i), &
WRITE( stdout,'(i3,2x,3(i5,2i7))') i, npp(i), ncp(i), ngp(i), &
& npps(i), ncps(i), ngps(i), nkcp(i), ngkp(i)
end do
write(6,'(i3,2x,3(i5,2i7))') 0, SUM(npp(1:nproc_pool)), SUM(ncp(1:nproc_pool)), &
WRITE( stdout,'(i3,2x,3(i5,2i7))') 0, SUM(npp(1:nproc_pool)), SUM(ncp(1:nproc_pool)), &
& SUM(ngp(1:nproc_pool)), SUM(npps(1:nproc_pool)), SUM(ncps(1:nproc_pool)), &
& SUM(ngps(1:nproc_pool)), SUM(nkcp(1:nproc_pool)), SUM(ngkp(1:nproc_pool))
write(6,*)
WRITE( stdout,*)
DEALLOCATE( stw, st, sts, in1, in2, index, ngc, ngcs, ngkc )

3
PW/davcio.f90
View File

@ -13,6 +13,7 @@ subroutine davcio (vect, nword, unit, nrec, io)
! direct-access vector input/output
! read/write nword words starting from the address specified by vect
!
USE io_global, ONLY : stdout
use parameters
implicit none
integer :: nword, unit, nrec, io
@ -42,7 +43,7 @@ implicit none
call errore ('davcio', 'nothing to do?', - 1)
endif
if (ios.ne.0) then
write (6, * ) ' IOS = ', ios
WRITE( stdout, * ) ' IOS = ', ios
call errore ('davcio', 'i/o error in davcio', unit)
endif
call stop_clock ('davcio')

2
PW/dprojdepsilon.f90
View File

@ -63,7 +63,7 @@ subroutine dprojdepsilon ( ik,dproj,wfcatom,spsi,ipol,jpol )
end do
dproj(:,:) = (0.d0,0.d0)
! write(6,*) 'dprojde: ik =',ik,' ipol =',ipol,' jpol =',jpol
! WRITE( stdout,*) 'dprojde: ik =',ik,' ipol =',ipol,' jpol =',jpol
!
! At first the derivatives of the atomic wfcs: we compute the term
! <d\fi^{at}_{I,m1}/d\epsilon(ipol,jpol)|S|\psi_{k,v,s}>

21
PW/dynamics.f90
View File

@ -29,6 +29,7 @@ subroutine dynamics
! DA 1997
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
use io_files, only : prefix
#ifdef __PARA
@ -61,13 +62,13 @@ subroutine dynamics
call seqopn (4, trim(prefix)//'.md', 'formatted', exst)
if (.not.exst) then
close (unit = 4, status = 'delete')
write (6, '(/5x,"Starting temperature = ",f8.2," K")') &
WRITE( stdout, '(/5x,"Starting temperature = ",f8.2," K")') &
temperature
do na = 1, ntyp
write (6, '(5x,"amass(",i1,") = ",f6.2)') na, amass (na)
WRITE( stdout, '(5x,"amass(",i1,") = ",f6.2)') na, amass (na)
enddo
write (6, '(5x,"Time step = ",f6.2," a.u., ",f6.4, &
WRITE( stdout, '(5x,"Time step = ",f6.2," a.u., ",f6.4, &
& " femto-seconds")') dt, dt * 0.0484
!
! masses in atomic rydberg units
@ -93,18 +94,18 @@ subroutine dynamics
it = it + 1
if (mod (it, nraise) .eq.0.and.delta_T.lt.0) then
write (6, '(/5x,"Thermalization: delta_T = ",f6.3, &
WRITE( stdout, '(/5x,"Thermalization: delta_T = ",f6.3, &
& ", T = ",f6.1)') - delta_T, temp_new - delta_T
call thermalize (temp_new, temp_new - delta_T, tauold)
endif
if (delta_T.ne.1.d0.and.delta_T.ge.0) then
write (6, '(/5x,"Thermalization: delta_T = ",f6.3, &
WRITE( stdout, '(/5x,"Thermalization: delta_T = ",f6.3, &
& ", T = ",f6.1)') delta_T, temp_new * delta_T
call thermalize (temp_new, temp_new * delta_T, tauold)
endif
write (6, '(/5x,"Entering Dynamics; it = ",i5," time = ", &
WRITE( stdout, '(/5x,"Entering Dynamics; it = ",i5," time = ", &
& f8.5," pico-seconds"/)') it, tempo
!
! calculate accelerations in a.u. units / alat
@ -161,10 +162,10 @@ subroutine dynamics
write (4, * ) temp_new, mass, total_mass, tauold, tempo, it
close (unit = 4, status = 'keep')
do na = 1, nat
write (6, '(a3,3f12.7)') atm(ityp(na)),&
WRITE( stdout, '(a3,3f12.7)') atm(ityp(na)),&
(tau (ipol, na) , ipol = 1, 3)
enddo
write (6, '(/5x,"Ekin = ",f14.8," Ryd T = ",f6.1," K ", &
WRITE( stdout, '(/5x,"Ekin = ",f14.8," Ryd T = ",f6.1," K ", &
& " Etot = ",f14.8)') ekin*alat**2, temp_new, ekin*alat**2+etot
!
! total linear momentum must be zero if all atoms move
@ -174,7 +175,7 @@ subroutine dynamics
if (mlt.gt.eps) call errore ('dynamics', 'Total linear momentum <> 0', - 1)
endif
write (6, '(5x,"Linear momentum: ",3f18.14)') ml
WRITE( stdout, '(5x,"Linear momentum: ",3f18.14)') ml
deallocate (tauold)
deallocate (a)
@ -441,7 +442,7 @@ subroutine find_alpha_and_beta (nat, tau, tauold, alpha0, beta0)
enddo
enddo
! write ( *, * ) chi, alpha0, beta0
! WRITE( stdout, * ) chi, alpha0, beta0
return
end subroutine find_alpha_and_beta

3
PW/efermig.f90
View File

@ -11,6 +11,7 @@ subroutine efermig (et, nbnd, nks, nelec, wk, Degauss, Ngauss, Ef)
!
! Finds the Fermi energy - Gaussian Broadening (Methfessel-Paxton)
!
USE io_global, ONLY : stdout
use parameters
implicit none
integer :: nks, nbnd, i, kpoint, Ngauss
@ -53,7 +54,7 @@ subroutine efermig (et, nbnd, nks, nelec, wk, Degauss, Ngauss, Ef)
Eup = Ef
endif
enddo
write (6, '(5x,"Warning: too many iterations in bisection"/ &
WRITE( stdout, '(5x,"Warning: too many iterations in bisection"/ &
& 5x,"Ef = ",f10.6," sumk = ",f10.6," electrons")' ) &
Ef * 13.6058, sumkmid
!

5
PW/efermit.f90
View File

@ -13,6 +13,7 @@ subroutine efermit (et, nbnd, nks, nelec, nspin, ntetra, &
!
! Finds the Fermi energy - tetrahedron method (Bloechl)
!
USE io_global, ONLY : stdout
use parameters
implicit none
integer :: nks, nbnd, nspin, ntetra, tetra (4, ntetra)
@ -94,12 +95,12 @@ subroutine efermit (et, nbnd, nks, nelec, nspin, ntetra, &
ef = efbetter
sumkmid = sumkt (et, nbnd, nks, nspin, ntetra, tetra, ef)
write (6, 9010) ef * rydtoev, sumkmid
WRITE( stdout, 9010) ef * rydtoev, sumkmid
! converged exit:
100 continue
! Check if Fermi level is above any of the highest eigenvalues
do ik = 1, nks
if (ef.gt.et (nbnd, ik) + 1.d-4) write (6, 9020) ef * rydtoev, ik, &
if (ef.gt.et (nbnd, ik) + 1.d-4) WRITE( stdout, 9020) ef * rydtoev, ik, &
et (nbnd, ik) * rydtoev
enddo

59
PW/electrons.f90
View File

@ -22,6 +22,7 @@ SUBROUTINE electrons
! the separate contributions.
!
USE parameters, ONLY : DP, npk
USE io_global, ONLY : stdout
USE brilz, ONLY : at, bg, alat, omega, tpiba2
USE basis, ONLY : nat, ntyp, ityp, tau
USE gvect, ONLY : ngm, gstart, nr1, nr2, nr3, nrx1, nrx2, nrx3, &
@ -152,15 +153,15 @@ SUBROUTINE electrons
DO idum = 1, niter
!
tcpu = get_clock( 'PWSCF' )
WRITE(6, 9000) tcpu
WRITE( stdout, 9000) tcpu
IF ( imix >= 0 ) CALL DCOPY( ( nspin * nrxx), rho, 1, rho_save, 1 )
!
iter = iter + 1
!
IF ( lscf ) THEN
WRITE(6, 9010) iter, ecutwfc, mixing_beta
WRITE( stdout, 9010) iter, ecutwfc, mixing_beta
ELSE
WRITE(6, 9009)
WRITE( stdout, 9009)
END IF
#ifdef FLUSH
CALL flush( 6 )
@ -195,11 +196,11 @@ SUBROUTINE electrons
#endif
DO ik = 1, nkstot
IF ( lsda ) THEN
IF ( ik == 1 ) WRITE(6, 9015)
IF ( ik == ( 1 + nkstot / 2 ) ) WRITE(6, 9016)
IF ( ik == 1 ) WRITE( stdout, 9015)
IF ( ik == ( 1 + nkstot / 2 ) ) WRITE( stdout, 9016)
END IF
WRITE(6, 9020) ( xk(i,ik), i = 1, 3 )
WRITE(6, 9030) ( et(ibnd,ik) * 13.6058, ibnd = 1, nbnd )
WRITE( stdout, 9020) ( xk(i,ik), i = 1, 3 )
WRITE( stdout, 9030) ( et(ibnd,ik) * 13.6058, ibnd = 1, nbnd )
END DO
!
! ... do a Berry phase polarization calculation if required
@ -217,7 +218,7 @@ SUBROUTINE electrons
tcpu = get_clock( 'PWSCF' )
!
IF ( tcpu > time_max ) THEN
WRITE(6, '(5x,"Maximum CPU time exceeded",2f15.2)') tcpu, time_max
WRITE( stdout, '(5x,"Maximum CPU time exceeded",2f15.2)') tcpu, time_max
CALL stop_pw ( .FALSE. )
END IF
!
@ -337,26 +338,26 @@ SUBROUTINE electrons
!
DO ik = 1, nkstot
IF ( lsda ) THEN
IF ( ik == 1 ) WRITE(6, 9015)
IF ( ik == ( 1 + nkstot / 2 ) ) WRITE(6, 9016)
IF ( ik == 1 ) WRITE( stdout, 9015)
IF ( ik == ( 1 + nkstot / 2 ) ) WRITE( stdout, 9016)
END IF
IF ( conv_elec ) THEN
#ifdef __PARA
WRITE(6, 9021) (xk(i,ik), i = 1, 3), ngkp(ik)
WRITE( stdout, 9021) (xk(i,ik), i = 1, 3), ngkp(ik)
#else
WRITE(6, 9021) (xk(i,ik), i = 1, 3), ngk(ik)
WRITE( stdout, 9021) (xk(i,ik), i = 1, 3), ngk(ik)
#endif
ELSE
WRITE(6, 9020) (xk(i,ik), i = 1, 3)
WRITE( stdout, 9020) (xk(i,ik), i = 1, 3)
END IF
WRITE(6, 9030) (et(ibnd,ik) * 13.6058, ibnd = 1, nbnd)
WRITE( stdout, 9030) (et(ibnd,ik) * 13.6058, ibnd = 1, nbnd)
END DO
!
IF ( lgauss .OR. ltetra ) WRITE(6, 9040) ef * 13.6058
IF ( lgauss .OR. ltetra ) WRITE( stdout, 9040) ef * 13.6058
!
END IF
!
IF ( ( ABS( charge - nelec ) / charge ) > 1.0E-7 ) WRITE(6, 9050) charge
IF ( ( ABS( charge - nelec ) / charge ) > 1.0E-7 ) WRITE( stdout, 9050) charge
!
etot = eband + ( etxc - etxcc ) + ewld + ehart + deband + demet + eth
!
@ -366,42 +367,42 @@ SUBROUTINE electrons
iswitch <= 2 ) THEN
!
IF ( imix >= 0 ) THEN
WRITE(6, 9081) etot, dr2
WRITE( stdout, 9081) etot, dr2
ELSE
WRITE(6, 9086) etot, dr2
WRITE( stdout, 9086) etot, dr2
END IF
!
WRITE(6, 9060) eband, ( eband + deband ), ehart, ( etxc - etxcc ), ewld
WRITE( stdout, 9060) eband, ( eband + deband ), ehart, ( etxc - etxcc ), ewld
!
IF ( tefield ) WRITE(6, 9061) etotefield
IF ( lda_plus_u ) WRITE(6, 9065) eth
IF ( degauss /= 0.0 ) WRITE(6, 9070) demet
IF ( tefield ) WRITE( stdout, 9061) etotefield
IF ( lda_plus_u ) WRITE( stdout, 9065) eth
IF ( degauss /= 0.0 ) WRITE( stdout, 9070) demet
!
ELSE IF ( conv_elec .AND. iswitch > 2 ) THEN
!
IF ( imix >= 0 ) THEN
WRITE(6, 9081) etot, dr2
WRITE( stdout, 9081) etot, dr2
ELSE
WRITE(6, 9086) etot, dr2
WRITE( stdout, 9086) etot, dr2
END IF
!
ELSE
!
IF ( imix >= 0 ) THEN
WRITE(6, 9080) etot, dr2
WRITE( stdout, 9080) etot, dr2
ELSE
WRITE(6, 9085) etot, dr2
WRITE( stdout, 9085) etot, dr2
END IF
!
END IF
!
IF ( lsda ) WRITE(6, 9017) magtot, absmag
IF ( lsda ) WRITE( stdout, 9017) magtot, absmag
!
#ifdef FLUSH
CALL flush( 6 )
#endif
IF ( conv_elec ) THEN
WRITE(6, 9110)
WRITE( stdout, 9110)
! jump to the end
IF ( output_drho /= ' ' ) CALL remove_atomic_rho
CALL stop_clock( 'electrons' )
@ -417,7 +418,7 @@ SUBROUTINE electrons
!
END DO
!
WRITE(6, 9120)
WRITE( stdout, 9120)
!
! <------- jump here if not scf
!

15
PW/error.f90
View File

@ -23,6 +23,7 @@ subroutine errore (routin, messag, ierr)
! For ibm sp machines, we write to the standard error, unit 0
! (this will appear in the error files produced by loadleveler).
!
USE io_global, ONLY : stdout
use parameters
implicit none
#ifdef __PARA
@ -35,11 +36,11 @@ subroutine errore (routin, messag, ierr)
integer :: ierr
! the error flag
if (ierr.eq.0) return
write (6, * ) ' '
write (6, '(1x,78("%"))')
write ( * , '(5x,"from ",a," : error #",i10)') routin, ierr
write ( * , '(5x,a)') messag
write (6, '(1x,78("%"))')
WRITE( stdout, * ) ' '
WRITE( stdout, '(1x,78("%"))')
WRITE( stdout , '(5x,"from ",a," : error #",i10)') routin, ierr
WRITE( stdout , '(5x,a)') messag
WRITE( stdout, '(1x,78("%"))')
#ifdef __PARA
#ifdef __AIX
write (0, * ) ' '
@ -50,7 +51,7 @@ subroutine errore (routin, messag, ierr)
#endif
#endif
if (ierr.gt.0) then
write ( * , '(" stopping ...")')
WRITE( stdout , '(" stopping ...")')
#ifdef FLUSH
call flush (6)
#endif
@ -59,7 +60,7 @@ subroutine errore (routin, messag, ierr)
#endif
stop 2
else
write (6, * ) ' '
WRITE( stdout, * ) ' '
return
endif
end subroutine errore

2
PW/ewald.f90
View File

@ -162,7 +162,7 @@ function ewald (alat, nat, ntyp, ityp, zv, at, bg, tau, omega, g, &
#endif
! call reduce (1,ewaldr)
! call reduce (1,ewaldg)
! write(6,'(/5x,"alpha used in ewald term: ",f4.2/
! WRITE( stdout,'(/5x,"alpha used in ewald term: ",f4.2/
! + 5x,"R-space term: ",f12.7,5x,"G-space term: ",f12.7/)')
! + alpha, ewaldr, ewaldg
return

17
PW/forces.f90
View File

@ -22,6 +22,7 @@ SUBROUTINE forces
!
!
USE parameters, ONLY : DP
USE io_global, ONLY : stdout
USE brilz, ONLY : at, bg, alat, omega
USE basis, ONLY : nat, ntyp, ityp, tau
USE gvect, ONLY : ngm, gstart, nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, &
@ -62,7 +63,7 @@ SUBROUTINE forces
forcescc(:,:) = 0.D0
forceh(:,:) = 0.D0
!
WRITE(6, '(/,5x,"Forces acting on atoms (Ry/au):", / )')
WRITE( stdout, '(/,5x,"Forces acting on atoms (Ry/au):", / )')
!
! ... The nonlocal contribution is computed here
!
@ -106,7 +107,7 @@ SUBROUTINE forces
IF ( tefield ) force(ipol,na) = force(ipol,na) + forcefield(ipol,na)
sum = sum + force(ipol, na)
END DO
! WRITE(6,*) 'sum = ', sum
! WRITE( stdout,*) 'sum = ', sum
!
! ... impose total force = 0
!
@ -134,16 +135,16 @@ SUBROUTINE forces
! ... write on output the forces
!
DO na = 1, nat
WRITE(6, 9035) na, ityp(na), ( force(ipol,na), ipol = 1, 3 )
WRITE( stdout, 9035) na, ityp(na), ( force(ipol,na), ipol = 1, 3 )
enddo
#ifdef DEBUG
WRITE(6, '(5x,"The SCF correction term to forces")')
WRITE( stdout, '(5x,"The SCF correction term to forces")')
DO na = 1, nat
WRITE(6, 9035) na, ityp(na), ( forcescc(ipol,na), ipol = 1, 3 )
WRITE( stdout, 9035) na, ityp(na), ( forcescc(ipol,na), ipol = 1, 3 )
END DO
WRITE(6, '(5x,"The Hubbard contribution to forces")')
WRITE( stdout, '(5x,"The Hubbard contribution to forces")')
DO na = 1, nat
WRITE(6, 9035) na, ityp(na), ( forceh(ipol,na), ipol = 1, 3 )
WRITE( stdout, 9035) na, ityp(na), ( forceh(ipol,na), ipol = 1, 3 )
END DO
#endif
!
@ -157,7 +158,7 @@ SUBROUTINE forces
END DO
END DO
!
WRITE(6, '(/5x,"Total force = ",F12.6,5X, &
WRITE( stdout, '(/5x,"Total force = ",F12.6,5X, &
& "Total SCF correction = ",F12.6)') SQRT(sum), SQRT(sumscf)
#ifdef __PARA
CALL check( ( 3 * nat ), force )

3
PW/gen_at_dj.f90
View File

@ -14,6 +14,7 @@ subroutine gen_at_dj ( kpoint, natw, lmax_wfc, dwfcat )
! is needed in computing the internal stress tensor.
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
implicit none
!
@ -127,7 +128,7 @@ subroutine gen_at_dj ( kpoint, natw, lmax_wfc, dwfcat )
enddo
if (iatw.ne.natw) then
write(6,*) 'iatw =',iatw,'natw =',natw
WRITE( stdout,*) 'iatw =',iatw,'natw =',natw
call errore('gen_at_dj','unexpected error',1)
end if

3
PW/gen_at_dy.f90
View File

@ -14,6 +14,7 @@ subroutine gen_at_dy ( ik, natw, lmax_wfc, u, dwfcat )
! is needed in computing the the internal stress tensor.
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
implicit none
!
@ -128,7 +129,7 @@ subroutine gen_at_dy ( ik, natw, lmax_wfc, u, dwfcat )
enddo
if (iatw.ne.natw) then
write(6,*) 'iatw =',iatw,'natw =',natw
WRITE( stdout,*) 'iatw =',iatw,'natw =',natw
call errore('gen_at_dy','unexpected error',1)
end if

3
PW/gen_us_dy.f90
View File

@ -13,6 +13,7 @@ subroutine gen_us_dy (ik, u, dvkb)
! derivative of the spherical harmonics projected on vector u
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
implicit none
!
@ -108,7 +109,7 @@ subroutine gen_us_dy (ik, u, dvkb)
enddo
if (ikb.ne.nkb) then
write ( *, * ) ikb, nkb
WRITE( stdout, * ) ikb, nkb
call errore ('gen_us_dy', 'unexpected error', 1)
endif

2
PW/ggen.f90
View File

@ -145,7 +145,7 @@ subroutine ggen
deallocate( igsrt )
! write(6, fmt="(//,' --- Executing new GGEN Loop ---',//)" )
! WRITE( stdout, fmt="(//,' --- Executing new GGEN Loop ---',//)" )
allocate(esort(ngm) )
esort(:) = 1.0d20

9
PW/init_run.f90
View File

@ -9,6 +9,7 @@
SUBROUTINE init_run
!-----------------------------------------------------------------------
!
USE io_global, ONLY : stdout
USE parameters, ONLY : ntypx, npk, lmaxx, nchix, ndm, nbrx, nqfm
USE wvfct, ONLY : gamma_only
!
@ -18,13 +19,13 @@ SUBROUTINE init_run
CALL start_clock( 'init_run' )
!
IF ( gamma_only ) THEN
WRITE(6, '(/5X,"Ultrasoft (Vanderbilt) Pseudopotentials, ", &
WRITE( stdout, '(/5X,"Ultrasoft (Vanderbilt) Pseudopotentials, ", &
& "Gamma point")')
ELSE
WRITE(6, '(/5X,"Ultrasoft (Vanderbilt) Pseudopotentials")')
WRITE( stdout, '(/5X,"Ultrasoft (Vanderbilt) Pseudopotentials")')
END IF
!
WRITE(6, 9010) ntypx, npk, lmaxx, nchix, ndm, nbrx, nqfm
WRITE( stdout, 9010) ntypx, npk, lmaxx, nchix, ndm, nbrx, nqfm
!
CALL iosys
CALL setup
@ -51,7 +52,7 @@ SUBROUTINE init_run
CALL wfcinit
!
CALL stop_clock ( 'init_run' )
WRITE(6, * )
WRITE( stdout, * )
!
CALL show_memory()
!

2
PW/init_us_1.f90
View File

@ -234,7 +234,7 @@ subroutine init_us_1
call qvan2 (1, ih, jh, nt, gg, qgm, ylmk0)
qq (ih, jh, nt) = omega * DREAL (qgm (1) )
qq (jh, ih, nt) = qq (ih, jh, nt)
! write(6,*) ih,jh,nt,qq(ih,jh,nt)
! WRITE( stdout,*) ih,jh,nt,qq(ih,jh,nt)
enddo
enddo
endif

14
PW/input.f90
View File

@ -18,6 +18,8 @@ SUBROUTINE iosys
! independent input parser
!
!
USE io_global, ONLY : stdout
USE constants, ONLY : AU, eV_to_kelvin
USE bp, ONLY : nppstr_ => nppstr, &
gdir_ => gdir, &
lberry_ => lberry
@ -170,11 +172,11 @@ SUBROUTINE iosys
!
IF ( tefield .AND. ( .NOT. nosym ) ) THEN
nosym = .TRUE.
WRITE(6,'(5x,"Presently no symmetry can be used with electric field",/)')
WRITE( stdout,'(5x,"Presently no symmetry can be used with electric field",/)')
END IF
IF ( tefield .AND. ( tstress ) ) THEN
tstress = .FALSE.
WRITE(6,'(5x,"Presently stress not available with electric field",/)')
WRITE( stdout,'(5x,"Presently stress not available with electric field",/)')
END IF
IF ( tefield .AND. ( nspin == 2 ) ) THEN
CALL errore('input','LSDA not available with electric field',1)
@ -232,9 +234,9 @@ SUBROUTINE iosys
lsda = ( nspin == 2 )
!noncolin = ( nspin == 4 )
IF (noncolin) THEN
write(*,*) 'noncolin = true'
WRITE( stdout,*) 'noncolin = true'
ELSE
write(*,*) 'noncolin = false'
WRITE( stdout,*) 'noncolin = false'
ENDIF
!
@ -726,8 +728,8 @@ SUBROUTINE iosys
!
CALL verify_tmpdir
!
! WRITE (6,'(/5x,"current restart_mode = ",a)') TRIM( restart_mode )
! WRITE (6,'( 5x,"current disk_io mode = ",a)') TRIM( disk_io )
! WRITE( stdout,'(/5x,"current restart_mode = ",a)') TRIM( restart_mode )
! WRITE( stdout,'( 5x,"current disk_io mode = ",a)') TRIM( disk_io )
CALL restart_from_file
!
IF ( startingconfig == 'file' ) CALL read_config_from_file

21
PW/linmin.f90
View File

@ -44,6 +44,7 @@ subroutine linmin (xold, eold, deold, xtot, etot, detot, xnew, &
! In any case, if the new estimated position is too far, better take an
! additional reduced step and see what happens
!
USE io_global, ONLY : stdout
use parameters
implicit none
! Input
@ -58,7 +59,7 @@ subroutine linmin (xold, eold, deold, xtot, etot, detot, xnew, &
real(kind=DP) :: b, c, c2, d, dbc2, dx, x, enew
write (6, 100) eold, etot, deold, detot
WRITE( stdout, 100) eold, etot, deold, detot
if (deold.gt.0) call errore ('linmin', 'search direction is up-hill &
&', 1)
@ -81,13 +82,13 @@ subroutine linmin (xold, eold, deold, xtot, etot, detot, xnew, &
!
! NB: since deold.lt.0, dbc2.gt.1.d0 may occour only if detot.lt.0 !!
!
write (6, '(5x,"linmin: no 3rd order solution")')
WRITE( stdout, '(5x,"linmin: no 3rd order solution")')
x = - sign (999.d0, d)
!
! 2nd order solution: x = -b/(2.d0*c2)
!
elseif (abs (dbc2) .lt.1.d-2) then
write (6, 110)
WRITE( stdout, 110)
110 format (5x,'linmin: 2nd order interpolation', &
& ' plus 3rd order corrections')
x = - b / (2.d0 * c) * (1.d0 + dbc2 / 2.d0)
@ -97,12 +98,12 @@ subroutine linmin (xold, eold, deold, xtot, etot, detot, xnew, &
!
x = c * ( - 1.d0 + sign (1.d0, c) * sqrt (1.d0 - dbc2) ) &
/ 3.d0 / d
write (6, '(5x,"linmin: 3rd order interpolation")')
WRITE( stdout, '(5x,"linmin: 3rd order interpolation")')
endif
!c write(6,'(5x,"b, c, d, dbc2 =",4f12.6)') b, c, d, dbc2
!c write(6,'(5x,"x ",f12.6)') x
!c WRITE( stdout,'(5x,"b, c, d, dbc2 =",4f12.6)') b, c, d, dbc2
!c WRITE( stdout,'(5x,"x ",f12.6)') x
if (detot.gt.0.d0) then
!
! (detot > 0) case: a nice minimum should exist with 0 < x < 1
@ -131,7 +132,7 @@ subroutine linmin (xold, eold, deold, xtot, etot, detot, xnew, &
!
minimum_ok = .false.
x = 1.d0 + min (2.d0, abs (detot / deold) )
write (6, '(5x,"linmin: no reliable minimum found")')
WRITE( stdout, '(5x,"linmin: no reliable minimum found")')
else
!
! ... ... (dbc2 < 1) AND (c > 0): a minimum exists for positive
@ -142,7 +143,7 @@ subroutine linmin (xold, eold, deold, xtot, etot, detot, xnew, &
if (x.lt.0) call errore ('linmin', 'unexpected error', 3)
if (x.lt.1) then
minimum_ok = .false.
write (6, '(5x,"linmin: new pos. on the wrong side")')
WRITE( stdout, '(5x,"linmin: new pos. on the wrong side")')
endif
endif
endif
@ -158,10 +159,10 @@ subroutine linmin (xold, eold, deold, xtot, etot, detot, xnew, &
endif
if (minimum_ok) then
enew = eold+b * x + c * x**2 + d * x**3
write (6, '(/5x,"Enext = ",f15.8," Xnext=",f12.6)') enew, &
WRITE( stdout, '(/5x,"Enext = ",f15.8," Xnext=",f12.6)') enew, &
x
else
write (6, '(5x,"linmin: take another downhill step")')
WRITE( stdout, '(5x,"linmin: take another downhill step")')
endif

22
PW/mix_rho.f90
View File

@ -117,11 +117,11 @@ subroutine mix_rho (rhout, rhoin, nsout, nsin, alphamix, dr2, iter, &
conv = (dr2 < tr2)
dehar = fn_dehar(rhocout)
#ifdef DEBUG
! if (lda_plus_u) write (6,*) ' ns_dr2 =', ns_dot_product(nsout,nsout)
! if (lda_plus_u) WRITE( stdout,*) ' ns_dr2 =', ns_dot_product(nsout,nsout)
if (conv) then
write (6,100) dr2, rho_dot_product(rhocout,rhocout) + &
WRITE( stdout,100) dr2, rho_dot_product(rhocout,rhocout) + &
ns_dot_product(nsout,nsout)
write (6,'(" dehar =",f15.8)') dehar
WRITE( stdout,'(" dehar =",f15.8)') dehar
end if
#endif
@ -306,9 +306,9 @@ subroutine mix_rho (rhout, rhoin, nsout, nsin, alphamix, dr2, iter, &
end do
!
#ifdef DEBUG
write (6,100) dr2, rho_dot_product(rhocout,rhocout) + &
WRITE( stdout,100) dr2, rho_dot_product(rhocout,rhocout) + &
ns_dot_product(nsout,nsout)
write (6,'(" dehar =",f15.8)') dehar
WRITE( stdout,'(" dehar =",f15.8)') dehar
#endif
100 format (' dr2 =',1pe15.1, ' internal_best_dr2= ', 1pe15.1)
@ -543,7 +543,7 @@ subroutine approx_screening (drho)
agg0 = (12.d0/pi)**(2.d0/3.d0)/tpiba2/rs
#ifdef DEBUG
write (6,'(a,f12.6,a,f12.6)') ' avg rs =', rs, ' avg rho =', nelec/omega
WRITE( stdout,'(a,f12.6,a,f12.6)') ' avg rs =', rs, ' avg rho =', nelec/omega
#endif
if (nspin == 1) then
@ -613,7 +613,7 @@ end subroutine approx_screening
is = 1
target = 0.d0
! write (6,*) ' eccoci qua '
! WRITE( stdout,*) ' eccoci qua '
if (gg(1) < 1.d-8) drho(1,is) = (0.d0,0.d0)
@ -679,7 +679,7 @@ end subroutine approx_screening
rs = (3.d0*omega/fpi/nelec)**(1.d0/3.d0)
agg0 = (12.d0/pi)**(2.d0/3.d0)/tpiba2/avg_rsm1
#ifdef DEBUG
write (6,'(a,5f12.6)') ' min/avgm1/max rs =', min_rs,avg_rsm1,max_rs,rs
WRITE( stdout,'(a,5f12.6)') ' min/avgm1/max rs =', min_rs,avg_rsm1,max_rs,rs
#endif
!
@ -778,10 +778,10 @@ end subroutine approx_screening
dr2_best= rho_dot_product(wbest,wbest)
if (target == 0.d0) target = 1.d-6 * dr2_best
! write (6,*) m, dr2_best, cbest
! WRITE( stdout,*) m, dr2_best, cbest
if (dr2_best < target) then
! write(6,*) ' last', dr2_best/target * 1.d-6
! WRITE( stdout,*) ' last', dr2_best/target * 1.d-6
psic(:) = (0.d0,0.d0)
do ig=1,ngm0
psic(nl(ig)) = vbest(ig)
@ -811,7 +811,7 @@ end subroutine approx_screening
deallocate (alpha, v, w, dv, vbest, wbest)
return
else if (m >= mmx) then
! write (6,*) m, dr2_best, cbest
! WRITE( stdout,*) m, dr2_best, cbest
m=1
do ig=1,ngm0
v(ig,m)=vbest(ig)

18
PW/move_ions.f90
View File

@ -105,6 +105,7 @@ subroutine new_force (dg, dg2)
!
! where dg is the gradient of the constraint function
!
USE io_global, ONLY : stdout
use pwcom
integer :: na, i, ipol
@ -142,9 +143,9 @@ subroutine new_force (dg, dg2)
call trnvect (force (1, na), at, bg, 1)
enddo
endif
write (6, '(/5x,"Constrained forces")')
WRITE( stdout, '(/5x,"Constrained forces")')
do na = 1, nat
write (6, '(3f14.8)') (force (i, na) , i = 1, 3)
WRITE( stdout, '(3f14.8)') (force (i, na) , i = 1, 3)
enddo
endif
@ -166,6 +167,7 @@ subroutine check_constrain (alat, tau, atm, ityp, theta0, nat)
! in normal cases the constraint equation should be always satisfied
! the very first iteration.
!
USE io_global, ONLY : stdout
use parameters
implicit none
integer :: ityp ( * ), nat, na, i, maxiter
@ -178,7 +180,7 @@ subroutine check_constrain (alat, tau, atm, ityp, theta0, nat)
parameter (eps = 1.d-15, maxiter = 250)
allocate ( dg(3,nat) )
call constrain (dummy, g, dg, dg2, theta0, nat, tau, alat)
write (6, '(5x,"G = ",1pe9.2," iteration # ",i3)') g, 0
WRITE( stdout, '(5x,"G = ",1pe9.2," iteration # ",i3)') g, 0
do i = 1, maxiter
!
! check if g=0
@ -189,19 +191,19 @@ subroutine check_constrain (alat, tau, atm, ityp, theta0, nat)
!
call DAXPY (3 * nat, - g / dg2, dg, 1, tau, 1)
call constrain (dummy, g, dg, dg2, theta0, nat, tau, alat)
write (6, '(5x,"G = ",1pe9.2," iteration # ",i3)') g, i
WRITE( stdout, '(5x,"G = ",1pe9.2," iteration # ",i3)') g, i
enddo
call errore ('new_dtau', 'g=0 is not satisfied g=', - 1)
14 continue
! write(6,'(5x,"G = ",1pe9.2)')g
write (6, '(5x,"Number of step(s): ",i3)') i - 1
! WRITE( stdout,'(5x,"G = ",1pe9.2)')g
WRITE( stdout, '(5x,"Number of step(s): ",i3)') i - 1
!
! if the atomic positions have been corrected write them on output
!
if (i.gt.1) then
write (6, '(/5x,"Corrected atomic positions:",/)')
WRITE( stdout, '(/5x,"Corrected atomic positions:",/)')
do na = 1, nat
write (6,'(a3,3x,3f14.9)') atm(ityp(na)), (tau(i,na), i=1,3)
WRITE( stdout,'(a3,3x,3f14.9)') atm(ityp(na)), (tau(i,na), i=1,3)
enddo
endif

7
PW/new_ns.f90
View File

@ -16,6 +16,7 @@ subroutine new_ns
! f_{kv} <\fi^{at}_{I,m1}|\psi_{k,v,s}><\psi_{k,v,s}|\fi^{at}_{I,m2}>
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY : evc
use io_files
@ -174,9 +175,9 @@ subroutine new_ns
do m2 = m1, 2 * Hubbard_l(nt) + 1
psum = abs ( nsnew(m1,m2,is,na) - nsnew(m1,m2,is,na) )
if (psum.gt.1.d-10) then
write (6, * ) na, is, m1, m2
write (6, * ) nsnew (m1, m2, is, na)
write (6, * ) nsnew (m2, m1, is, na)
WRITE( stdout, * ) na, is, m1, m2
WRITE( stdout, * ) nsnew (m1, m2, is, na)
WRITE( stdout, * ) nsnew (m2, m1, is, na)
call errore ('new_ns', 'non hermitean matrix', 1)
else
nsnew(m1,m2,is,na) = 0.5d0 * (nsnew(m1,m2,is,na) + &

8
PW/newd.f90
View File

@ -136,9 +136,9 @@ subroutine newd
do na = 1, nat
nt = ityp (na)
do is = 1, nspin
! write(6,'( "dmatrix atom ",i4, " spin",i4)') na,is
! WRITE( stdout,'( "dmatrix atom ",i4, " spin",i4)') na,is
! do ih = 1, nh(nt)
! write(6,'(8f9.4)') (deeq(ih,jh,na,is),jh=1,nh(nt))
! WRITE( stdout,'(8f9.4)') (deeq(ih,jh,na,is),jh=1,nh(nt))
! end do
do ih = 1, nh (nt)
do jh = ih, nh (nt)
@ -147,9 +147,9 @@ subroutine newd
enddo
enddo
enddo
! write(6,'( "dion pseudo ",i4)') nt
! WRITE( stdout,'( "dion pseudo ",i4)') nt
! do ih = 1, nh(nt)
! write(6,'(8f9.4)') (dvan(ih,jh,nt),jh=1,nh(nt))
! WRITE( stdout,'(8f9.4)') (dvan(ih,jh,nt),jh=1,nh(nt))
! end do
enddo

3
PW/openfil.f90
View File

@ -13,6 +13,7 @@ subroutine openfil
! This routine opens all files needed to the self consistent run,
! sets various file names, units, record lengths
!
USE io_global, ONLY : stdout
use pwcom
use io_files, only: prefix
use restart_module, only: readfile_new
@ -55,7 +56,7 @@ subroutine openfil
#else
write (6, '(5x,"Cannot read wfc file: not found")')
WRITE( stdout, '(5x,"Cannot read wfc file: not found")')
startingwfc='atomic'
#endif

5
PW/orthoatwfc.f90
View File

@ -15,6 +15,7 @@ subroutine orthoatwfc
! in order to make lda+U calculations
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
use becmod
#ifdef __PARA
@ -50,9 +51,9 @@ subroutine orthoatwfc
orthogonalize_wfc = .false.
if (orthogonalize_wfc) then
write (6,*) 'Atomic wfc used in LDA+U are orthogonalized'
WRITE( stdout,*) 'Atomic wfc used in LDA+U are orthogonalized'
else
write (6,*) 'Atomic wfc used in LDA+U are NOT orthogonalized'
WRITE( stdout,*) 'Atomic wfc used in LDA+U are NOT orthogonalized'
end if
if (nks.gt.1) rewind (iunigk)

15
PW/output_tau.f90
View File

@ -9,6 +9,7 @@
subroutine output_tau
!-----------------------------------------------------------------------
!
USE io_global, ONLY : stdout
use parameters, only: DP
use constants, only: bohr_radius_angs
use brilz, only: alat, at, bg
@ -26,27 +27,27 @@ subroutine output_tau
!
CASE ('alat')
!
write (6, '("ATOMIC_POSITIONS (alat)")')
WRITE( stdout, '("ATOMIC_POSITIONS (alat)")')
CASE ('bohr')
!
write (6, '("ATOMIC_POSITIONS (bohr)")')
WRITE( stdout, '("ATOMIC_POSITIONS (bohr)")')
tau_out(:,:) = tau_out(:,:)*alat
CASE ('crystal')
!
write (6, '("ATOMIC_POSITIONS (crystal)")')
WRITE( stdout, '("ATOMIC_POSITIONS (crystal)")')
call cryst_to_cart (nat, tau_out, bg,-1)
CASE ('angstrom')
!
write (6, '("ATOMIC_POSITIONS (angstrom)")')
WRITE( stdout, '("ATOMIC_POSITIONS (angstrom)")')
!
tau_out(:,:) = tau_out(:,:)*alat*bohr_radius_angs
CASE DEFAULT
write (6, '("ATOMIC_POSITIONS")')
WRITE( stdout, '("ATOMIC_POSITIONS")')
END SELECT
do na = 1, nat
write (6,'(a3,3x,3f14.9)') atm(ityp(na)), (tau_out(i,na), i=1,3)
WRITE( stdout,'(a3,3x,3f14.9)') atm(ityp(na)), (tau_out(i,na), i=1,3)
enddo
write (6, '(/)')
WRITE( stdout, '(/)')
deallocate(tau_out)
return
end subroutine output_tau

21
PW/potinit.f90
View File

@ -21,6 +21,7 @@ subroutine potinit
! is saved in vr
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
use io_files, only: prefix
#ifdef __PARA
@ -54,7 +55,7 @@ subroutine potinit
call mp_bcast( exst, ionode_id )
#endif
if (startingpot=='file' .and. .not.exst) then
write (6, '(5x,"Cannot read pot/rho file: not found")')
WRITE( stdout, '(5x,"Cannot read pot/rho file: not found")')
startingpot='atomic'
end if
@ -65,7 +66,7 @@ subroutine potinit
if (startingpot=='file') then
if (imix.ge.0.and.lscf) then
call io_pot ( -1, trim(prefix)//'.rho', rho, nspin)
write (6, '(/5x,"The initial density is read from file ", &
WRITE( stdout, '(/5x,"The initial density is read from file ", &
& a14)') trim(prefix)//'.rho'
!
! here we compute the potential which correspond to the initial charge
@ -75,10 +76,10 @@ subroutine potinit
ehart, etxc, vtxc, charge, vr)
!
if (abs (charge-nelec) / charge.gt.1.0d-4) &
write (6, '(/5x,"starting charge =",f10.5)') charge
WRITE( stdout, '(/5x,"starting charge =",f10.5)') charge
else
call io_pot ( - 1, trim(prefix)//'.pot', vr, nspin)
write (6, '(/5x,"The initial potential is read from file ", &
WRITE( stdout, '(/5x,"The initial potential is read from file ", &
& a14)') trim(prefix)//'.pot'
end if
!
@ -106,7 +107,7 @@ subroutine potinit
! Second case, the potential is built from a superposition of atomic
! charges contained in the array rho_at and already set in readin-readva
!
write (6, '(/5x,"Initial potential from superposition", &
WRITE( stdout, '(/5x,"Initial potential from superposition", &
& " of free atoms")')
!
! in the lda+U case set the initial value of ns
@ -122,7 +123,7 @@ subroutine potinit
if (input_drho.ne.' ') then
if (lsda) call errore ('potinit', ' lsda not allowed in drho', 1)
call io_pot ( - 1, input_drho, vr, nspin)
write (6, '(/5x,"a scf correction to at. rho is read from", &
WRITE( stdout, '(/5x,"a scf correction to at. rho is read from", &
& a14)') input_drho
call DAXPY (nrxx, 1.d0, vr, 1, rho, 1)
endif
@ -134,7 +135,7 @@ subroutine potinit
ehart, etxc, vtxc, charge, vr)
!
if (abs (charge-nelec) / charge.gt.1.0d-4) &
write (6, '(/5x,"starting charge =",f10.5)') charge
WRITE( stdout, '(/5x,"starting charge =",f10.5)') charge
endif
!
@ -146,10 +147,10 @@ subroutine potinit
! write on output the parameters used in the lda+U calculation
!
if (lda_plus_u) then
write (6, '(/5x,"Parameters of the lda+U calculation:")')
write (6, '(5x,"Number of iteration with fixed ns =",i3)') &
WRITE( stdout, '(/5x,"Parameters of the lda+U calculation:")')
WRITE( stdout, '(5x,"Number of iteration with fixed ns =",i3)') &
niter_with_fixed_ns
write (6, '(5x,"Starting ns and Hubbard U :")')
WRITE( stdout, '(5x,"Starting ns and Hubbard U :")')
call write_ns
endif

27
PW/print_clock_pw.f90
View File

@ -12,25 +12,26 @@ subroutine print_clock_pw
! this routine prints out the clocks at the end of the run
! it tries to construct the calling tree of the program.
USE io_global, ONLY : stdout
use pwcom
implicit none
write (6, * )
WRITE( stdout, * )
call print_clock ('PWSCF')
call print_clock ('init_run')
call print_clock ('electrons')
if (lforce) call print_clock ('forces')
if (lstres) call print_clock ('stress')
write (6, * )
WRITE( stdout, * )
call print_clock ('electrons')
call print_clock ('c_bands')
call print_clock ('sum_band')
call print_clock ('v_of_rho')
call print_clock ('newd')
#ifdef DEBUG_NEWD
write (*,*) "nhm*(nhm+1)/2 = ", nhm*(nhm+1)/2, nhm
write (*,*) "nbrx*(nbrx+1)/2*lqx = ", nbrx*(nbrx+1)/2*lqx, nbrx,lqx
WRITE( stdout,*) "nhm*(nhm+1)/2 = ", nhm*(nhm+1)/2, nhm
WRITE( stdout,*) "nbrx*(nbrx+1)/2*lqx = ", nbrx*(nbrx+1)/2*lqx, nbrx,lqx
call print_clock ('newd:fftvg')
call print_clock ('newd:qvan2')
call print_clock ('newd:int1')
@ -41,13 +42,13 @@ subroutine print_clock_pw
else
call print_clock ('mix_pot')
endif
write (6, * )
WRITE( stdout, * )
call print_clock ('c_bands')
call print_clock ('init_us_2')
call print_clock ('cegterg')
call print_clock ('ccgdiagg')
call print_clock ('diis')
write (6, * )
WRITE( stdout, * )
call print_clock ('sum_band')
call print_clock ('sumbec')
@ -58,7 +59,7 @@ subroutine print_clock_pw
call print_clock ('addus:aux2')
call print_clock ('addus:aux')
#endif
write (6, * )
WRITE( stdout, * )
call print_clock ('wfcrot')
call print_clock ('wfcrot1')
call print_clock ('cegterg')
@ -71,7 +72,7 @@ subroutine print_clock_pw
call print_clock ('cdiaghg')
call print_clock ('update')
call print_clock ('last')
write (6, * )
WRITE( stdout, * )
call print_clock ('h_psi')
call print_clock ('init')
call print_clock ('firstfft')
@ -82,23 +83,23 @@ subroutine print_clock_pw
call print_clock ('h_1psi')
call print_clock ('s_1psi')
call print_clock ('cdiaghg')
write (6, * )
WRITE( stdout, * )
call print_clock ('h_1psi')
call print_clock ('init')
call print_clock ('firstfft')
call print_clock ('secondfft')
call print_clock ('add_vuspsi')
endif
write (6, * )
write (6, * ) ' General routines'
WRITE( stdout, * )
WRITE( stdout, * ) ' General routines'
call print_clock ('ccalbec')
call print_clock ('cft3')
call print_clock ('cft3s')
call print_clock ('interpolate')
call print_clock ('davcio')
write (6, * )
WRITE( stdout, * )
#ifdef __PARA
write (6, * ) ' Parallel routines'
WRITE( stdout, * ) ' Parallel routines'
call print_clock ('reduce')
call print_clock ('fft_scatter')
! call print_clock('poolreduce')

6
PW/punch.f90
View File

@ -17,6 +17,7 @@ subroutine punch
! the information needed to the phonon program.
!
!
USE io_global, ONLY : stdout
use pwcom, only: nks, filpun, reduce_io, nwordwfc, iunwfc, lscf, &
rho, nspin, iunpun, et, wg, nbnd, nkstot
USE wavefunctions, ONLY : evc
@ -32,7 +33,7 @@ subroutine punch
logical :: exst
!
filpun = trim(prefix)//'.save'
write (6, '(/,5x,"Writing file ",a14,"for program phonon")') filpun
WRITE( stdout, '(/,5x,"Writing file ",a14,"for program phonon")') filpun
!
kunittmp = 1
!
@ -89,6 +90,7 @@ subroutine punch
! the information needed to the phonon program.
!
!
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY : evc
use io_files, only: prefix
@ -103,7 +105,7 @@ subroutine punch
logical :: exst
!
filpun = trim(prefix)//'.pun'
write (6, '(/,5x,"Writing file ",a14,"for program phonon")') filpun
WRITE( stdout, '(/,5x,"Writing file ",a14,"for program phonon")') filpun
!
kunittmp = 1
!

18
PW/read_conf_from_file.f90
View File

@ -9,6 +9,7 @@
subroutine read_config_from_file
!-----------------------------------------------------------------------
USE io_global, ONLY : stdout
use pwcom
use io_files, only: prefix
use restart_module, only : readfile_config
@ -23,15 +24,15 @@ subroutine read_config_from_file
if (trim(startingconfig).ne.'file') return
write (6, '(/5x,"Starting configuration read from file ", a14 )') &
WRITE( stdout, '(/5x,"Starting configuration read from file ", a14 )') &
trim(prefix)//".save"
!
! check if restart file is present, if yes read config parameters
!
call readfile_config( iunres, ibrav_, nat_, alat_, at_, tau_, ierr )
if ( ierr == 1 ) then
write (6, '(/5x,"Failed to open file", a14 )') trim(prefix)//".save"
write (6, '(/5x,"Use input configuration")')
WRITE( stdout, '(/5x,"Failed to open file", a14 )') trim(prefix)//".save"
WRITE( stdout, '(/5x,"Use input configuration")')
return
else if( ierr > 1 ) then
call errore ('read_config_from_file', 'problems in reading file', 1)
@ -40,7 +41,7 @@ subroutine read_config_from_file
! check if atomic positions from restart file if present
!
if (nat_.ne.nat.or.ibrav_.ne.ibrav) then
write(*,*) 'wrong nat ', nat, nat_, ' or ibrav ', ibrav, ibrav_
WRITE( stdout,*) 'wrong nat ', nat, nat_, ' or ibrav ', ibrav, ibrav_
call errore('read_config_from_file','wrong nat or ibrav',1)
endif
alat = alat_
@ -69,6 +70,7 @@ end subroutine read_config_from_file
subroutine read_config_from_file_old
!-----------------------------------------------------------------------
USE io_global, ONLY : stdout
use pwcom
use io_files, only : prefix
@ -80,7 +82,7 @@ subroutine read_config_from_file_old
if (trim(startingconfig).ne.'file') return
write (6, '(/5x,"Starting configuration read from file ", a14 )') &
WRITE( stdout, '(/5x,"Starting configuration read from file ", a14 )') &
trim(prefix)//".config"
!
! check if restart file is present
@ -89,8 +91,8 @@ subroutine read_config_from_file_old
call seqopn (iunit, trim(prefix)//".config", 'unformatted', exst)
if (.not.exst) then
close (unit = iunit, status = 'delete')
write (6, '(/5x,"Failed to open file", a14 )') trim(prefix)//".config"
write (6, '(/5x,"Use input configuration")')
WRITE( stdout, '(/5x,"Failed to open file", a14 )') trim(prefix)//".config"
WRITE( stdout, '(/5x,"Use input configuration")')
return
endif
!
@ -99,7 +101,7 @@ subroutine read_config_from_file_old
read (iunit, err = 10, end = 10) ibrav_, nat_
if (nat_.ne.nat.or.ibrav_.ne.ibrav) then
write(*,*) 'wrong nat ', nat, nat_, ' or ibrav ', ibrav, ibrav_
WRITE( stdout,*) 'wrong nat ', nat, nat_, ' or ibrav ', ibrav, ibrav_
call errore('read_config_from_file','wrong nat or ibrav',1)
endif

22
PW/readvan.f90
View File

@ -293,37 +293,37 @@ subroutine readvan (is, iunps)
if (exfact.eq. - 3.) xctit = ' gunnarson-lundqvist'
if (exfact.gt.0.) xctit = ' slater x-alpha'
! write (6,200) is
! WRITE( stdout,200) is
200 format (/4x,60('=')/4x,'| pseudopotential report', &
& ' for atomic species:',i3,11x,'|')
! write(6,300) 'pseudo potential version', iver(1,is),
! WRITE( stdout,300) 'pseudo potential version', iver(1,is),
! + iver(2,is), iver(3,is)
300 format (4x,'| ',1a30,3i4,13x,' |' /4x,60('-'))
! write (6,400) line, xctit
! WRITE( stdout,400) line, xctit
400 format (4x,'| ',2a20,' exchange-corr |')
! write (6,500) zmesh(is), is, zp(is), exfact
! WRITE( stdout,500) zmesh(is), is, zp(is), exfact
500 format (4x,'| z =',f5.0,4x,'zv(',i2,') =',f5.0,4x,'exfact =', &
& f10.5, 9x,'|')
! write (6,600) ifpcor, etotpseu
! WRITE( stdout,600) ifpcor, etotpseu
600 format (4x,'| ifpcor = ',i2,10x,' atomic energy =',f10.5, &
& ' Ry',6x,'|')
! write (6,700)
! WRITE( stdout,700)
700 format(4x,'| index orbital occupation energy',14x,'|')
! write (6,800) ( nb, nnlz(nb), wwnl(nb), ee(nb), nb=1,nchi(is) )
! WRITE( stdout,800) ( nb, nnlz(nb), wwnl(nb), ee(nb), nb=1,nchi(is) )
800 format(4x,'|',i5,i11,5x,f10.2,f12.2,15x,'|')
900 format('(4x,"| rinner =",',i1,'f8.4,',i2,'x,"|")')
! write (6,1000)
! WRITE( stdout,1000)
1000 format(4x,'| new generation scheme:',32x,'|')
! write (6,1100) nbeta(is),kkbeta(is),rcloc
! WRITE( stdout,1100) nbeta(is),kkbeta(is),rcloc
1100 format(4x,'| nbeta = ',i2,5x,'kkbeta =',i5,5x, &
& 'rcloc =',f10.4,4x,'|'/ &
& 4x,'| ibeta l epsilon rcut',25x,'|')
do nb = 1, nbeta (is)
lp = lll (nb, is) + 1
! write (6,1200) nb,lll(nb,is),eee(nb),rc(lp)
! WRITE( stdout,1200) nb,lll(nb,is),eee(nb),rc(lp)
1200 format (4x,'|',5x,i2,6x,i2,4x,2f7.2,25x,'|')
enddo
! write (6,1300)
! WRITE( stdout,1300)
1300 format (4x,60('='))
return

4
PW/remove_atomic_rho.f90
View File

@ -9,7 +9,7 @@
subroutine remove_atomic_rho
!-----------------------------------------------------------------------
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
implicit none
integer :: ir
@ -26,7 +26,7 @@ subroutine remove_atomic_rho
!
if (lsda) call errore ('rmv_at_rho', 'lsda not allowed', 1)
write (6, '(/5x,"remove atomic charge density from scf rho")')
WRITE( stdout, '(/5x,"remove atomic charge density from scf rho")')
!
! subtract the old atomic charge density
!

14
PW/restart.f90
View File

@ -9,6 +9,8 @@
#include "machine.h"
module restart_module
USE io_global, ONLY : stdout
implicit none
save
@ -107,7 +109,7 @@ subroutine writefile_new( what, ndw, et_g, wg_g, kunit )
!
!
filename = trim(prefix)//'.save'
! write (6, '(/,5x,"Writing file ",a14)') filename
! WRITE( stdout, '(/,5x,"Writing file ",a14)') filename
!
if( ionode ) THEN
call seqopn (ndw, filename, 'unformatted', exst)
@ -444,7 +446,7 @@ subroutine writefile_new( what, ndw, et_g, wg_g, kunit )
call davcio (evc, nwordwfc, iunwfc, (ik-iks+1), - 1)
END IF
ispin = isk( ik )
! write(6,*) ' ### ', ik,nkstot,iks,ike,kunit,nproc,nproc_pool ! DEBUG
! WRITE( stdout,*) ' ### ', ik,nkstot,iks,ike,kunit,nproc,nproc_pool ! DEBUG
CALL write_restart_wfc(ndw, ik, nkstot, kunit, ispin, nspin, &
wfc_scal, evc, twf0, evc, twfm, npw_g, nbnd, igk_l2g(:,ik-iks+1), ngk(ik-iks+1) )
@ -458,7 +460,7 @@ subroutine writefile_new( what, ndw, et_g, wg_g, kunit )
END IF
! write (6, '(5x,"file written")')
! WRITE( stdout, '(5x,"file written")')
if( ionode ) then
close (unit = ndw)
@ -567,7 +569,7 @@ subroutine readfile_new( what, ndr, et_g, wg_g, kunit, nsizwfc, iunitwfc, ierr )
ierr = 0
filename = trim(prefix)//'.save'
flen = index(filename,' ')-1
write (6, '(/,5x,"Reading file ",a," ... ")') filename(1:flen)
WRITE( stdout, '(/,5x,"Reading file ",a," ... ")') filename(1:flen)
!
if( ionode ) THEN
call seqopn (ndr, filename(1:flen), 'unformatted', exst)
@ -998,7 +1000,7 @@ subroutine readfile_new( what, ndr, et_g, wg_g, kunit, nsizwfc, iunitwfc, ierr )
if( ionode ) then
close (unit = ndr)
end if
write (6, '(5x,"read complete")')
WRITE( stdout, '(5x,"read complete")')
!
return
end subroutine
@ -1072,7 +1074,7 @@ subroutine readfile_config( ndr, ibrav, nat, alat, at, tau, ierr )
!
ierr = 0
filename = trim( prefix )//'.save'
write (6, '(/,5x,"Reading file ",a14)') filename
WRITE( stdout, '(/,5x,"Reading file ",a14)') filename
!
if( ionode ) THEN
call seqopn (ndr, filename, 'unformatted', exst)

14
PW/restart_from_file.f90
View File

@ -8,7 +8,7 @@
!-----------------------------------------------------------------------
subroutine restart_from_file
!-----------------------------------------------------------------------
USE io_global, ONLY : stdout
use pwcom
implicit none
@ -19,25 +19,25 @@ subroutine restart_from_file
!
iunres = 1
if (.not.restart) then
! write (6, '(/5x,"RECOVER from restart file has been switched off on input")')
! WRITE( stdout, '(/5x,"RECOVER from restart file has been switched off on input")')
call seqopn (iunres, 'restart', 'unformatted', exst)
! if (exst) write (6,'(/5x,"Existing restart file has been removed")')
! if (exst) WRITE( stdout,'(/5x,"Existing restart file has been removed")')
close (unit = iunres, status = 'delete')
return
endif
call seqopn (iunres, 'restart', 'unformatted', restart)
if (.not.restart) then
write (6, '(/5x,"RECOVER from restart file failed: file not found")')
WRITE( stdout, '(/5x,"RECOVER from restart file failed: file not found")')
close (unit = iunres, status = 'delete')
return
endif
!
write (6, '(/5x,"read information from restart file")')
WRITE( stdout, '(/5x,"read information from restart file")')
read (iunres, err = 10, end = 10) where
write (6, '(5x,"Restarting in ",a)') where
WRITE( stdout, '(5x,"Restarting in ",a)') where
if (where.ne.'ELECTRONS'.and.where.ne.'IONS') then
write (*,*) where, '......?'
WRITE( stdout,*) where, '......?'
call errore ('readin', ' wrong recover file ', 1)
endif
!

9
PW/restart_in_electrons.f90
View File

@ -8,6 +8,7 @@
!-----------------------------------------------------------------------
subroutine restart_in_electrons (iter, ik_, dr2)
!-----------------------------------------------------------------------
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY : evc
implicit none
@ -45,15 +46,15 @@ subroutine restart_in_electrons (iter, ik_, dr2)
close (unit = iunres, status = 'keep')
if (ik_.eq.0) then
iter = iter_
write (6, '(5x,"Calculation restarted from first kpoint ", &
WRITE( stdout, '(5x,"Calculation restarted from first kpoint ", &
&" of iteration #",i3)') iter + 1
elseif (ik_.ne.nks) then
iter = iter_ - 1
write (6, '(5x,"Calculation restarted from kpoint #",i4, &
WRITE( stdout, '(5x,"Calculation restarted from kpoint #",i4, &
&" of iteration #",i3)') ik_ + 1, iter + 1
else
iter = iter_ - 1
write (6, '(5x,"Calculation restarted from charge/pot", &
WRITE( stdout, '(5x,"Calculation restarted from charge/pot", &
&" of iteration #",i3)') iter + 1
!
! with only one k-point wavefunctions are not read in sum_band
@ -61,7 +62,7 @@ subroutine restart_in_electrons (iter, ik_, dr2)
if (nks.eq.1) call davcio (evc, nwordwfc, iunwfc, 1, - 1)
endif
write (6, '(5x,"tr2 = ",1pe8.2," ethr = ",1pe8.2)') tr2, ethr
WRITE( stdout, '(5x,"tr2 = ",1pe8.2," ethr = ",1pe8.2)') tr2, ethr
!
! restart procedure completed
!

5
PW/restart_in_ions.f90
View File

@ -8,6 +8,7 @@
!-----------------------------------------------------------------------
subroutine restart_in_ions (iter, ik_, dr2)
!-----------------------------------------------------------------------
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY : evc, psic
implicit none
@ -31,7 +32,7 @@ subroutine restart_in_ions (iter, ik_, dr2)
!
if (where.ne.'IONS') then
close (unit = iunres, status = 'keep')
write (*,*) where, '.......?'
WRITE( stdout,*) where, '.......?'
call errore ('restart_i', ' we should not be here ...!', 1)
endif
!
@ -42,7 +43,7 @@ subroutine restart_in_ions (iter, ik_, dr2)
! vnew = V(in)-V(out) is needed in the scf correction term to forces
read (iunres, err=10, end=10) vnew
close (unit = iunres, status = 'keep')
write (6, '(5x,"Calculation restarted from IONS ",i3)')
WRITE( stdout, '(5x,"Calculation restarted from IONS ",i3)')
!
! store wavefunctions in memory here if there is just one k-point
! (otherwise it is never done)

3
PW/rho2zeta.f90
View File

@ -13,6 +13,7 @@ subroutine rho2zeta (rho, rho_core, nrxx, nspin, iop)
! rho(*,2) = ( rho_up - rho_dw ) / rho_tot = zeta
! if (iopi.eq.-1) do the opposit transformation
!
USE io_global, ONLY : stdout
use parameters
implicit none
integer :: iop, nspin, nrxx, ir
@ -61,7 +62,7 @@ subroutine rho2zeta (rho, rho_core, nrxx, nspin, iop)
endif
enddo
else
write ( * , * ) ' iop =', iop
WRITE( stdout , * ) ' iop =', iop
call errore ('mag2zeta', 'wrong iop', 1)
endif

2
PW/s_gemm.f90
View File

@ -135,7 +135,7 @@ subroutine r_transpose (A, LDA, B, LDB, N, M, ITYPE, INFO)
S3 = IRTC ()
else
write (6, * ) ' *** r_traspose : PARAMETER ITYPE ', 'OUT OF RANGE'
WRITE( stdout, * ) ' *** r_traspose : PARAMETER ITYPE ', 'OUT OF RANGE'
stop

2
PW/scala_cdiag.f90
View File

@ -238,7 +238,7 @@ subroutine scala_cdiag (n, a, ilda, w, z, ildz)
rwork, lrwork, iwork, liwork, ifail, iclustr, gap, info)
!
if (abs (info) .gt.2) then
write (6, * ) 'info ', info, m, nz
WRITE( stdout, * ) 'info ', info, m, nz
call errore ('scala_cdiag', 'wrong info', 1)
endif
!

16
PW/scala_cdiaghg.f90
View File

@ -266,35 +266,35 @@ subroutine scala_cdiaghg (n, a, ilda, b, ildb, w, z, ildz)
if (iam_blacs.eq.0) then
if (info.lt.0) then
if (info> - 100) then
write (6, * ) 'scala_cdiaghg: Argument', - info, &
WRITE( stdout, * ) 'scala_cdiaghg: Argument', - info, &
'to PCHEGVX had an illegal value'
endif
if (info< - 100) then
i = - info / 100
j = mod ( - info, 100)
write (6, * ) 'scala_cdiagh: Element', j, 'of argument', i, &
WRITE( stdout, * ) 'scala_cdiagh: Element', j, 'of argument', i, &
'to PCHEGVX had an illegal value'
endif
endif
write (6, * ) 'given and requested lwork', lwork, work (1)
write (6, * ) 'given and requested lrwork', lrwork, rwork (1)
WRITE( stdout, * ) 'given and requested lwork', lwork, work (1)
WRITE( stdout, * ) 'given and requested lrwork', lrwork, rwork (1)
write (6, * ) 'given and requested liwork', liwork, iwork (1)
WRITE( stdout, * ) 'given and requested liwork', liwork, iwork (1)
if (info.gt.0) then
if (mod (info, 2) .ne.0) then
write (6, * ) 'scala_cdiaghg: PCHEGVX: Calculation failed', &
WRITE( stdout, * ) 'scala_cdiaghg: PCHEGVX: Calculation failed', &
' to converge'
endif
if (mod (info / 2, 2) .ne.0) then
write (6, * ) 'scala_cdiaghg: PCHEGVX: Insufficient workspace', &
WRITE( stdout, * ) 'scala_cdiaghg: PCHEGVX: Insufficient workspace', &
' to orthogonalize eigenvectors'
endif
if (mod (info / 4, 2) .ne.0) then
write (6, * ) 'scala_cdiaghg: PCHEGVX: Insufficient workspace', &
WRITE( stdout, * ) 'scala_cdiaghg: PCHEGVX: Insufficient workspace', &
' to compute all eigenvectors'
endif
endif

5
PW/scale_h.f90
View File

@ -14,6 +14,7 @@ subroutine scale_h
!
#include "machine.h"
!
USE io_global, ONLY : stdout
use pwcom
implicit none
@ -26,9 +27,9 @@ integer :: ik, ipol
!
call cryst_to_cart (nkstot, xk, at_old, - 1)
call cryst_to_cart (nkstot, xk, bg, + 1)
write (6, * ) ' NEW K-POINTS'
WRITE( stdout, * ) ' NEW K-POINTS'
do ik = 1, nkstot
write (6, '(3f12.7,f12.7)') (xk (ipol, ik) , ipol = 1, 3) , wk (ik)
WRITE( stdout, '(3f12.7,f12.7)') (xk (ipol, ik) , ipol = 1, 3) , wk (ik)
enddo
!

3
PW/set_fft_dim.f90
View File

@ -14,6 +14,7 @@ subroutine set_fft_dim
! NB: The values of nr1, nr2, nr3 are computed only if they are not
! given as input parameters. Input values are kept otherwise.
!
USE io_global, ONLY : stdout
use pwcom
use fft_scalar, only: allowed
implicit none
@ -142,7 +143,7 @@ subroutine set_fft_dim
36 continue
!
if (nr1s > nr1 .or. nr2s > nr2 .or. nr3s > nr3) then
write (6, * ) nr1s, nr2s, nr3s, nr1, nr2, nr3
WRITE( stdout, * ) nr1s, nr2s, nr3s, nr1, nr2, nr3
call errore ('set_fft_dim', 'smooth grid larger than big grid', 1)
endif
!

7
PW/set_rhoc.f90
View File

@ -14,6 +14,7 @@ subroutine set_rhoc
!
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
implicit none
!
@ -108,7 +109,7 @@ subroutine set_rhoc
call reduce (1, rhoima)
#endif
if (rhoneg.lt. - 1.0d-6.or.rhoima.gt.1.0d-6) &
write (6, '(" warning: negative or imaginary core charge ",2f12.6)')&
WRITE( stdout, '(" warning: negative or imaginary core charge ",2f12.6)')&
rhoneg, rhoima
!
! calculate core_only exch-corr energy etxcc=E_xc[rho_core] if required
@ -120,8 +121,8 @@ subroutine set_rhoc
! nrxx, nl, ngm, gstart, nspin, g, gg, alat, omega, &
! ehart, etxcc, vtxcc, aux)
! deallocate(dum)
! write (6, 9000) etxcc
! write (6, * ) 'BEWARE it will be subtracted from total energy !'
! WRITE( stdout, 9000) etxcc
! WRITE( stdout, * ) 'BEWARE it will be subtracted from total energy !'
!
deallocate (rhocg)
deallocate (aux)

5
PW/setup.f90
View File

@ -40,6 +40,7 @@ SUBROUTINE setup
!
!
USE parameters, ONLY : DP, npsx, nchix, npk
USE io_global, ONLY : stdout
USE constants, ONLY : pi
USE brilz, ONLY : at, bg, alat, tpiba, tpiba2, ibrav, symm_type
USE basis, ONLY : nat, tau, ntyp, ityp, startingwfc, startingpot, &
@ -420,10 +421,10 @@ SUBROUTINE setup
IF ( Hubbard_U(nt) /= 0.D0 .OR. Hubbard_alpha(nt) /= 0.D0) THEN
Hubbard_l(nt) = set_Hubbard_l( psd(nt) )
Hubbard_lmax = MAX( Hubbard_lmax, Hubbard_l(nt) )
WRITE( 6, * ) ' HUBBARD L FOR TYPE ',psd(nt),' IS ', Hubbard_l(nt)
WRITE( stdout, * ) ' HUBBARD L FOR TYPE ',psd(nt),' IS ', Hubbard_l(nt)
END IF
END DO
WRITE( 6, * ) ' MAXIMUM HUBBARD L IS ', Hubbard_lmax
WRITE( stdout, * ) ' MAXIMUM HUBBARD L IS ', Hubbard_lmax
IF ( Hubbard_lmax == -1 ) &
CALL errore( 'setup', &
& 'lda_plus_u calculation but Hubbard_l not set', 1 )

9
PW/sgam_at.f90
View File

@ -21,6 +21,7 @@ subroutine sgam_at (nrot, s, nat, tau, ityp, at, bg, nr1, nr2, &
! total point group
!
#include "machine.h"
USE io_global, ONLY : stdout
use parameters
implicit none
!
@ -94,7 +95,7 @@ subroutine sgam_at (nrot, s, nat, tau, ityp, at, bg, nr1, nr2, &
2) ) .lt.1.d-8) call errore ('sgam_at', 'overlapping atoms', na)
if (sym (irot) ) then
fractional_translations = .false.
write (6, '(5x,"Found additional translation:",3f10.4)') ft
WRITE( stdout, '(5x,"Found additional translation:",3f10.4)') ft
endif
endif
@ -110,9 +111,9 @@ subroutine sgam_at (nrot, s, nat, tau, ityp, at, bg, nr1, nr2, &
mod (s (1, 3, irot) * nr3, nr1) .ne.0 .or. &
mod (s (2, 3, irot) * nr3, nr2) .ne.0 ) then
sym (irot) = .false.
write (6, '(5x,"warning: symmetry operation # ",i2, &
WRITE( stdout, '(5x,"warning: symmetry operation # ",i2, &
& " not compatible with FFT grid. ")') irot
write (6, '(3i4)') ( (s (i, j, irot) , j = 1, 3) , i = 1, 3)
WRITE( stdout, '(3i4)') ( (s (i, j, irot) , j = 1, 3) , i = 1, 3)
goto 100
endif
@ -157,7 +158,7 @@ subroutine sgam_at (nrot, s, nat, tau, ityp, at, bg, nr1, nr2, &
if (abs (ft1 - nint (ft1) ) / nr1.gt.1.0d-5 .or. &
abs (ft2 - nint (ft2) ) / nr2.gt.1.0d-5 .or. &
abs (ft3 - nint (ft3) ) / nr3.gt.1.0d-5) then
write (6, '(5x,"warning: symmetry operation", &
WRITE( stdout, '(5x,"warning: symmetry operation", &
& " # ",i2," not allowed. fractional ", &
& "translation:"/5x,3f11.7," in crystal", &
& " coordinates")') irot, ft

4
PW/show_memory.f90
View File

@ -11,9 +11,9 @@
subroutine show_memory ()
#include "machine.h"
implicit none
! write(6,'(5x,"Current number of allocated pointers:",i8)') nptr
! WRITE( stdout,'(5x,"Current number of allocated pointers:",i8)') nptr
!write (6, '(5x,"Dynamical memory: ",f6.2,"Mb current, ", &
!WRITE( stdout, '(5x,"Dynamical memory: ",f6.2,"Mb current, ", &
! & f6.2,"Mb maximum")') real (totsize) / 1000000, &
! & real (maxsize) / 1000000
return

14
PW/startup.f90
View File

@ -40,7 +40,7 @@ subroutine startup (nd_nmbr, code, version)
! The following two modules hold global information about processors
! number, IDs and communicators
use io_global, only: io_global_start
use io_global, only: stdout, io_global_start
use mp_global, only: mp_global_start
use mp, only: mp_start, mp_env, mp_barrier, mp_bcast
@ -149,20 +149,20 @@ subroutine startup (nd_nmbr, code, version)
# endif
if (me == 1) then
call date_and_tim (cdate, ctime)
write (6, 9000) code, version, cdate, ctime
write (6, '(/5x,"Parallel version (MPI)")')
write (6, '(5x,"Number of processors in use: ",i4)') nproc
WRITE( stdout, 9000) code, version, cdate, ctime
WRITE( stdout, '(/5x,"Parallel version (MPI)")')
WRITE( stdout, '(5x,"Number of processors in use: ",i4)') nproc
if (npool /= 1) &
write (6, '(5x,"K-points division: npool = ",i4)') npool
WRITE( stdout, '(5x,"K-points division: npool = ",i4)') npool
if (nprocp /= 1)&
write (6, '(5x,"R & G space division: nprocp = ",i4/)') nprocp
WRITE( stdout, '(5x,"R & G space division: nprocp = ",i4/)') nprocp
endif
#else
nd_nmbr = ' '
call date_and_tim (cdate, ctime)
write (6, 9000) code, version, cdate, ctime
WRITE( stdout, 9000) code, version, cdate, ctime
#endif

162
PW/stop_pw.f90
View File

@ -1,101 +1,117 @@
!
! Copyright (C) 2001 PWSCF group
! Copyright (C) 2001-2003 PWSCF group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!--------------------------------------------------------------------
subroutine stop_pw (flag)
!--------------------------------------------------------------------
!
! Close all files and synchronize processes before stopping.
! Called at the end of the run with flag=.true. (removes 'restart')
! or during execution with flag=.false. (does not remove 'restart')
!----------------------------------------------------------------------------
SUBROUTINE stop_pw( flag )
!----------------------------------------------------------------------------
!
use pwcom
use io_files, only : prefix
use mp, only : mp_end
logical :: flag
! ... Close all files and synchronize processes before stopping.
! ... Called at the end of the run with flag = .TRUE. (removes 'restart')
! ... or during execution with flag = .FALSE. (does not remove 'restart')
!
USE varie, ONLY : order
USE units, ONLY : iunwfc, iunoldwfc, iunoldwfc2, iunigk, iunres
USE io_files, ONLY : prefix
#ifdef __PARA
include 'mpif.h'
integer :: info
USE mp, ONLY : mp_barrier, mp_end
#endif
logical exst
!
! iunwfc contains wavefunctions and is kept open during
! the execution - close and save the file
IMPLICIT NONE
!
close (unit = iunwfc, status = 'keep')
if (flag) then
LOGICAL, INTENT(IN) :: flag
LOGICAL :: exst
!
! all other files must be reopened and removed
! ... iunwfc contains wavefunctions and is kept open during
! ... the execution - close and save the file
!
call seqopn (iunres, 'restart','unformatted',exst)
close (unit=iunres,status='delete')
call seqopn (4, trim(prefix)//'.bfgs','unformatted',exst)
close (unit=4,status='delete')
call seqopn (4, trim(prefix)//'.md','formatted',exst)
close (unit=4,status='delete')
endif
CLOSE( UNIT = iunwfc, STATUS = 'KEEP' )
!
! iunigk is kept open during the execution - close and remove
IF ( order > 1 ) &
CLOSE( UNIT = iunoldwfc, STATUS = 'KEEP' )
!
IF ( order > 2 ) &
CLOSE( UNIT = iunoldwfc2, STATUS = 'KEEP' )
!
IF ( flag ) THEN
!
! ... all other files must be reopened and removed
!
CALL seqopn( iunres, 'restart', 'UNFORMATTED', exst )
CLOSE( UNIT = iunres, STATUS = 'DELETE' )
!
CALL seqopn( 4, TRIM( prefix )//'.bfgs', 'UNFORMATTED', exst )
CLOSE( UNIT = 4, STATUS = 'DELETE' )
!
CALL seqopn( 4, TRIM( prefix )//'.md', 'FORMATTED', exst )
CLOSE( UNIT = 4, STATUS = 'DELETE' )
!
END IF
!
! ... iunigk is kept open during the execution - close and remove
!
CLOSE( UNIT = iunigk, STATUS = 'DELETE' )
CALL print_clock_pw
!
CALL show_memory ()
!
close (unit = iunigk, status = 'delete')
call print_clock_pw
call show_memory ()
#ifdef __PARA
call mpi_barrier (MPI_COMM_WORLD, info)
! call mpi_finalize (info)
CALL mp_barrier()
CALL mp_end()
#endif
call mp_end()
!
#ifdef __T3E
!
! set streambuffers off
! ... set streambuffers off
!
call set_d_stream (0)
CALL set_d_stream( 0 )
#endif
call clean_pw
if (flag) then
stop
else
stop 1
endif
end subroutine stop_pw
!
!--------------------------------------------------------------------
subroutine closefile
!--------------------------------------------------------------------
CALL clean_pw
!
! Close all files and synchronize processes before stopping
! Called by "sigcatch" when it receives a signal
IF ( flag ) THEN
STOP
ELSE
STOP 1
END IF
!
write (6, '(5x,"Signal Received, stopping ... ")')
call stop_pw (.false.)
return
end subroutine closefile
!--------------------------------------------------------------------
subroutine cpflush
!--------------------------------------------------------------------
END SUBROUTINE stop_pw
!
!
!----------------------------------------------------------------------------
SUBROUTINE closefile
!----------------------------------------------------------------------------
!
USE io_global, ONLY : stdout
!
! ... Close all files and synchronize processes before stopping
! ... Called by "sigcatch" when it receives a signal
!
WRITE( stdout,'(5X,"Signal Received, stopping ... ")')
!
CALL stop_pw( .FALSE. )
!
RETURN
!
END SUBROUTINE closefile
!
!
!----------------------------------------------------------------------------
SUBROUTINE cpflush
!----------------------------------------------------------------------------
!
USE io_global, ONLY : stdout
!
! TEMP: compatibility with Car-Parrinello code
!
print *, "what am i doing in cpflush ?"
call stop_pw (.false.)
return
end subroutine cpflush
WRITE( stdout, '("what am i doing in cpflush ?")' )
!
CALL stop_pw( .FALSE. )
!
RETURN
!
END SUBROUTINE cpflush

8
PW/stres_hub.f90
View File

@ -51,9 +51,9 @@ subroutine stres_hub ( sigmah )
do is=1,nspin
nt = ityp(na)
if (Hubbard_U(nt).ne.0.d0.or.Hubbard_alpha(nt).ne.0.d0) then
write (*,'(a,2i3)') 'NS(NA,IS) ', na,is
WRITE( stdout,'(a,2i3)') 'NS(NA,IS) ', na,is
do m1=1,ldim
write (*,'(7f10.4)') (ns(m1,m2,is,na),m2=1,ldim)
WRITE( stdout,'(7f10.4)') (ns(m1,m2,is,na),m2=1,ldim)
end do
end if
end do
@ -68,8 +68,8 @@ subroutine stres_hub ( sigmah )
if (Hubbard_U(nt).ne.0.d0.or.Hubbard_alpha(nt).ne.0.d0) then
do is = 1,nspin
#ifdef DEBUG
write (*,'(a,4i3)') 'DNS(IPOL,JPOL,NA,IS) ', ipol,jpol,na,is
write (*,'(5f10.4)') ((dns(m1,m2,is,na),m2=1,5),m1=1,5)
WRITE( stdout,'(a,4i3)') 'DNS(IPOL,JPOL,NA,IS) ', ipol,jpol,na,is
WRITE( stdout,'(5f10.4)') ((dns(m1,m2,is,na),m2=1,5),m1=1,5)
#endif
do m2 = 1, 2 * Hubbard_l(nt) + 1
sigmah(ipol,jpol) = sigmah(ipol,jpol) - omin1 * &

2
PW/stres_loc.f90
View File

@ -46,7 +46,7 @@ subroutine stres_loc (sigmaloc)
* vloc (igtongl (ng), nt) * fact
enddo
enddo
! write (6,*) ' evloc ', evloc, evloc*omega
! WRITE( stdout,*) ' evloc ', evloc, evloc*omega
!
do nt = 1, ntyp
! dvloc contains dV_loc(G)/dG

2
PW/stres_us.f90
View File

@ -92,7 +92,7 @@ subroutine stres_us (ik, gk, sigmanlc)
sigmanlc (l, l) = sigmanlc (l, l) - evps
enddo
! write (6,*) ' non local energy ', evps, evps*uakbar/omega
! WRITE( stdout,*) ' non local energy ', evps, evps*uakbar/omega
100 continue
!
! non diagonal contribution - derivative of the bessel function

7
PW/stress.f90
View File

@ -12,6 +12,7 @@ subroutine stress
!
#include "machine.h"
!
USE io_global, ONLY : stdout
use pwcom
implicit none
!
@ -21,7 +22,7 @@ subroutine stress
integer :: l, m
call start_clock ('stress')
write (6, '(//5x,"entering subroutine stress ..."/)')
WRITE( stdout, '(//5x,"entering subroutine stress ..."/)')
!
! contribution from local potential
@ -75,11 +76,11 @@ subroutine stress
! write results in Ryd/(a.u.)^3 and in kbar
!
write (6, 9000) (sigma(1,1) + sigma(2,2) + sigma(3,3)) * uakbar / 3d0, &
WRITE( stdout, 9000) (sigma(1,1) + sigma(2,2) + sigma(3,3)) * uakbar / 3d0, &
(sigma(l,1), sigma(l,2), sigma(l,3), &
sigma(l,1)*uakbar, sigma(l,2)*uakbar, sigma(l,3)*uakbar, l=1,3)
if (iverbosity.ge.1) write (6, 9005) &
if (iverbosity.ge.1) WRITE( stdout, 9005) &
(sigmakin(l,1)*uakbar,sigmakin(l,2)*uakbar,sigmakin(l,3)*uakbar, l=1,3),&
(sigmaloc(l,1)*uakbar,sigmaloc(l,2)*uakbar,sigmaloc(l,3)*uakbar, l=1,3),&
(sigmanlc(l,1)*uakbar,sigmanlc(l,2)*uakbar,sigmanlc(l,3)*uakbar, l=1,3),&

2
PW/sum_band.f90
View File

@ -92,7 +92,7 @@ subroutine sum_band
!
do ibnd = 1, nbnd
eband = eband+et (ibnd, ik) * wg (ibnd, ik)
! write(6,'(4x, " ibnd = ", i5, " ik= ",i5,
! WRITE( stdout,'(4x, " ibnd = ", i5, " ik= ",i5,
! + f15.5)') ibnd, ik,
! + wg(ibnd,ik)
!

137
PW/summary.f90
View File

@ -17,6 +17,7 @@ subroutine summary
! if iverbosity = 0 only a partial summary is done.
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
use funct
implicit none
@ -55,9 +56,9 @@ subroutine summary
if (imix.eq. 2) mixing_style = 'local-TF'
if (title.ne.' ') then
write (6,"(/,5x,'Title: ',/,5x,a75)") title
WRITE( stdout,"(/,5x,'Title: ',/,5x,a75)") title
end if
write (6, 100) ibrav, alat, omega, nat, ntyp, &
WRITE( stdout, 100) ibrav, alat, omega, nat, ntyp, &
ecutwfc, dual * ecutwfc, tr2, mixing_beta, nmix, &
mixing_style
@ -72,16 +73,16 @@ subroutine summary
& 'convergence threshold = ',1pe12.1,/,5x, &
& 'beta = ',0pf12.4,/,5x, &
& 'number of iterations used = ',i12,2x,a,' mixing')
write (6, '(5x,"Exchange-correlation = ",a, &
WRITE( stdout, '(5x,"Exchange-correlation = ",a, &
& " (",4i1,")")') trim(dft) , iexch, icorr, igcx, igcc
if (iswitch.gt.0) then
write (6, '(5x,"iswitch = ",i2," nstep = ",i4,/)') iswitch, nstep
WRITE( stdout, '(5x,"iswitch = ",i2," nstep = ",i4,/)') iswitch, nstep
else
write (6, '(5x,"iswitch = ",i2/)') iswitch
WRITE( stdout, '(5x,"iswitch = ",i2/)') iswitch
endif
if (qcutz.gt.0.d0) then
write (6, 110) ecfixed, qcutz, q2sigma
WRITE( stdout, 110) ecfixed, qcutz, q2sigma
110 format (5x,'A smooth kinetic-energy cutoff is imposed at ', &
& f12.4,' Ry',/5x,'height of the smooth ', &
& 'step-function =',f21.4,' Ry',/5x, &
@ -92,32 +93,32 @@ subroutine summary
!
! and here more detailed information. Description of the unit cell
!
write (6, '(2(3x,3(2x,"celldm(",i1,")=",f11.5),/))') (i, celldm(i), i=1,6)
write (6, '(5x, &
WRITE( stdout, '(2(3x,3(2x,"celldm(",i1,")=",f11.5),/))') (i, celldm(i), i=1,6)
WRITE( stdout, '(5x, &
& "crystal axes: (cart. coord. in units of a_0)",/, &
& 3(15x,"a(",i1,") = (",3f8.4," ) ",/ ) )') (apol, &
(at (ipol, apol) , ipol = 1, 3) , apol = 1, 3)
write (6, '(5x, &
WRITE( stdout, '(5x, &
& "reciprocal axes: (cart. coord. in units 2 pi/a_0)",/, &
& 3(15x,"b(",i1,") = (",3f8.4," ) ",/ ) )') (apol,&
& (bg (ipol, apol) , ipol = 1, 3) , apol = 1, 3)
do nt = 1, ntyp
if (tvanp (nt) ) then
ps = '(US)'
write (6, '(/5x,"PSEUDO",i2," is ",a2, &
WRITE( stdout, '(/5x,"PSEUDO",i2," is ",a2, &
& 1x,a5," zval =",f5.1," lmax=",i2, &
& " lloc=",i2)') nt, psd (nt) , ps, zp (nt) , lmax (nt) &
&, lloc (nt)
write (6, '(5x,"Version ", 3i3, " of US pseudo code")') &
WRITE( stdout, '(5x,"Version ", 3i3, " of US pseudo code")') &
(iver (i, nt) , i = 1, 3)
write (6, '(5x,"Using log mesh of ", i5, " points")') mesh (nt)
write (6, '(5x,"The pseudopotential has ",i2, &
WRITE( stdout, '(5x,"Using log mesh of ", i5, " points")') mesh (nt)
WRITE( stdout, '(5x,"The pseudopotential has ",i2, &
& " beta functions with: ")') nbeta (nt)
do ib = 1, nbeta (nt)
write (6, '(15x," l(",i1,") = ",i3)') ib, lll (ib, nt)
WRITE( stdout, '(15x," l(",i1,") = ",i3)') ib, lll (ib, nt)
enddo
write (6, '(5x,"Q(r) pseudized with ", &
WRITE( stdout, '(5x,"Q(r) pseudized with ", &
& i2," coefficients, rinner = ",3f8.3,/ &
& 58x,2f8.3)') nqf(nt), (rinner(i,nt), i=1,nqlc(nt) )
else
@ -131,26 +132,26 @@ subroutine summary
ps = ' '
endif
write (6, '(/5x,"PSEUDO",i2," is ",a2, 1x,a5," zval =",f5.1,&
WRITE( stdout, '(/5x,"PSEUDO",i2," is ",a2, 1x,a5," zval =",f5.1,&
& " lmax=",i2," lloc=",i2)') &
nt, psd(nt), ps, zp(nt), lmax(nt), lloc(nt)
if (numeric (nt) ) then
write (6, '(5x,"(in numerical form: ",i5,&
WRITE( stdout, '(5x,"(in numerical form: ",i5,&
&" grid points",", xmin = ",f5.2,", dx = ",f6.4,")")')&
& mesh (nt) , xmin (nt) , dx (nt)
else
write (6, '(/14x,"i=",7x,"1",13x,"2",10x,"3")')
write (6, '(/5x,"core")')
write (6, '(5x,"alpha =",4x,3g13.5)') (alpc (i, nt) , i = 1, 2)
write (6, '(5x,"a(i) =",4x,3g13.5)') (cc (i, nt) , i = 1, 2)
WRITE( stdout, '(/14x,"i=",7x,"1",13x,"2",10x,"3")')
WRITE( stdout, '(/5x,"core")')
WRITE( stdout, '(5x,"alpha =",4x,3g13.5)') (alpc (i, nt) , i = 1, 2)
WRITE( stdout, '(5x,"a(i) =",4x,3g13.5)') (cc (i, nt) , i = 1, 2)
do l = 0, lmax (nt)
write (6, '(/5x,"l = ",i2)') l
write (6, '(5x,"alpha =",4x,3g13.5)') (alps (i, l, nt) , &
WRITE( stdout, '(/5x,"l = ",i2)') l
WRITE( stdout, '(5x,"alpha =",4x,3g13.5)') (alps (i, l, nt) , &
i = 1, 3)
write (6, '(5x,"a(i) =",4x,3g13.5)') (aps (i, l, nt) , i = 1,3)
write (6, '(5x,"a(i+3)=",4x,3g13.5)') (aps (i, l, nt) , i= 4, 6)
WRITE( stdout, '(5x,"a(i) =",4x,3g13.5)') (aps (i, l, nt) , i = 1,3)
WRITE( stdout, '(5x,"a(i+3)=",4x,3g13.5)') (aps (i, l, nt) , i= 4, 6)
enddo
if ( nlcc(nt) ) write(6, 200) a_nlcc(nt), b_nlcc(nt), alpha_nlcc(nt)
if ( nlcc(nt) ) WRITE( stdout, 200) a_nlcc(nt), b_nlcc(nt), alpha_nlcc(nt)
200 format(/5x,'nonlinear core correction: ', &
& 'rho(r) = ( a + b r^2) exp(-alpha r^2)', &
& /,5x,'a =',4x,g11.5, &
@ -160,46 +161,46 @@ subroutine summary
endif
enddo
write (6, '(/5x, "atomic species valence mass pseudopotential")')
WRITE( stdout, '(/5x, "atomic species valence mass pseudopotential")')
xp = 1.d0
do nt = 1, ntyp
if (calc.eq.' ') then
write (6, '(5x,a6,6x,f10.2,2x,f10.5,5x,5 (a2,"(",f5.2,")"))') &
WRITE( stdout, '(5x,a6,6x,f10.2,2x,f10.5,5x,5 (a2,"(",f5.2,")"))') &
atm(nt), zv(nt), amass(nt), psd(nt), xp
else
write (6, '(5x,a6,6x,f10.2,2x,f10.5,5x,5 (a2,"(",f5.2,")"))') &
WRITE( stdout, '(5x,a6,6x,f10.2,2x,f10.5,5x,5 (a2,"(",f5.2,")"))') &
atm(nt), zv(nt), amass(nt)/amconv, psd(nt), xp
end if
enddo
if (calc.eq.'cd' .or. calc.eq.'cm' ) &
write (6, '(/5x," cell mass =", f10.5, " UMA ")') cmass/amconv
WRITE( stdout, '(/5x," cell mass =", f10.5, " UMA ")') cmass/amconv
if (calc.eq.'nd' .or. calc.eq.'nm' ) &
write (6, '(/5x," cell mass =", f10.5, " UMA/(a.u.)^2 ")') cmass/amconv
WRITE( stdout, '(/5x," cell mass =", f10.5, " UMA/(a.u.)^2 ")') cmass/amconv
if (lsda) then
write (6, '(/5x,"Starting magnetic structure ", &
WRITE( stdout, '(/5x,"Starting magnetic structure ", &
& /5x,"atomic species magnetization")')
do nt = 1, ntyp
write (6, '(5x,a6,9x,f6.3)') atm(nt), starting_magnetization(nt)
WRITE( stdout, '(5x,a6,9x,f6.3)') atm(nt), starting_magnetization(nt)
enddo
endif
!
! description of symmetries
!
if (nsym.le.1) then
write (6, '(/5x,"No symmetry!")')
WRITE( stdout, '(/5x,"No symmetry!")')
else
if (invsym) then
write (6, '(/5x,i2," Sym.Ops. (with inversion)",/)') nsym
WRITE( stdout, '(/5x,i2," Sym.Ops. (with inversion)",/)') nsym
else
write (6, '(/5x,i2," Sym.Ops. (no inversion)",/)') nsym
WRITE( stdout, '(/5x,i2," Sym.Ops. (no inversion)",/)') nsym
endif
endif
if (iverbosity.eq.1) then
write (6, '(36x,"s",24x,"frac. trans.")')
WRITE( stdout, '(36x,"s",24x,"frac. trans.")')
do isym = 1, nsym
write (6, '(/6x,"isym = ",i2,5x,a45/)') isym, sname(isym)
WRITE( stdout, '(/6x,"isym = ",i2,5x,a45/)') isym, sname(isym)
call s_axis_to_cart (s(1,1,isym), sr, at, bg)
if (ftau(1,isym).ne.0.or.ftau(2,isym).ne.0.or.ftau(3,isym).ne.0) then
ft1 = at(1,1)*ftau(1,isym)/nr1 + at(1,2)*ftau(2,isym)/nr2 + &
@ -208,29 +209,29 @@ subroutine summary
at(2,3)*ftau(3,isym)/nr3
ft3 = at(3,1)*ftau(1,isym)/nr1 + at(3,2)*ftau(2,isym)/nr2 + &
at(3,3)*ftau(3,isym)/nr3
write (6, '(1x,"cryst.",3x,"s(",i2,") = (",3(i6,5x), &
WRITE( stdout, '(1x,"cryst.",3x,"s(",i2,") = (",3(i6,5x), &
& " ) f =( ",f10.7," )")') &
isym, (s(1,ipol,isym),ipol=1,3), float(ftau(1,isym))/float(nr1)
write (6, '(17x," (",3(i6,5x), " ) ( ",f10.7," )")') &
WRITE( stdout, '(17x," (",3(i6,5x), " ) ( ",f10.7," )")') &
(s(2,ipol,isym),ipol=1,3), float(ftau(2,isym))/float(nr2)
write (6, '(17x," (",3(i6,5x), " ) ( ",f10.7," )"/)') &
WRITE( stdout, '(17x," (",3(i6,5x), " ) ( ",f10.7," )"/)') &
(s(3,ipol,isym),ipol=1,3), float(ftau(3,isym))/float(nr3)
write (6, '(1x,"cart. ",3x,"s(",i2,") = (",3f11.7, &
WRITE( stdout, '(1x,"cart. ",3x,"s(",i2,") = (",3f11.7, &
& " ) f =( ",f10.7," )")') &
isym, (sr(1,ipol),ipol=1,3), ft1
write (6, '(17x," (",3f11.7, " ) ( ",f10.7," )")') &
WRITE( stdout, '(17x," (",3f11.7, " ) ( ",f10.7," )")') &
(sr(2,ipol),ipol=1,3), ft2
write (6, '(17x," (",3f11.7, " ) ( ",f10.7," )"/)') &
WRITE( stdout, '(17x," (",3f11.7, " ) ( ",f10.7," )"/)') &
(sr(3,ipol),ipol=1,3), ft3
else
write (6, '(1x,"cryst.",3x,"s(",i2,") = (",3(i6,5x), " )")') &
WRITE( stdout, '(1x,"cryst.",3x,"s(",i2,") = (",3(i6,5x), " )")') &
isym, (s (1, ipol, isym) , ipol = 1,3)
write (6, '(17x," (",3(i6,5x)," )")') (s(2,ipol,isym), ipol=1,3)
write (6, '(17x," (",3(i6,5x)," )"/)') (s(3,ipol,isym), ipol=1,3)
write (6, '(1x,"cart. ",3x,"s(",i2,") = (",3f11.7," )")') &
WRITE( stdout, '(17x," (",3(i6,5x)," )")') (s(2,ipol,isym), ipol=1,3)
WRITE( stdout, '(17x," (",3(i6,5x)," )"/)') (s(3,ipol,isym), ipol=1,3)
WRITE( stdout, '(1x,"cart. ",3x,"s(",i2,") = (",3f11.7," )")') &
isym, (sr (1, ipol) , ipol = 1, 3)
write (6, '(17x," (",3f11.7," )")') (sr (2, ipol) , ipol = 1, 3)
write (6, '(17x," (",3f11.7," )"/)') (sr (3, ipol) , ipol = 1, 3)
WRITE( stdout, '(17x," (",3f11.7," )")') (sr (2, ipol) , ipol = 1, 3)
WRITE( stdout, '(17x," (",3f11.7," )"/)') (sr (3, ipol) , ipol = 1, 3)
endif
enddo
@ -238,10 +239,10 @@ subroutine summary
!
! description of the atoms inside the unit cell
!
write (6, '(/,3x,"Cartesian axes")')
write (6, '(/,5x,"site n. atom positions (a_0 units)")')
WRITE( stdout, '(/,3x,"Cartesian axes")')
WRITE( stdout, '(/,5x,"site n. atom positions (a_0 units)")')
write (6, '(7x,i3,8x,a6," tau(",i3,") = (",3f11.7," )")') &
WRITE( stdout, '(7x,i3,8x,a6," tau(",i3,") = (",3f11.7," )")') &
(na, atm(ityp(na)), na, (tau(ipol,na), ipol=1,3), na=1,nat)
!
! output of starting magnetization
@ -265,11 +266,11 @@ subroutine summary
! description of the atoms inside the unit cell
! (in crystallographic coordinates)
!
write (6, '(/,3x,"Crystallographic axes")')
write (6, '(/,5x,"site n. atom ", &
WRITE( stdout, '(/,3x,"Crystallographic axes")')
WRITE( stdout, '(/,5x,"site n. atom ", &
& " positions (cryst. coord.)")')
write (6, '(7x,i2,8x,a6," tau(",i3,") = (",3f11.7," )")') &
WRITE( stdout, '(7x,i2,8x,a6," tau(",i3,") = (",3f11.7," )")') &
(na, atm(ityp(na)), na, (xau(ipol,na), ipol=1,3), na=1,nat)
!
! deallocate work space
@ -278,30 +279,30 @@ subroutine summary
endif
if (lgauss) then
write (6, '(/5x,"number of k points=",i5, &
WRITE( stdout, '(/5x,"number of k points=",i5, &
& " gaussian broad. (ryd)=",f8.4,5x, &
& "ngauss = ",i3)') nkstot, degauss, ngauss
else if (ltetra) then
write(6,'(/5x,"number of k points=",i5, &
WRITE( stdout,'(/5x,"number of k points=",i5, &
& " (tetrahedron method)")') nkstot
else
write (6, '(/5x,"number of k points=",i5)') nkstot
WRITE( stdout, '(/5x,"number of k points=",i5)') nkstot
endif
write (6, '(23x,"cart. coord. in units 2pi/a_0")')
WRITE( stdout, '(23x,"cart. coord. in units 2pi/a_0")')
do ik = 1, nkstot
write (6, '(8x,"k(",i4,") = (",3f12.7,"), wk =",f12.7)') ik, &
WRITE( stdout, '(8x,"k(",i4,") = (",3f12.7,"), wk =",f12.7)') ik, &
(xk (ipol, ik) , ipol = 1, 3) , wk (ik)
enddo
if (iverbosity.eq.1) then
write (6, '(/23x,"cryst. coord.")')
WRITE( stdout, '(/23x,"cryst. coord.")')
do ik = 1, nkstot
do ipol = 1, 3
xkg(ipol) = at(1,ipol)*xk(1,ik) + at(2,ipol)*xk(2,ik) + &
at(3,ipol)*xk(3,ik)
! xkg are the component in the crystal RL basis
enddo
write (6, '(8x,"k(",i4,") = (",3f12.7,"), wk =",f12.7)') &
WRITE( stdout, '(8x,"k(",i4,") = (",3f12.7,"), wk =",f12.7)') &
ik, (xkg (ipol) , ipol = 1, 3) , wk (ik)
enddo
endif
@ -309,7 +310,7 @@ subroutine summary
#ifdef __PARA
call ireduce (1, ngmtot)
#endif
write (6, '(/5x,"G cutoff =",f10.4," (", &
WRITE( stdout, '(/5x,"G cutoff =",f10.4," (", &
& i7," G-vectors)"," FFT grid: (",i3, &
& ",",i3,",",i3,")")') gcutm, ngmtot, nr1, nr2, nr3
if (doublegrid) then
@ -317,15 +318,15 @@ subroutine summary
#ifdef __PARA
call ireduce (1, ngmtot)
#endif
write (6, '(5x,"G cutoff =",f10.4," (", &
WRITE( stdout, '(5x,"G cutoff =",f10.4," (", &
& i7," G-vectors)"," smooth grid: (",i3, &
& ",",i3,",",i3,")")') gcutms, ngmtot, nr1s, nr2s, nr3s
endif
if (isolve.eq.2) then
write (6, * )
write (6, '(5x,"threshold for starting DIIS: ",f10.4)') diis_ethr_cg
write (6, '(5x,"reduced basis size: ",1i5)') diis_ndim
WRITE( stdout, * )
WRITE( stdout, '(5x,"threshold for starting DIIS: ",f10.4)') diis_ethr_cg
WRITE( stdout, '(5x,"reduced basis size: ",1i5)') diis_ndim
endif
#ifdef FLUSH

10
PW/update_pot.f90
View File

@ -38,6 +38,7 @@ subroutine update_pot
!
!
USE io_global, ONLY : stdout
use pwcom
implicit none
@ -62,7 +63,7 @@ subroutine extrapolate_charge
!
#include "machine.h"
!
USE io_global, ONLY : stdout
use pwcom
use io_files, only: prefix
implicit none
@ -80,7 +81,7 @@ subroutine extrapolate_charge
! if order = 1 update the potential subtracting to the charge density
! the "old" atomic charge and summing the new one
!
write (6,'(/5x,"NEW-OLD atomic charge density approx. for the potential")')
WRITE( stdout,'(/5x,"NEW-OLD atomic charge density approx. for the potential")')
!
! in the lsda case the magnetization will follow rigidly the density kee
! fixed the value of zeta=mag/rho_tot. zeta is set here and put in rho(*
@ -167,6 +168,7 @@ subroutine extrapolate_wfcs
!
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY : evc
implicit none
@ -212,9 +214,9 @@ subroutine extrapolate_wfcs
enddo
else
if (order.eq.2) then
write (6, '(5x,"Extrapolating wave-functions (first order) ...")')
WRITE( stdout, '(5x,"Extrapolating wave-functions (first order) ...")')
else
write (6, '(5x,"Extrapolating wave-functions (second order) ...")')
WRITE( stdout, '(5x,"Extrapolating wave-functions (second order) ...")')
endif
allocate ( u_m(nbnd,nbnd), s_m(nbnd,nbnd), sp_m(nbnd,nbnd), &

8
PW/v_of_rho.f90
View File

@ -18,6 +18,7 @@ subroutine v_of_rho (rho, rho_core, nr1, nr2, nr3, nrx1, nrx2, &
! Hartree potential is computed in reciprocal space.
!
!
USE io_global, ONLY : stdout
use parameters, only: DP
implicit none
!
@ -75,6 +76,7 @@ subroutine v_xc (rho, rho_core, nr1, nr2, nr3, nrx1, nrx2, nrx3, &
!
! Exchange-Correlation potential Vxc(r) from n(r)
!
USE io_global, ONLY : stdout
use parameters, only : DP
implicit none
!
@ -175,13 +177,13 @@ subroutine v_xc (rho, rho_core, nr1, nr2, nr3, nrx1, nrx2, nrx3, &
#ifdef __PARA
call ireduce (3, neg)
#endif
if (neg(3).gt.0) write (6,'(/,4x," npt with |zeta| > 1: ",i8, &
if (neg(3).gt.0) WRITE( stdout,'(/,4x," npt with |zeta| > 1: ",i8, &
& ", npt tot ",i8, ",",f10.2, " %" )') neg(3), &
& nr1*nr2*nr3, float(neg(3)*100) / real(nr1*nr2*nr3)
if (neg(1).gt.0) write (6,'(/,4x," npt with rhoup < 0: ",i8, &
if (neg(1).gt.0) WRITE( stdout,'(/,4x," npt with rhoup < 0: ",i8, &
& ", npt tot ",i8, ",",f10.2, " %" )') neg(1), &
& nr1*nr2*nr3, float(neg(1)*100) / real(nr1*nr2*nr3)
if (neg(2).gt.0) write (6,'(/,4x," npt with rhodw < 0: ",i8, &
if (neg(2).gt.0) WRITE( stdout,'(/,4x," npt with rhodw < 0: ",i8, &
& ", npt tot ",i8, ",",f10.2, " %" )') neg(2), &
& nr1*nr2*nr3, float(neg(2)*100) / real(nr1 * nr2 * nr3)
endif

47
PW/vcsmd.f90
View File

@ -26,6 +26,7 @@ subroutine vcsmd
!
#include "machine.h"
USE io_global, ONLY : stdout
use constants, only : e2, uakbar
use brilz
use basis
@ -151,7 +152,7 @@ subroutine vcsmd
enddo
enddo
if (conv_ions) then
write (6,'(/5x,"Damped Dynamics: convergence achieved, Efinal=",&
WRITE( stdout,'(/5x,"Damped Dynamics: convergence achieved, Efinal=",&
& f15.8)') etot
call output_tau
return
@ -172,17 +173,17 @@ subroutine vcsmd
end do
end do
if (conv_ions) then
if (calc.eq.'cm') write (6, &
if (calc.eq.'cm') WRITE( stdout, &
'(/5x,"Parrinello-Rahman Damped Dynamics: convergence achieved, ", &
& "Efinal=", f15.8)') etot
if (calc.eq.'nm') write (6, &
if (calc.eq.'nm') WRITE( stdout, &
'(/5x,"Wentzcovitch Damped Dynamics: convergence achieved, ", &
& "Efinal=", f15.8)') etot
write (6,'(/72("-")//5x,"Final estimate of lattice vectors ", &
WRITE( stdout,'(/72("-")//5x,"Final estimate of lattice vectors ", &
& "(input alat units)")')
write (6, '(3f14.9)') ( (at (i, k) , i = 1, 3) , k = 1, 3)
write (6,'(" final unit-cell volume =",f12.4," (a.u.)^3")') omega
write (6,'(" input alat = ",f12.4," (a.u.)")') alat
WRITE( stdout, '(3f14.9)') ( (at (i, k) , i = 1, 3) , k = 1, 3)
WRITE( stdout,'(" final unit-cell volume =",f12.4," (a.u.)^3")') omega
WRITE( stdout,'(" input alat = ",f12.4," (a.u.)")') alat
!
call output_tau
!
@ -195,21 +196,21 @@ subroutine vcsmd
tempo = (istep - 1) * dt * time_au
if (istep.eq.1 .and. calc.eq.'mm') &
write(6,'(/5x,"Damped Dynamics Minimization", /5x, &
WRITE( stdout,'(/5x,"Damped Dynamics Minimization", /5x, &
& "convergence thresholds: EPSE = ", e8.2," EPSF = ",e8.2)') &
epse, epsf
if (istep.eq.1 .and. calc.eq.'cm') &
write(6,'(/5x,"Parrinello-Rahman Damped Cell-Dynamics Minimization", &
WRITE( stdout,'(/5x,"Parrinello-Rahman Damped Cell-Dynamics Minimization", &
& /5x, "convergence thresholds: EPSE = ", e8.2," EPSF = ", &
& e8.2," EPSP = ",e8.2 )') epse, epsf, epsp
if (istep.eq.1 .and. calc.eq.'nm') &
write(6,'(/5x,"Wentzcovitch Damped Cell-Dynamics Minimization", /5x, &
WRITE( stdout,'(/5x,"Wentzcovitch Damped Cell-Dynamics Minimization", /5x, &
& "convergence thresholds: EPSE = ", e8.2," EPSF = ",e8.2,&
& " EPSP = ",e8.2 )') epse, epsf, epsp
write (6, '(/5x,"Entering Dynamics; it = ",i5," time = ", &
WRITE( stdout, '(/5x,"Entering Dynamics; it = ",i5," time = ", &
& f8.5," pico-seconds"/)') istep, tempo
! write (*,*) ' enter vcsmd ', istep,idone,exst
! WRITE( stdout,*) ' enter vcsmd ', istep,idone,exst
!
! save cell shape of previous step
!
@ -345,7 +346,7 @@ subroutine vcsmd
write (46,*) 'edyn=',edyn
#endif
else
! write (*,'(3f12.6)') ((ratd(ipol,na),ipol=1,3),na=1,nat)
! WRITE( stdout,'(3f12.6)') ((ratd(ipol,na),ipol=1,3),na=1,nat)
enew = etot - e_start
@ -537,16 +538,16 @@ subroutine vcsmd
call recips (at(1,1), at(1,2), at(1,3), bg(1,1), bg(1,2) , bg(1,3) )
call DCOPY (3 * nat, rat, 1, tau, 1)
if (lmovecell) then
write (6, * ) ' new lattice vectors (alat unit) :'
write (6, '(3f14.9)') ( (at (i, k) , i = 1, 3) , k = 1, 3)
write (6,'(a,f12.4,a)') ' new unit-cell volume =', omega, ' (a.u.)^3'
WRITE( stdout, * ) ' new lattice vectors (alat unit) :'
WRITE( stdout, '(3f14.9)') ( (at (i, k) , i = 1, 3) , k = 1, 3)
WRITE( stdout,'(a,f12.4,a)') ' new unit-cell volume =', omega, ' (a.u.)^3'
endif
write (6, * ) ' new positions in cryst coord'
write (6,'(a3,3x,3f14.9)') (atm(ityp(na)), (tau(i,na), i=1,3),na=1,nat)
write (6, * ) ' new positions in cart coord (alat unit)'
WRITE( stdout, * ) ' new positions in cryst coord'
WRITE( stdout,'(a3,3x,3f14.9)') (atm(ityp(na)), (tau(i,na), i=1,3),na=1,nat)
WRITE( stdout, * ) ' new positions in cart coord (alat unit)'
call cryst_to_cart (nat, tau, at, + 1)
write (6,'(a3,3x,3f14.9)') (atm(ityp(na)), (tau(i,na), i=1,3),na=1,nat)
write (6, '(/5x,"Ekin = ",f14.8," Ryd T = ",f6.1," K ", &
WRITE( stdout,'(a3,3x,3f14.9)') (atm(ityp(na)), (tau(i,na), i=1,3),na=1,nat)
WRITE( stdout, '(/5x,"Ekin = ",f14.8," Ryd T = ",f6.1," K ", &
& " Etot = ",f14.8)') ekint, tnew, edyn + e_start
!
! save MD history on file
@ -578,6 +579,8 @@ end subroutine vcsmd
subroutine delete_if_present(filename)
USE io_global, ONLY : stdout
character (len=*) :: filename
logical :: exst, opnd
integer :: iunit
@ -593,7 +596,7 @@ subroutine delete_if_present(filename)
10 continue
open (unit=iunit, file= filename , status='old')
close (unit=iunit, status = 'delete')
write (6,*) 'WARNING: ',filename,' file was present; old file deleted '
WRITE( stdout,*) 'WARNING: ',filename,' file was present; old file deleted '
end if
end subroutine

33
PW/vcsubs.f90
View File

@ -263,7 +263,7 @@ subroutine init (mxdtyp, mxdatm, ntype, natot, rat, ityp, avec, &
enddo
endif
!
! write(6,*) avec2d(2,1),avec2d(3,1), avec2d(3,2)
! WRITE( stdout,*) avec2d(2,1),avec2d(3,1), avec2d(3,2)
!
! compute atomic energies
!
@ -281,7 +281,7 @@ subroutine init (mxdtyp, mxdatm, ntype, natot, rat, ityp, avec, &
uta = enew
eta = eka + uta
!
! write (*,*) 'eka,ekint', eka, ekint
! WRITE( stdout,*) 'eka,ekint', eka, ekint
!
! lattice contribution
!
@ -338,7 +338,7 @@ subroutine init (mxdtyp, mxdatm, ntype, natot, rat, ityp, avec, &
pv = p * vcell
!
! write(6,1001) ekint,ut,etot
! WRITE( stdout,1001) ekint,ut,etot
!
! now make the initial move
!
@ -772,16 +772,16 @@ subroutine move (mxdtyp, mxdatm, ntype, ityp, rat, avec, vcell, &
else
ts = dabs (tnew / temp - um)
endif
! write (6,*) ts
! WRITE( stdout,*) ts
!
! rescale velocities
!
! write (*,*) ' ekla', ekla, ttol,ts, nst, ntcheck, ntimes
! WRITE( stdout,*) ' ekla', ekla, ttol,ts, nst, ntcheck, ntimes
if (mod (nst, ntcheck) .eq.0) then
if ( (ts.gt.ttol) .and. (ntimes.gt.0) ) then
! write (*,*) ' ekkkeka ! non dovrei essere qui !'
! write(6,*) 'nst,ntcheck, ts, ttol,ntimes'
! write(6,*) nst,ntcheck, ts, ttol,ntimes
! WRITE( stdout,*) ' ekkkeka ! non dovrei essere qui !'
! WRITE( stdout,*) 'nst,ntcheck, ts, ttol,ntimes'
! WRITE( stdout,*) nst,ntcheck, ts, ttol,ntimes
!
if (tnew.le.0.1d-12) then
alpha = zero
@ -813,7 +813,7 @@ subroutine move (mxdtyp, mxdatm, ntype, ityp, rat, avec, vcell, &
endif
if (calc (2:2) .eq.'m') then
! write(6,109) alpha,nst
! WRITE( stdout,109) alpha,nst
if (.false.) then
do na = 1, natot
do k = 1, 3
@ -851,7 +851,7 @@ subroutine move (mxdtyp, mxdatm, ntype, ityp, rat, avec, vcell, &
do l = 1, 3
xx = avec2d (l, k) * avec2di (l, k)
if (xx.lt.zero) then
! write ( *, * ) l, k, avec2d (l, k), avec2di (l, k)
! WRITE( stdout, * ) l, k, avec2d (l, k), avec2di (l, k)
avecd (l, k) = zero
endif
enddo
@ -919,6 +919,7 @@ subroutine ranv (ntype, natot, ityp, atmass, mxdtyp, mxdatm, temp, &
! v(i,na) = initial velocity of atom na of type nt
! vmean(nt), rms(nt),vx2(nt),vy2(nt),vz2(nt)
!
USE io_global, ONLY : stdout
use parameters , only : DP
implicit none
!
@ -973,8 +974,8 @@ subroutine ranv (ntype, natot, ityp, atmass, mxdtyp, mxdatm, temp, &
do nt = 1, ntype
natom = 0
vfac = dsqrt (boltz * t / atmass (nt) )
! write(6,901)
! write(6,*) 'vfac = ',vfac
! WRITE( stdout,901)
! WRITE( stdout,*) 'vfac = ',vfac
iseed = iseed+382
do na = 1, natot
if (ityp (na) .eq.nt) then
@ -1000,7 +1001,7 @@ subroutine ranv (ntype, natot, ityp, atmass, mxdtyp, mxdatm, temp, &
p (3) = zero
ekin (nt) = zero
if (natom.eq.0) then
write (6,*) 'natom=0 for type',nt,'in sub ranv (1) !!!! '
WRITE( stdout,*) 'natom=0 for type',nt,'in sub ranv (1) !!!! '
go to 111
end if
!
@ -1032,7 +1033,7 @@ subroutine ranv (ntype, natot, ityp, atmass, mxdtyp, mxdatm, temp, &
v(3,na)*v(3,na) ) / dois
endif
enddo
! write(6,*) 'ekin(nt)',ekin(nt)
! WRITE( stdout,*) 'ekin(nt)',ekin(nt)
ekin (nt) = atmass (nt) * ekin (nt)
ekint = ekint + ekin (nt)
111 continue
@ -1043,8 +1044,8 @@ subroutine ranv (ntype, natot, ityp, atmass, mxdtyp, mxdatm, temp, &
atemp = dois * ekint / tres / dfloat (natot - 1) / boltz
tfac = dsqrt (t / atemp)
if (temp.lt.1d-14) tfac = zero
! write(6,*) 'atemp = ',atemp,' k'
! write(6,*) 'tfac = ',tfac
! WRITE( stdout,*) 'atemp = ',atemp,' k'
! WRITE( stdout,*) 'tfac = ',tfac
do nt = 1, ntype
vmean (nt) = zero
rms (nt) = zero

13
PW/wfcinit.f90
View File

@ -14,6 +14,7 @@ subroutine wfcinit
! from superposition of atomic wavefunctions.
!
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY : evc
implicit none
@ -33,7 +34,7 @@ subroutine wfcinit
! state what is going to happen
!
if (startingwfc == 'file') then
write (6, '(5x,a)') 'Starting wfc from file'
WRITE( stdout, '(5x,a)') 'Starting wfc from file'
!
! read the wavefunction into memory (if it is not done in c_bands)
!
@ -44,14 +45,14 @@ subroutine wfcinit
call start_clock ('wfcinit')
if (startingwfc == 'atomic') then
if (natomwfc >= nbnd) then
write (6, '(5x,a)') 'Starting wfc are atomic'
WRITE( stdout, '(5x,a)') 'Starting wfc are atomic'
else
write (6, '(5x,a,i3,a)') 'Starting wfc are atomic + ',&
WRITE( stdout, '(5x,a,i3,a)') 'Starting wfc are atomic + ',&
nbnd-natomwfc, ' random wfc'
endif
n_starting_wfc = max (natomwfc, nbnd)
else
write (6, '(5x,a)') 'Starting wfc are random'
WRITE( stdout, '(5x,a)') 'Starting wfc are random'
n_starting_wfc = nbnd
endif
!
@ -139,8 +140,8 @@ subroutine wfcinit
call poolrecover (et, nbnd, nkstot, nks)
#endif
do ik = 1, nkstot
write (6, 9010) (xk (ipol, ik), ipol = 1, 3)
write (6, '(2x,8f9.4)') (et (ibnd, ik) * rytoev, ibnd = 1, nbnd)
WRITE( stdout, 9010) (xk (ipol, ik), ipol = 1, 3)
WRITE( stdout, '(2x,8f9.4)') (et (ibnd, ik) * rytoev, ibnd = 1, nbnd)
enddo
endif
#ifdef FLUSH

2
PW/which_dft.f90
View File

@ -100,7 +100,7 @@ subroutine which_dft (dft, iexch, icorr, igcx, igcc)
dftout = exc (iexch) //'-'//corr (icorr) //'-'//gradx (igcx) //'-' &
&//gradc (igcc)
!cc write (6,'(a)') dftout
!cc WRITE( stdout,'(a)') dftout
return
end subroutine which_dft
!

25
PW/write_ns.f90
View File

@ -9,6 +9,7 @@
subroutine write_ns
!-----------------------------------------------------------------------
USE io_global, ONLY : stdout
use pwcom
implicit none
integer :: is, na, nt, m1, m2, ldim
@ -19,14 +20,14 @@ subroutine write_ns
complex(kind=DP) :: f (ldmx, ldmx), vet (ldmx, ldmx)
real(kind=DP) :: lambda (ldmx), nsum, nsuma
write (*,*) 'enter write_ns'
WRITE( stdout,*) 'enter write_ns'
if ( 2 * Hubbard_lmax + 1 .gt. ldmx ) &
call errore ('write_ns', 'ldmx is too small', 1)
write (6,'(6(a,i2,a,f8.4,6x))') &
WRITE( stdout,'(6(a,i2,a,f8.4,6x))') &
('U(',nt,') =', Hubbard_U(nt) * rytoev, nt=1,ntyp)
write (6,'(6(a,i2,a,f8.4,6x))') &
WRITE( stdout,'(6(a,i2,a,f8.4,6x))') &
('alpha(',nt,') =', Hubbard_alpha(nt) * rytoev, nt=1,ntyp)
nsum = 0.d0
@ -41,7 +42,7 @@ subroutine write_ns
end do
end do
if (nspin.eq.1) nsuma = 2.d0 * nsuma
write(6,'(a,x,i2,2x,a,f11.7)') 'atom', na, ' Tr[ns(na)]= ', nsuma
WRITE( stdout,'(a,x,i2,2x,a,f11.7)') 'atom', na, ' Tr[ns(na)]= ', nsuma
nsum = nsum + nsuma
do is = 1, nspin
do m1 = 1, ldim
@ -50,21 +51,21 @@ subroutine write_ns
enddo
enddo
call cdiagh(ldim, f, ldmx, lambda, vet)
write(6,'(a,x,i2,2x,a,x,i2)') 'atom', na, 'spin', is
write(6,'(a,7f10.7)') 'eigenvalues: ',(lambda(m1),m1=1,ldim)
write(6,*) 'eigenvectors'
WRITE( stdout,'(a,x,i2,2x,a,x,i2)') 'atom', na, 'spin', is
WRITE( stdout,'(a,7f10.7)') 'eigenvalues: ',(lambda(m1),m1=1,ldim)
WRITE( stdout,*) 'eigenvectors'
do m2 = 1, ldim
write(6,'(i2,2x,7(f10.7,x))') m2,(dreal(vet(m1,m2)),m1=1,ldim)
WRITE( stdout,'(i2,2x,7(f10.7,x))') m2,(dreal(vet(m1,m2)),m1=1,ldim)
end do
write(6,*) 'occupations'
WRITE( stdout,*) 'occupations'
do m1 = 1, ldim
write (6,'(7(f6.3,x))') (nsnew(m1,m2,is,na),m2=1,ldim)
WRITE( stdout,'(7(f6.3,x))') (nsnew(m1,m2,is,na),m2=1,ldim)
end do
enddo
endif
enddo
write (6, '(a,x,f11.7)') 'nsum =', nsum
write (*,*) 'exit write_ns'
WRITE( stdout, '(a,x,f11.7)') 'nsum =', nsum
WRITE( stdout,*) 'exit write_ns'
return
end subroutine write_ns