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

Check on undefined variables, out-of-bound arrays 

Several implicit none re-added, pwcom modules split


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@466 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2004-01-06 10:53:30 +00:00
parent 5a8c4a05dc
commit 183a01bc5e
25 changed files with 135 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
PP/addusdens1d.f90
View File

@ -21,7 +21,7 @@ subroutine addusdens1d (plan, prho)
!
! here the local variables
!
implicit none
integer :: ig, na, nt, ih, jh, ijh, ngm1d, ig1dto3d (nr3), &
igtongl1d (nr3), nl1d (nr3)
! counter on G vectors

1
PP/bands.f90
View File

@ -141,6 +141,7 @@ subroutine punch_band (filband)
!
! prepare the indices of this k point
!
npw=npwx
call gk_sort (xk (1, ik), ngm, g, ecutwfc / tpiba2, npw, &
igk, g2kin)
!

2
PP/elf.f90
View File

@ -66,7 +66,7 @@ subroutine do_elf (elf)
!
! prepare the indices of this k point
!
npw=npwx
call gk_sort (xk (1, ik), ngm, g, ecutwfc / tpiba2, npw, igk, g2kin)
!
! reads the eigenfunctions

2
PP/ggen1d.f90
View File

@ -14,7 +14,7 @@ subroutine ggen1d (ngm1d, g1d, gg1d, ig1dto3d, nl1d, igtongl1d)
!
use pwcom
implicit none
integer :: ngm1d, ig1dto3d (nr3), igtongl1d (nr3), nl1d (nr3)
! output: the number of 1D G vectors on this proce
! output: correspondence 1D with 3D G vectors

1
PP/local_dos.f90
View File

@ -96,6 +96,7 @@ subroutine local_dos (iflag, lsign, kpoint, kband, emin, emax, dos)
do ik = 1, nks
if (ik.eq.kpoint.or.iflag.ne.0) then
if (lsda) current_spin = isk (ik)
npw=npwx
call gk_sort (xk (1, ik), ngm, g, ecutwfc / tpiba2, npw, igk, g2kin)
call davcio (evc, nwordwfc, iunwfc, ik, - 1)
call init_us_2 (npw, igk, xk (1, ik), vkb)

22
PP/plot_io.f90
View File

@ -24,22 +24,22 @@ subroutine plot_io (filplot, title, nrx1, nrx2, nrx3, nr1, nr2, &
character (len=*) :: filplot
character (len=75) :: title
integer :: nrx1, nrx2, nrx3, nr1, nr2, nr3, nat, ntyp, ibrav, &
plot_num, ityp (ntyp), iflag, i
plot_num, ityp (nat), iflag, i
character (len=3) :: atm(ntyp)
real(kind=DP) :: celldm (6), gcutm, dual, ecut, zv (ntyp), tau (3, nat) &
, plot (nrx1 * nrx2 * nrx3), at(3,3)
!
integer :: iunplot, ios, ipol, na, nt, ir, ndum
if (filplot.eq.' ') call errore ('plot_io', 'filename missing', 1)
!
if (filplot == ' ') call errore ('plot_io', 'filename missing', 1)
!
iunplot = 4
if (iflag.gt.0) then
if (iflag > 0) then
WRITE( stdout, '(5x,"Writing data on file ",a)') filplot
open (unit = iunplot, file = filplot, form = 'formatted', &
status = 'unknown', err = 100, iostat = ios)
else
if (iflag.lt.0) then
if (iflag < 0) then
WRITE( stdout, '(5x,"Reading data from file ",a)') filplot
else
WRITE( stdout, '(5x,"Reading header from file ",a)') filplot
@ -51,12 +51,12 @@ subroutine plot_io (filplot, title, nrx1, nrx2, nrx3, nr1, nr2, &
100 call errore ('plot_io', 'opening file '//filplot, abs (ios) )
rewind (iunplot)
if (iflag.gt.0) then
if (iflag > 0) then
write (iunplot, '(a)') title
write (iunplot, '(8i8)') nrx1, nrx2, nrx3, nr1, nr2, nr3, nat, &
ntyp
write (iunplot, '(i6,6f12.8)') ibrav, celldm
if (ibrav.eq.0) then
if (ibrav == 0) then
do i = 1,3
write ( iunplot, * ) ( at(ipol,i),ipol=1,3 )
enddo
@ -66,19 +66,19 @@ subroutine plot_io (filplot, title, nrx1, nrx2, nrx3, nr1, nr2, &
(nt, atm (nt), zv (nt), nt=1, ntyp)
write (iunplot, '(i4,3x,3f15.9,3x,i2)') (na, &
(tau (ipol, na), ipol = 1, 3), ityp (na), na = 1, nat)
if (plot_num.ne.9) write (iunplot, '(5(1pe17.9))') (plot (ir) , &
if (plot_num /= 9) write (iunplot, '(5(1pe17.9))') (plot (ir) , &
ir = 1, nrx1 * nrx2 * nr3)
else
read (iunplot, '(a)') title
read (iunplot, * ) nrx1, nrx2, nrx3, nr1, nr2, nr3, nat, ntyp
read (iunplot, * ) ibrav, celldm
if (ibrav.eq.0) then
if (ibrav == 0) then
do i = 1,3
read ( iunplot, * ) ( at(ipol,i),ipol=1,3 )
enddo
endif
read (iunplot, * ) gcutm, dual, ecut, plot_num
if (iflag.lt.0) then
if (iflag < 0) then
read (iunplot, '(i4,3x,a2,3x,f5.2)') &
(ndum, atm(nt), zv(nt), nt=1, ntyp)
read (iunplot, *) (ndum, (tau (ipol, na), ipol = 1, 3), &
@ -87,6 +87,6 @@ subroutine plot_io (filplot, title, nrx1, nrx2, nrx3, nr1, nr2, &
endif
endif
if (plot_num.ne.9) close (unit = iunplot)
if (plot_num /= 9) close (unit = iunplot)
return
end subroutine plot_io

14
PP/plotrho.f90
View File

@ -162,15 +162,17 @@ program plotrho
xs = 4.0
ys = 3.0
! contour lines plus gray levels (shading for negative values)
! uncomment the call to "cplot" if you want contour lines,
! plus gray levels and shading for negative values
!call cplot (rhoo, nxmax, nymax, x, xmin, xmax, nx, y, ymin, ymax, &
! ny, nlevels, z, xdim, ydim, xs, ys, filename, fileout)
call cplot (rhoo, nxmax, nymax, x, xmin, xmax, nx, y, ymin, ymax, &
ny, nlevels, z, xdim, ydim, xs, ys, filename, fileout)
! contour lines of various kinds (solid, dashed, etc)
! uncomment the call to "psplot" if you want contour lines
! of various kinds: solid, dashed, etc
call psplot ( rhoo, nxmax, x, nx, y, ny, nlevels, z, xdim, ydim, &
xs, ys, fileout)
! call psplot ( rhoo, nxmax, x, nx, y, ny, nlevels, z, xdim, ydim, &
! xs, ys, fileout)
call atomi (nat, tau, ityp, at, a0, r0, tau1, tau2, xdim, ydim)
20 stop

1
PP/stm.f90
View File

@ -154,6 +154,7 @@ subroutine stm (wf, sample_bias, z, dz, stm_wfc_matching, stmdos)
! of the wavefunctions to the stm dos
!
do ik = 1, nks
npw=npwx
call gk_sort (xk (1, ik), ngm, g, ecutwfc / tpiba2, npw, igk, g2kin)
call davcio (evc, nwordwfc, iunwfc, ik, - 1)
!

3
PW/bp_c_phase.f90
View File

@ -428,6 +428,7 @@ SUBROUTINE c_phase
IF (kpar /= 1) THEN
! --- Dot wavefunctions and betas for PREVIOUS k-point ---
npw0 = npwx
CALL gk_sort(xk(1,kpoint-1),ngm,g,ecutwfc/tpiba2, &
npw0,igk0,g2kin_bp)
CALL davcio(psi,nwordwfc,iunwfc,kpoint-1,-1)
@ -436,6 +437,7 @@ SUBROUTINE c_phase
! --- Dot wavefunctions and betas for CURRENT k-point ---
IF (kpar /= nppstr) THEN
npw1 = npwx
CALL gk_sort(xk(1,kpoint),ngm,g,ecutwfc/tpiba2, &
npw1,igk1,g2kin_bp)
CALL davcio(evc,nwordwfc,iunwfc,kpoint,-1)
@ -443,6 +445,7 @@ SUBROUTINE c_phase
CALL ccalbec(nkb,npwx,npw,nbnd,becp_bp,vkb,evc)
ELSE
kstart = kpoint-nppstr+1
npw1 = npwx
CALL gk_sort(xk(1,kstart),ngm,g,ecutwfc/tpiba2, &
npw1,igk1,g2kin_bp)
CALL davcio(evc,nwordwfc,iunwfc,kstart,-1)

1
PW/bp_calc_btq.f90
View File

@ -8,6 +8,7 @@
!
use pwcom
!
implicit none
integer :: ik, msh_bp, i, np, m, k, l
integer :: n,idbes,ilmin,ilmax,iv,jv
real(DP) :: jl(ndm), ql, sum, jlp1(ndm), aux(ndm), &

1
PW/bp_qvan3.f90
View File

@ -6,6 +6,7 @@
! calculate qg = SUM_LM (-I)^L AP(LM,iv,jv) YR_LM QRAD(iv,jv,L,is)
use pwcom
implicit none
integer :: iv,jv,is
complex(DP) :: qg,sig
real(DP) :: ylm_k(lqx*lqx)

4
PW/bp_zgedi.f
View File

@ -1,7 +1,7 @@
c
subroutine zgedi(a,lda,n,ipvt,det,work,job)
integer lda,n,ipvt(1),job
complex*16 a(lda,1),det(2),work(1)
integer lda,n,ipvt(n),job
complex*16 a(lda,n),det(2),work(n)
c
c zgedi computes the determinant and inverse of a matrix
c using the factors computed by zgeco or zgefa.

4
PW/bp_zgefa.f
View File

@ -1,7 +1,7 @@
c
subroutine zgefa(a,lda,n,ipvt,info)
integer lda,n,ipvt(1),info
complex*16 a(lda,1)
integer lda,n,ipvt(n),info
complex*16 a(lda,n)
c
c zgefa factors a complex*16 matrix by gaussian elimination.
c

70
PW/mix_rho.f90
View File

@ -17,9 +17,15 @@ subroutine mix_rho (rhout, rhoin, nsout, nsin, alphamix, dr2, iter, &
! d.d. johnson prb 38, 12807 (1988)
! On output: the mixed density is in rhoin, rhout is UNCHANGED
!
use parameters, only : DP
use pwcom
USE parameters, ONLY : DP
USE basis, ONLY: nat
USE gvect, ONLY: nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, nl, nlm
USE ldaU, ONLY: lda_plus_u, Hubbard_lmax
USE lsda_mod, ONLY: nspin
USE varie, ONLY: imix, ngm0, tr2
USE wvfct, ONLY: gamma_only
USE wavefunctions_module, ONLY : psic
implicit none
!
! First the I/O variable
!
@ -271,7 +277,8 @@ subroutine mix_rho (rhout, rhoin, nsout, nsin, alphamix, dr2, iter, &
!
do i=1,iter_used
do j=i,iter_used
betamix(i,j) = rho_dot_product(df(1,j),df(1,i)) + &
betamix(i,j) = rho_dot_product(df(1,j),df(1,i))
if (lda_plus_u) betamix(i,j) = betamix(i,j) + &
ns_dot_product(df_ns(1,1,1,1,j),df_ns(1,1,1,1,i))
end do
end do
@ -288,7 +295,8 @@ subroutine mix_rho (rhout, rhoin, nsout, nsin, alphamix, dr2, iter, &
end do
!
do i=1,iter_used
work(i) = rho_dot_product(df(1,i),rhocout) + &
work(i) = rho_dot_product(df(1,i),rhocout)
if (lda_plus_u) work(i) = work(i) + &
ns_dot_product(df_ns(1,1,1,1,i),nsout)
end do
!
@ -375,11 +383,17 @@ function rho_dot_product (rho1,rho2)
!--------------------------------------------------------------------
! this function evaluates the dot product between two input densities
!
use parameters, only : DP
use pwcom
USE parameters, ONLY : DP
USE constants, ONLY : e2, tpi, fpi
USE brilz, ONLY: omega, tpiba2
USE gvect, ONLY: gstart, gg
USE lsda_mod, ONLY: nspin
USE varie, ONLY: ngm0
USE wvfct, ONLY: gamma_only
!
! I/O variables
!
implicit none
real (kind=DP) :: rho_dot_product ! (out) the function value
complex (kind=DP) :: rho1(ngm0,nspin), rho2(ngm0,nspin) ! (in) the two densities
@ -437,11 +451,15 @@ function ns_dot_product (ns1,ns2)
!--------------------------------------------------------------------
! this function evaluates the dot product between two input densities
!
use parameters, only : DP
use pwcom
USE parameters, ONLY : DP
USE ldaU, ONLY: lda_plus_u, Hubbard_lmax, Hubbard_l, Hubbard_U, &
Hubbard_alpha
USE basis, ONLY: nat, ityp
USE lsda_mod, ONLY: nspin
!
! I/O variables
!
implicit none
real (kind=DP) :: ns_dot_product ! (out) the function value
real (kind=DP) :: ns1(2*Hubbard_lmax+1,2*Hubbard_lmax+1,nspin,nat), &
@ -480,8 +498,15 @@ function fn_dehar (drho)
!--------------------------------------------------------------------
! this function evaluates the residual hartree energy of drho
!
use parameters, only : DP
use pwcom
USE parameters, ONLY : DP
USE constants, ONLY : e2, fpi
USE brilz, ONLY: omega, tpiba2
USE gvect, ONLY: gstart, gg
USE lsda_mod, ONLY: nspin
USE varie, ONLY: ngm0
USE wvfct, ONLY: gamma_only
implicit none
!
! I/O variables
!
@ -527,11 +552,17 @@ subroutine approx_screening (drho)
!--------------------------------------------------------------------
! apply an average TF preconditioning to drho
!
use parameters, only : DP
use pwcom
USE parameters, ONLY : DP
USE constants, ONLY : e2, pi, fpi
USE brilz, ONLY: omega, tpiba2
USE gvect, ONLY: gstart, gg
USE klist, ONLY: nelec
USE lsda_mod, ONLY: nspin
USE varie, ONLY: ngm0
!
! I/O
!
implicit none
complex (kind=DP) drho(ngm0,nspin) ! (in/out)
!
! and the local variables
@ -570,19 +601,24 @@ end subroutine approx_screening
!--------------------------------------------------------------------
! apply a local-density dependent TF preconditioning to drho
!
use parameters, only : DP
use pwcom
USE parameters, ONLY : DP
USE constants, ONLY : e2, pi, tpi, fpi
USE brilz, ONLY: omega, tpiba2
USE gvect, ONLY: nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, nl, nlm, gg
USE klist, ONLY: nelec
USE lsda_mod, ONLY: nspin
USE varie, ONLY: ngm0
USE wvfct, ONLY: gamma_only
USE wavefunctions_module, ONLY : psic
!
! I/O
!
!
implicit none
complex (kind=DP) :: drho(ngm0,nspin), rhobest(ngm0,nspin)
!
! and the local variables
!
integer :: mmx
parameter (mmx=12)
integer, parameter :: mmx=12
integer :: iwork(mmx),i,j,m,info, nspin_save
real (kind=DP) :: rs, min_rs, max_rs, avg_rsm1, target, &
dr2_best, ccc, cbest, l2smooth

2
PW/output_tau.f90
View File

@ -14,7 +14,9 @@ subroutine output_tau
use constants, only: bohr_radius_angs
use brilz, only: alat, at, bg
use basis, only: nat, tau, atomic_positions, ityp, atm
implicit none
real (kind=DP), allocatable:: tau_out (:, :)
integer :: na, i
!
! tau in output format
!

23
PW/readin.f90
View File

@ -12,10 +12,15 @@ subroutine readpp
! Read pseudopotentials
!
#include "machine.h"
use pwcom
use io_files, only: pseudo_dir, psfile
USE atom, ONLY: numeric, xmin, dx
USE us, ONLY: tvanp, iver
USE basis, ONLY: ntyp
USE varie, ONLY: newpseudo
USE funct, ONLY: iexch, icorr, igcx, igcc
USE io_files, ONLY: pseudo_dir, psfile
!
character :: file_pseudo * 256
implicit none
character(len=256) :: file_pseudo
! file name complete with path
integer :: iunps, isupf, l, nt, ios, pseudo_type
integer :: iexch_, icorr_, igcx_, igcc_
@ -51,8 +56,8 @@ subroutine readpp
! *.RRKJ3 Andrea's US new code pseudo_type=2
! none of the above: PWSCF norm-conserving format pseudo_type=0
!
if (pseudo_type (psfile (nt) ) .eq.1 &
.or.pseudo_type (psfile (nt) ) .eq.2) then
if ( pseudo_type (psfile (nt) ) == 1 .or. &
pseudo_type (psfile (nt) ) == 2 ) then
!
! The vanderbilt pseudopotential is always in numeric form
!
@ -65,12 +70,12 @@ subroutine readpp
! produced by Vanderbilt code and those produced
! by Andrea's atomic code.
!
if (pseudo_type (psfile (nt) ) .eq.1) then
if (pseudo_type (psfile (nt) ) == 1) then
newpseudo (nt) = .false.
tvanp (nt) = .true.
call readvan (nt, iunps)
endif
if (pseudo_type (psfile (nt) ) .eq.2) then
if (pseudo_type (psfile (nt) ) == 2) then
newpseudo (nt) = .true.
! tvanp is read inside readnewvan
call readnewvan (nt, iunps)
@ -96,11 +101,11 @@ subroutine readpp
if (nt == 1) then
iexch_ = iexch
icorr_ = icorr
igxc_ = igxc
igcx_ = igcx
igcc_ = igcc
else
if ( iexch_ /= iexch .or. icorr_ /= icorr .or. &
igxc_ /= igxc .or. igcc_ /= igcc ) then
igcx_ /= igcx .or. igcc_ /= igcc ) then
CALL errore( 'readpp','inconsistent DFT read',nt)
end if
end if

10
PW/vhpsi.f90
View File

@ -14,8 +14,14 @@ subroutine vhpsi (ldap, np, mp, psip, hpsi)
! of the current k-point, the result is added to hpsi
!
#include "machine.h"
USE parameters, ONLY: DP
USE atom, ONLY: oc, lchi, nchi
USE ldaU, ONLY: Hubbard_lmax, Hubbard_l, Hubbard_U, Hubbard_alpha, &
ns, nsnew, swfcatom
USE lsda_mod, ONLY: nspin, current_spin
USE basis, ONLY: nat, ntyp, ityp, natomwfc
USE varie, ONLY: newpseudo
use pwcom
implicit none
integer :: ldap, np, mp
complex(kind=DP) :: psip (ldap, mp), hpsi (ldap, mp)
@ -31,7 +37,7 @@ subroutine vhpsi (ldap, np, mp, psip, hpsi)
do na = 1, nat
nt = ityp (na)
do n = 1, nchi (nt)
if (oc (n, nt) .gt.0.d0.or..not.newpseudo (nt) ) then
if (oc (n, nt) > 0.d0 .or. .not.newpseudo (nt) ) then
l = lchi (n, nt)
if (l.eq.Hubbard_l(nt)) offset (na) = counter
counter = counter + 2 * l + 1

13
PW/write_config_to_file.f90
View File

@ -8,8 +8,10 @@
!-----------------------------------------------------------------------
subroutine write_config_to_file_old
!-----------------------------------------------------------------------
use pwcom
use io_files, only : prefix, iunres
USE brilz, ONLY : ibrav, alat, at
USE basis, ONLY : nat, tau
USE varie, ONLY : lscf
USE io_files, ONLY : prefix, iunres
implicit none
logical :: exst
integer :: iunit
@ -36,9 +38,10 @@ end subroutine write_config_to_file_old
!-----------------------------------------------------------------------
subroutine write_config_to_file
!-----------------------------------------------------------------------
use pwcom, only: lscf, dp
use io_files, only : prefix, iunres
use restart_module, only : writefile_new
USE varie, ONLY : lscf
USE parameters, ONLY : DP
USE io_files, ONLY : prefix, iunres
USE restart_module, ONLY : writefile_new
!
implicit none
!

9
PW/write_ns.f90
View File

@ -9,12 +9,17 @@
subroutine write_ns
!-----------------------------------------------------------------------
USE parameters, only : DP
USE constants, ONLY : rytoev
USE basis, ONLY : nat, ntyp, ityp
USE lsda_mod, ONLY : nspin
USE io_global, ONLY : stdout
use pwcom
USE ldaU, ONLY: Hubbard_lmax, Hubbard_l, Hubbard_U, Hubbard_alpha, &
nsnew
implicit none
integer :: is, na, nt, m1, m2, ldim
! counter on spin component
! counter on atoms and their type
! counters on atoms and their type
! counters on d components
integer, parameter :: ldmx = 7
complex(kind=DP) :: f (ldmx, ldmx), vet (ldmx, ldmx)

1
PWCOND/allocate_cond_2.f90
View File

@ -12,6 +12,7 @@ subroutine allocate_cond_2
!
#include "machine.h"
use cond
implicit none
allocate( newbg(ngper, n2d) )
allocate( psiper( n2d, n2d, nrzp ) )

1
PWCOND/bessj.f90
View File

@ -11,6 +11,7 @@ function bessj(n,x)
!
use parameters, only : DP
implicit none
integer, parameter :: iacc=40
integer :: n, j, jsum, m
real(kind=DP), parameter :: bigno=1.d10, bigni=1.d-10

1
PWCOND/free_mem.f90
View File

@ -11,6 +11,7 @@ subroutine free_mem
!
#include "machine.h"
use cond
implicit none
!
! From local_2
!

2
flib/avrec.f90
View File

@ -14,7 +14,9 @@
! ...
USE kinds
IMPLICIT NONE
INTEGER, INTENT(IN) :: n
INTEGER :: i
REAL(dbl), INTENT(IN) :: alpha
REAL(dbl), INTENT(IN) :: v(*)
REAL(dbl), INTENT(OUT) :: av(*)

1
flib/iglocal.f90
View File

@ -6,6 +6,7 @@
! global index is ig. If the G vector is not local to the current
! processor, then the function returns -1
!
IMPLICIT NONE
INTEGER, INTENT(IN) :: ig
INTEGER, INTENT(IN) :: ng
INTEGER, INTENT(IN) :: ig_l2g( ng ), sortedig_l2g( ng )

4
flib/itoa.f90
View File

@ -6,9 +6,11 @@
! or http://www.gnu.org/copyleft/gpl.txt .
!
! trasforma un numero intero in una stringa
! trasform an integer number into a string
subroutine cpitoa(n,str)
implicit none
integer, intent(in) :: n
character(LEN=*) str
integer i, npow, j, nq, ntmp