Commit c5d8ff2f authored by cavazzon's avatar cavazzon

- unit 6 replaced by stdout in CPV

- ^M removed from pseudo files
- wavefunctions arrais moved to module
  wavefunctions_module, common to all codes
  this is required to reduce duplicated subroutine
- new lapack subroutine, called from PWCOND,
  added to lib/lapack.f lib/lapack_ibm.f


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@381 c92efa57-630b-4861-b058-cf58834340f0
parent 1d6e63dd
This diff is collapsed.
This diff is collapsed.
......@@ -254,6 +254,7 @@
! g^2 (dvps)
!
use control_flags, only: iprint, tpre, iprsta
use io_global, only: stdout
use bhs
use gvec
use gvecs
......@@ -290,7 +291,7 @@
end do
eself=eself/sqrt(2.*pi)
if(tfirst.or.iprsta.ge.4)then
write(6,1200) eself
WRITE( stdout,1200) eself
endif
1200 format(2x,'formf: eself=',f10.5)
!
......@@ -458,8 +459,8 @@
call reduce(1,vpsum)
call reduce(1,rhopsum)
#endif
write(6,1250) vps(1,is),rhops(1,is)
write(6,1300) vpsum,rhopsum
WRITE( stdout,1250) vps(1,is),rhops(1,is)
WRITE( stdout,1300) vpsum,rhopsum
endif
!
end do
......@@ -496,7 +497,7 @@
use control_flags, only: iprint
use gvec
use gvecw, only: ngw
use pres_mod
use gvecw, only: ggp, agg => ecutz, sgg => ecsig, e0gg => ecfix
implicit none
!
integer nr1, nr2, nr3
......@@ -682,6 +683,7 @@
! use ibrav=0 for generic cell vectors given by the matrix h(3,3)
!
use control_flags, only: iprint, thdyn
use io_global, only: stdout
use gvec
use gvecw, only: ngw
use ions_base, only: na, pmass, nsp
......@@ -689,7 +691,7 @@
use elct
use constants, only: pi, fpi
use cell_base, only: wmass, hold, h
use pres_mod
use gvecw, only: ggp, agg => ecutz, sgg => ecsig, e0gg => ecfix
use betax, only: mmx, refg
use restart
use parameters, only: nacx, nsx, natx
......@@ -732,7 +734,7 @@
end do
!
refg=1.0*ecut/(mmx-1)
write(6,*) ' NOTA BENE: refg, mmx = ',refg,mmx
WRITE( stdout,*) ' NOTA BENE: refg, mmx = ',refg,mmx
!
if(thdyn) then
if(thdiag) then
......@@ -763,11 +765,11 @@
& lambda,lambdam,xnhe0,xnhem,vnhe,xnhp0,xnhpm,vnhp,ekincm, &
& xnhh0,xnhhm,vnhh,velh,ecut,ecutw,delt,pmass,ibrav,celldm,fion)
!
write(6,344) ibrav
WRITE( stdout,344) ibrav
do i=1,3
write(6,345) (h(i,j),j=1,3)
WRITE( stdout,345) (h(i,j),j=1,3)
enddo
write(6,*)
WRITE( stdout,*)
else
!
! with variable-cell we use h to describe the cell
......@@ -809,14 +811,14 @@
end do
!
if(.not. twmass) then
write(6,998) wmass
WRITE( stdout,998) wmass
else
wmass=0.
do is=1,nsp
wmass=wmass+na(is)*pmass(is)
enddo
wmass=wmass*0.75/pi/pi
write(6,999) wmass
WRITE( stdout,999) wmass
endif
998 format(' wmass (read from input) = ',f15.2,/)
999 format(' wmass (calculated) = ',f15.2,/)
......@@ -834,6 +836,7 @@
! are recalculated according to the value of cell parameter h
!
use control_flags, only: iprint, iprsta
use io_global, only: stdout
use gvec
use grid_dimensions, only: nr1, nr2, nr3
use cell_base, only: ainv, a1, a2, a3
......@@ -842,7 +845,7 @@
use smallbox_grid_dimensions, only: nr1b, nr2b, nr3b
use small_box, only: a1b, a2b, a3b, ainvb, omegab, tpibab
use cell_base, only: h, deth
use pres_mod
use gvecw, only: ggp, agg => ecutz, sgg => ecsig, e0gg => ecfix
!
implicit none
integer ibrav
......@@ -901,13 +904,13 @@
end do
! ==============================================================
if(iprsta.ge.4)then
write(6,34) ibrav,alat,omega
WRITE( stdout,34) ibrav,alat,omega
if(ibrav.eq.0) then
write(6,344)
WRITE( stdout,344)
do i=1,3
write(6,345) (h(i,j),j=1,3)
WRITE( stdout,345) (h(i,j),j=1,3)
enddo
write(6,*)
WRITE( stdout,*)
endif
endif
!
......@@ -926,6 +929,7 @@
! See also comments in nlinit
!
use control_flags, only: iprint, tpre, iprsta
use io_global, only: stdout
use gvec
use gvecw, only: ngw
use reciprocal_vectors, only: ng0 => gstart
......@@ -968,7 +972,7 @@
! ---------------------------------------------------------------
! calculation of array qradb(igb,iv,jv,is)
! ---------------------------------------------------------------
if(iprsta.ge.4) write(6,*) ' qradb '
if(iprsta.ge.4) WRITE( stdout,*) ' qradb '
c=fpi/omegab
!
do l=1,nqlc(is)
......@@ -1056,7 +1060,7 @@
! ---------------------------------------------------------------
! calculation of array beta(ig,iv,is)
! ---------------------------------------------------------------
if(iprsta.ge.4) write(6,*) ' beta '
if(iprsta.ge.4) WRITE( stdout,*) ' beta '
c=fpi/sqrt(omega)
do iv=1,nh(is)
lp=indlm(iv,is)
......@@ -1112,7 +1116,7 @@
do ig=1,ngb
rhocb(ig,is)=c*qgbs(ig)
end do
if(iprsta.ge.4) write(6,'(a,f12.8)') &
if(iprsta.ge.4) WRITE( stdout,'(a,f12.8)') &
& ' integrated core charge= ',omegab*rhocb(1,is)
deallocate(jl)
deallocate(fint)
......@@ -1226,6 +1230,7 @@
! (this is done in routine newnlinit)
!
use control_flags, only: iprint, tpre
use io_global, only: stdout
use gvec
use gvecw, only: ngw
use cvan
......@@ -1342,7 +1347,7 @@
! ---------------------------------------------------------------
! calculation of array qradx(igb,iv,jv,is)
! ---------------------------------------------------------------
write(6,*) ' nlinit nh(is),ngb,is,kkbeta,lqx = ', &
WRITE( stdout,*) ' nlinit nh(is),ngb,is,kkbeta,lqx = ', &
& nh(is),ngb,is,kkbeta(is),nqlc(is)
do l=1,nqlc(is)
do il=1,mmx
......@@ -1412,12 +1417,12 @@
end do
end do
!
write(6,*)
write(6,'(20x,a)') ' qqq '
WRITE( stdout,*)
WRITE( stdout,'(20x,a)') ' qqq '
do iv=1,nbeta(is)
write(6,'(8f9.4)') (qqq(iv,jv,is),jv=1,nbeta(is))
WRITE( stdout,'(8f9.4)') (qqq(iv,jv,is),jv=1,nbeta(is))
end do
write(6,*)
WRITE( stdout,*)
!
deallocate(jl)
deallocate(fint)
......@@ -1449,7 +1454,7 @@
! ---------------------------------------------------------------
! calculation of array betagx(ig,iv,is)
! ---------------------------------------------------------------
write(6,*) ' betagx '
WRITE( stdout,*) ' betagx '
do iv=1,nh(is)
l=nhtol(iv,is)+1
do il=1,mmx
......@@ -1524,14 +1529,14 @@
end do
!
do iv=1,nh(is)
write(6,901) iv,indv(iv,is),nhtol(iv,is)
WRITE( stdout,901) iv,indv(iv,is),nhtol(iv,is)
end do
901 format(2x,i2,' indv= ',i2,' ang. mom= ',i2)
!
write(6,*)
write(6,'(20x,a)') ' dion '
WRITE( stdout,*)
WRITE( stdout,'(20x,a)') ' dion '
do iv=1,nbeta(is)
write(6,'(8f9.4)') (fac*dion(iv,jv,is),jv=1,nbeta(is))
WRITE( stdout,'(8f9.4)') (fac*dion(iv,jv,is),jv=1,nbeta(is))
end do
!
deallocate(jltmp)
......
......@@ -10,6 +10,7 @@
subroutine errore(a,b,n)
!-----------------------------------------------------------------------
use io_global, only: stdout
character(len=*) a,b
integer n
#ifdef __PARA
......@@ -17,7 +18,7 @@ subroutine errore(a,b,n)
integer ierr
#endif
!
write(6,1) a,b,n
WRITE( stdout,1) a,b,n
1 format(//' program ',a,':',a,'.',8x,i8,8x,'stop')
#ifdef __MPI
call mpi_abort( MPI_COMM_WORLD, ierr, ierr)
......
......@@ -51,7 +51,7 @@ CONTAINS
use constants, only: pi, scmass, factem, eps8
use parameters, only: nsx, natx, nbndxx
use io_global, only: ionode
use io_global, only: ionode, stdout
use mp, only: mp_bcast
!
......@@ -577,54 +577,54 @@ CONTAINS
! --------------------------------------------------------
! print out heading
!
write(6,500) nbeg_ , nomore_ , iprint_ , ndr_ , ndw_
write(6,505) delt_
write(6,510) emass_ , emaec_
WRITE( stdout,500) nbeg_ , nomore_ , iprint_ , ndr_ , ndw_
WRITE( stdout,505) delt_
WRITE( stdout,510) emass_ , emaec_
!
if( tortho_ ) then
write(6,511) eps_ , max_
WRITE( stdout,511) eps_ , max_
else
write(6,512)
WRITE( stdout,512)
endif
!
if( tsde_ ) then
write(6,513)
WRITE( stdout,513)
else
if ( tnosee_ ) frice_ = 0.
write(6,509)
write(6,514) frice_ , grease_
WRITE( stdout,509)
WRITE( stdout,514) frice_ , grease_
endif
!
if ( trhor_ ) then
write(6,720)
WRITE( stdout,720)
endif
!
if( .not. trhor_ .and. trhow_ )then
write(6,721)
WRITE( stdout,721)
endif
!
if( tvlocw_ )then
write(6,722)
WRITE( stdout,722)
endif
!
if( trane_ ) then
write(6,515) ampre_
WRITE( stdout,515) ampre_
endif
write(6,516)
WRITE( stdout,516)
do is =1, nsp_
if(tranp_(is)) write(6,517) is, amprp_(is)
if(tranp_(is)) WRITE( stdout,517) is, amprp_(is)
end do
!
if(tfor_) then
if(tnosep_) fricp_ = 0.
write(6,520)
WRITE( stdout,520)
if(tsdp_)then
write(6,521)
WRITE( stdout,521)
else
write(6,522) fricp_ , greasp_
WRITE( stdout,522) fricp_ , greasp_
endif
else
write(6,518)
WRITE( stdout,518)
endif
!
if( tfor_ ) then
......@@ -632,7 +632,7 @@ CONTAINS
call errore(' main',' t contr. for ions when tsdp=.t.',0)
endif
if(.not. tcp_ .and. .not. tcap_ .and. .not. tnosep_ ) then
write(6,550)
WRITE( stdout,550)
else if(tcp_ .and. tcap_ ) then
call errore(' main',' tcp and tcap both true',0)
else if(tcp_ .and. tnosep_ ) then
......@@ -640,35 +640,35 @@ CONTAINS
else if(tcap_ .and. tnosep_ ) then
call errore(' main',' tcap and tnosep both true',0)
else if(tcp_ ) then
write(6,555) tempw_ , tolp_
WRITE( stdout,555) tempw_ , tolp_
else if(tcap_) then
write(6,560) tempw_ , tolp_
WRITE( stdout,560) tempw_ , tolp_
else if(tnosep_ ) then
write(6,562) tempw_ , qnp_
WRITE( stdout,562) tempw_ , qnp_
end if
if(tnosee_) then
write(6,566) ekincw_ , qne_
WRITE( stdout,566) ekincw_ , qne_
end if
end if
!
if(tpre_) then
write(6,600)
WRITE( stdout,600)
if(thdyn_) then
if(thdiag_) write(6,608)
if(thdiag_) WRITE( stdout,608)
if(tnoseh_) then
frich_=0.
write(6,604) temph_,qnh_,press_
WRITE( stdout,604) temph_,qnh_,press_
else
write(6,602) frich_,greash_,press_
WRITE( stdout,602) frich_,greash_,press_
endif
else
write(6,606)
WRITE( stdout,606)
endif
endif
if ( agg_ .ne. 0.d0) then
write(6,650) agg_, sgg_, e0gg_
WRITE( stdout,650) agg_, sgg_, e0gg_
end if
write(6,700) iprsta_
WRITE( stdout,700) iprsta_
!
500 format(// &
......
......@@ -146,6 +146,7 @@
#ifdef __PARA
use para_mod, only: me
#endif
use io_global, only: stdout
implicit none
character(len=80) command
integer pid
......@@ -155,7 +156,7 @@
pid=getpid_()
write(command,10) pid
10 format('ps -lp ',i8,' | grep -v SZ | awk ''{print $10}'' ')
write(6,'(''Estimated size (kB) of each process: '',$)')
WRITE( stdout,'(''Estimated size (kB) of each process: '',$)')
call system(command)
#endif
......@@ -164,7 +165,7 @@
pid=getpid()
write(command,10) pid
10 format('ps -lp ',i8,'|grep -v SZ|awk ''{print $10}''|cut -f1 -d:')
write(6,'(''Total estimated size (pages) of each process: '',$)')
WRITE( stdout,'(''Total estimated size (pages) of each process: '',$)')
#ifdef __PARA
if(me.eq.1) &
#endif
......
......@@ -322,10 +322,3 @@ module cdvan
drhovan(:,:,:,:,:)
end module cdvan
module pres_mod
use gvecw, only: agg => ecutz, sgg => ecsig, e0gg => ecfix
implicit none
save
real(kind=8),allocatable:: ggp(:)
end module pres_mod
......@@ -92,6 +92,7 @@ end module para_mod
!
use para_mod
use mp, only: mp_start, mp_env
use io_global, only: stdout
use global_version
!
implicit none
......@@ -122,16 +123,16 @@ end module para_mod
! only the first processor writes
!
if ( me == 1 ) then
write(6,'(72("*"))')
write(6,'(4("*"),64x,4("*"))')
write(6,'(4("*")," CPV: variable-cell Car-Parrinello ", &
WRITE( stdout,'(72("*"))')
WRITE( stdout,'(4("*"),64x,4("*"))')
WRITE( stdout,'(4("*")," CPV: variable-cell Car-Parrinello ", &
& "molecular dynamics ",4("*"))')
write(6,'(4("*")," using ultrasoft Vanderbilt ", &
WRITE( stdout,'(4("*")," using ultrasoft Vanderbilt ", &
& "pseudopotentials - v.",a6,8x,4("*"))') version_number
write(6,'(4("*"),64x,4("*"))')
write(6,'(72("*"))')
write(6,'(/5x,''Parallel version (MPI)'')')
write(6,'(5x,''Number of processors in use: '',i4)') nproc
WRITE( stdout,'(4("*"),64x,4("*"))')
WRITE( stdout,'(72("*"))')
WRITE( stdout,'(/5x,''Parallel version (MPI)'')')
WRITE( stdout,'(5x,''Number of processors in use: '',i4)') nproc
else
open(6,file='/dev/null',status='unknown')
!
......@@ -264,6 +265,7 @@ end module para_mod
use para_mod
use stick_base
use fft_scalar, only: good_fft_dimension
use io_global, only: stdout
!
implicit none
real(kind=8) b1(3), b2(3), b3(3), gcut, gcuts, gcutw
......@@ -523,14 +525,14 @@ end module para_mod
! ipc is the processor for this column in the dense grid
! ipcs is the same, for the smooth grid
!
write(6,"( &
WRITE( stdout,"( &
& ' Proc planes cols G planes cols G columns G',/, &
& ' (dense grid) (smooth grid) (wavefct grid)' )" )
do i=1,nproc
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), ncpw(i), ngpw(i)
end do
write(6,'(i3,2x,3(i5,2i7))') 0, SUM(npp(1:nproc)), SUM(ncp(1:nproc)), &
WRITE( stdout,'(i3,2x,3(i5,2i7))') 0, SUM(npp(1:nproc)), SUM(ncp(1:nproc)), &
SUM(ngp(1:nproc)), SUM(npps(1:nproc)), SUM(ncps(1:nproc)), &
SUM(ngps(1:nproc)), SUM(ncpw(1:nproc)), SUM(ngpw(1:nproc))
!
......@@ -675,13 +677,13 @@ end module para_mod
call tictac(27,1)
! do i = 1, nproc
! write(6,fmt="('DEBUG fft_setup ',3I5 )" ) i, npp(i), dfftp%npp(i)
! write(6,fmt="('DEBUG fft_setup ',3I5 )" ) i, npps(i), dffts%npp(i)
! WRITE( stdout,fmt="('DEBUG fft_setup ',3I5 )" ) i, npp(i), dfftp%npp(i)
! WRITE( stdout,fmt="('DEBUG fft_setup ',3I5 )" ) i, npps(i), dffts%npp(i)
! end do
! write(6,fmt="('DEBUG fft_setup ',3I9 )" ) nnr_, dfftp%nnr
! write(6,fmt="('DEBUG fft_setup ',3I9 )" ) nnrs_, dffts%nnr
! write(6,fmt="('DEBUG fft_setup ',3I9 )" ) nct, dfftp%nst
! write(6,fmt="('DEBUG fft_setup ',3I9 )" ) ncts, dffts%nst
! WRITE( stdout,fmt="('DEBUG fft_setup ',3I9 )" ) nnr_, dfftp%nnr
! WRITE( stdout,fmt="('DEBUG fft_setup ',3I9 )" ) nnrs_, dffts%nnr
! WRITE( stdout,fmt="('DEBUG fft_setup ',3I9 )" ) nct, dfftp%nst
! WRITE( stdout,fmt="('DEBUG fft_setup ',3I9 )" ) ncts, dffts%nst
!
return
end
......@@ -807,6 +809,7 @@ end module para_mod
!
use para_mod
use timex_mod
use io_global, only: stdout
!
implicit none
include 'mpif.h'
......@@ -828,12 +831,12 @@ end module para_mod
if (ierr.ne.0) &
& call errore('print_para_times','error in maximum',ierr)
!
write(6,*)
write(6,*) ' routine calls cpu time elapsed'
write(6,*) ' node0 node0, min, max node0'
write(6,*)
WRITE( stdout,*)
WRITE( stdout,*) ' routine calls cpu time elapsed'
WRITE( stdout,*) ' node0 node0, min, max node0'
WRITE( stdout,*)
do i=1, maxclock
if (ntimes(i).gt.0) write(6,30) routine(i), &
if (ntimes(i).gt.0) WRITE( stdout,30) routine(i), &
& ntimes(i), cputime(i), mincpu(i),maxcpu(i), elapsed(i)
end do
30 format(a10,i7,4f8.1)
......
......@@ -440,16 +440,16 @@ CONTAINS
strlen = index(filename,' ') - 1
OPEN(unit=ndr, file=filename(1:strlen), form='unformatted', status='old')
REWIND (ndr)
WRITE(6,10)
WRITE( stdout,10)
10 FORMAT(/,3X,'READING FROM RESTART FILE ...')
end if
if (flag.eq.-1) then
write(6,'((a,i3,a))') ' ### reading from file ',ndr,' only h ##'
WRITE( stdout,'((a,i3,a))') ' ### reading from file ',ndr,' only h ##'
else if (flag.eq.0) then
write(6,'((a,i3,a))') ' ## reading from file ',ndr,' only c0 ##'
WRITE( stdout,'((a,i3,a))') ' ## reading from file ',ndr,' only c0 ##'
else
write(6,'((a,i3))') ' ## reading from file ',ndr
WRITE( stdout,'((a,i3))') ' ## reading from file ',ndr
end if
! ==--------------------------------------------------------------==
......
......@@ -99,7 +99,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
!
......
......@@ -52,6 +52,8 @@
! nac=number of columns of a, number of rows of b
! nbc=number of columns of b and c
!
use io_global, only: stdout
implicit none
integer na, iad, nb, ibd, nc, icd, nar, nac, nbc
real(kind=8) a(iad,nac), b(ibd,nbc), c(icd,nbc)
......@@ -76,9 +78,9 @@
!
if ( na.ne.1.and.iad.ne.1 .or. &
& nb.ne.1.and.ibd.ne.1 .or. nc.ne.1 ) then
write (6,'(''MXMA : na,nb,nc,iad,ibd,icd,nar,nac,nbc =''/ &
WRITE( stdout,'(''MXMA : na,nb,nc,iad,ibd,icd,nar,nac,nbc =''/ &
& 9i8)') na,nb,nc,iad,ibd,icd,nar,nac,nbc
write (6,'(''MXMA : not implemented'')')
WRITE( stdout,'(''MXMA : not implemented'')')
stop
end if
!
......
......@@ -169,7 +169,6 @@ PHOBJS = ../PH/phcom.o \
MODULES = ../Modules/*.o
PWOBJS = ../PW/pwcom.o \
../PW/wavefunctions.o \
../PW/aainit.o \
../PW/addusdens.o \
../PW/addusforce.o \
......
......@@ -16,7 +16,7 @@ subroutine d0rhod2v (ipert, drhoscf)
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY : evc
USE wavefunctions_module, ONLY : evc
use phcom
use d3com
#ifdef __PARA
......
......@@ -16,7 +16,7 @@ subroutine d3vrho
!
#include "machine.h"
use pwcom
USE wavefunctions, ONLY: evc
USE wavefunctions_module, ONLY: evc
use phcom
use d3com
!
......
......@@ -16,7 +16,7 @@ subroutine dqrhod2v (ipert, drhoscf)
!
#include "machine.h"
use pwcom
USE wavefunctions, ONLY: evc
USE wavefunctions_module, ONLY: evc
use phcom
use d3com
#ifdef __PARA
......
......@@ -19,7 +19,7 @@ subroutine gen_dpdvp
!
#include "machine.h"
use pwcom
USE wavefunctions, ONLY: evc
USE wavefunctions_module, ONLY: evc
use phcom
use d3com
......
......@@ -17,7 +17,7 @@ subroutine incdrhoscf2 (drhoscf, weight, ik, dbecsum, mode, flag)
!
#include "machine.h"
use pwcom
USE wavefunctions, ONLY: evc
USE wavefunctions_module, ONLY: evc
use phcom
implicit none
......
......@@ -31,7 +31,7 @@ subroutine solve_linter_d3 (irr, imode0, npe, isw_sl)
#include "machine.h"
USE io_global, ONLY : stdout
use pwcom
USE wavefunctions, ONLY : evc
USE wavefunctions_module, ONLY : evc
use phcom
use d3com
......
......@@ -7,7 +7,6 @@ include ../make.sys
# targets
#
PWOBJS=../PW/pwcom.o \
../PW/wavefunctions.o \
../PW/para.o \
../PW/funct.o \
../PW/g_psi_mod.o \
......
......@@ -12,7 +12,7 @@ subroutine A_h(e,h,ah)
#include "machine.h"
use parameters, only: DP
use pwcom
USE wavefunctions, ONLY: evc, psic
USE wavefunctions_module, ONLY: evc, psic
USE constants, ONLY: degspin
use rbecmod, only: becp
use cgcom
......
......@@ -20,7 +20,7 @@ subroutine allocate_wfc
USE ldaU, ONLY : swfcatom, lda_plus_u