more 0:ndm => 1:ndm

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@816 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2004-04-24 11:58:24 +00:00
parent d198ebad0c
commit c90e9062bd
6 changed files with 62 additions and 75 deletions

View File

@ -823,14 +823,14 @@
!
INTEGER, INTENT(IN) :: iuni
REAL(dbl), INTENT(IN) :: zmesh, xmin, dx
REAL(dbl), INTENT(IN) :: r(0:), rab(0:), vnl(0:,0:), chi(0:,:)
REAL(dbl), INTENT(IN) :: oc(:), rho_at(0:), rho_atc(0:)
REAL(dbl), INTENT(IN) :: r(:), rab(:), vnl(:,0:), chi(:,:)
REAL(dbl), INTENT(IN) :: oc(:), rho_at(:), rho_atc(:)
INTEGER, INTENT(IN) :: mesh, msh, nchi, lchi(:)
LOGICAL, INTENT(IN) :: numeric
REAL(dbl), INTENT(IN) :: cc(2), alpc(2), zp, aps(6,0:3), alps(3,0:3), zv
INTEGER, INTENT(IN) :: nlc, nnl, lmax, lloc
LOGICAL, INTENT(IN) :: bhstype
REAL(dbl), INTENT(IN) :: dion(:,:), betar(0:,:), qqq(:,:), qfunc(0:,:,:)
REAL(dbl), INTENT(IN) :: dion(:,:), betar(:,:), qqq(:,:), qfunc(:,:,:)
REAL(dbl), INTENT(IN) :: qfcoef(:,:,:,:), rinner(:)
INTEGER, INTENT(IN) :: nh, nbeta, kkbeta, nqf, nqlc, ifqopt, lll(:), iver(3)
LOGICAL, INTENT(IN) :: tvanp, okvan, newpseudo
@ -896,12 +896,12 @@
WRITE(iuni) zmesh, xmin, dx, mesh, msh, nchi, numeric, zp, zv, nlc, nnl, lmax, lloc, &
bhstype, nh, nbeta, kkbeta, nqf, nqlc, ifqopt, tvanp, okvan, newpseudo, &
iexch, icorr, igcx, igcc, lsda, a_nlcc, b_nlcc, alpha_nlcc, nlcc, psd
WRITE(iuni) r( 0:mesh_ ), rab( 0:mesh_ ), &
vnl( 0:mesh_, 0:lloc_ ), chi( 0:mesh_, 1:nchi_ ), &
oc( 1:nchi_ ), rho_at( 0:mesh_ ), rho_atc( 0:mesh_ ), lchi( 1:nchi_ )
WRITE(iuni) r( 1:mesh_ ), rab( 1:mesh_ ), &
vnl( 1:mesh_, 0:lloc_ ), chi( 1:mesh_, 1:nchi_ ), &
oc( 1:nchi_ ), rho_at( 1:mesh_ ), rho_atc( 1:mesh_ ), lchi( 1:nchi_ )
WRITE(iuni) cc(1:2), alpc(1:2), aps(1:6,0:3), alps(1:3,0:3)
WRITE(iuni) dion( 1:nbeta_, 1:nbeta_ ), betar( 0:mesh_, 1:nbeta_ ), &
qqq( 1:nbeta_, 1:nbeta_ ), qfunc( 0:mesh_, 1:nbeta_, 1:nbeta_ ), &
WRITE(iuni) dion( 1:nbeta_, 1:nbeta_ ), betar( 1:mesh_, 1:nbeta_ ), &
qqq( 1:nbeta_, 1:nbeta_ ), qfunc( 1:mesh_, 1:nbeta_, 1:nbeta_ ), &
qfcoef( 1:nqf_, 1:nqlc_, 1:nbeta_, 1:nbeta_ ), &
rinner( 1:nqlc_ ), lll( 1:nbeta_ ), iver(1:3)
@ -984,19 +984,19 @@
CALL errore( sub_name, ' wrong size ', 2 )
IF( SIZE(oc) < nwfc ) &
CALL errore( sub_name, ' wrong size ', 3 )
IF( SIZE(r) < ( mesh + 1 ) ) &
IF( SIZE(r) < mesh ) &
CALL errore( sub_name, ' wrong size ', 4 )
IF( SIZE(rab) < ( mesh + 1 ) ) &
IF( SIZE(rab) < mesh ) &
CALL errore( sub_name, ' wrong size ', 5 )
IF( SIZE(rho_atc) < ( mesh + 1 ) ) &
IF( SIZE(rho_atc) < mesh ) &
CALL errore( sub_name, ' wrong size ', 6 )
IF( SIZE(vloc) < ( mesh + 1 ) ) &
IF( SIZE(vloc) < mesh ) &
CALL errore( sub_name, ' wrong size ', 7 )
IF( SIZE(lll) < nbeta ) &
CALL errore( sub_name, ' wrong size ', 8 )
IF( SIZE(kkbeta) < nbeta ) &
CALL errore( sub_name, ' wrong size ', 9 )
IF( ( SIZE(beta,1) < ( mesh + 1 ) ) .OR. ( SIZE(beta,2) < nbeta ) ) &
IF( ( SIZE(beta,1) < mesh ) .OR. ( SIZE(beta,2) < nbeta ) ) &
CALL errore( sub_name, ' wrong size ', 10 )
IF( ( SIZE(dion,1) < nbeta ) .OR. ( SIZE(dion,2) < nbeta ) ) &
CALL errore( sub_name, ' wrong size ', 11 )
@ -1004,15 +1004,15 @@
CALL errore( sub_name, ' wrong size ', 12 )
IF( ( SIZE(qqq,1) < nbeta ) .OR. ( SIZE(qqq,2) < nbeta ) ) &
CALL errore( sub_name, ' wrong size ', 13 )
IF( ( SIZE(qfunc,1) < ( mesh + 1 ) ) .OR. ( SIZE(qfunc,2) < nbeta ) .OR. &
IF( ( SIZE(qfunc,1) < mesh ) .OR. ( SIZE(qfunc,2) < nbeta ) .OR. &
( SIZE(qfunc,3) < nbeta ) ) &
CALL errore( sub_name, ' wrong size ', 14 )
IF( ( SIZE(qfcoef,1) < nqf ) .OR. ( SIZE(qfcoef,2) < nqlc ) .OR. &
( SIZE(qfcoef,3) < nbeta ) .OR. ( SIZE(qfcoef,4) < nbeta ) ) &
CALL errore( sub_name, ' wrong size ', 15 )
IF( ( SIZE(chi,1) < ( mesh + 1 ) ) .OR. ( SIZE(chi,2) < nwfc ) ) &
IF( ( SIZE(chi,1) < mesh ) .OR. ( SIZE(chi,2) < nwfc ) ) &
CALL errore( sub_name, ' wrong size ', 16 )
IF( SIZE(rho_at) < ( mesh + 1 ) ) &
IF( SIZE(rho_at) < mesh ) &
CALL errore( sub_name, ' wrong size ', 17 )
IF( ionode ) THEN
@ -1022,11 +1022,11 @@
WRITE(iuni) generated, date_author, comment, psd, typ, tvanp, nlcc, dft, &
zp, etotps, ecutwfc, ecutrho, nv, lmax, mesh, nwfc, nbeta, nd, nqf, nqlc
!
WRITE(iuni) els(1:nwfc), lchi(nwfc), oc(nwfc), r(0:mesh), rab(0:mesh), &
rho_atc(0:mesh), vloc(0:mesh), lll(1:nbeta), kkbeta(1:nbeta), beta(0:mesh,1:nbeta), &
WRITE(iuni) els(1:nwfc), lchi(nwfc), oc(nwfc), r(1:mesh), rab(1:mesh), &
rho_atc(1:mesh), vloc(1:mesh), lll(1:nbeta), kkbeta(1:nbeta), beta(1:mesh,1:nbeta), &
dion(1:nbeta,1:nbeta), rinner(1:nqlc), qqq(1:nbeta,1:nbeta), &
qfunc(0:mesh, 1:nbeta, 1:nbeta), qfcoef(1:nqf, 1:nqlc, 1:nbeta, 1:nbeta), &
chi(0:mesh, nwfc), rho_at(0:mesh)
qfunc(1:mesh, 1:nbeta, 1:nbeta), qfcoef(1:nqf, 1:nqlc, 1:nbeta, 1:nbeta), &
chi(1:mesh, nwfc), rho_at(1:mesh)
WRITE(iuni) idum
WRITE(iuni) idum
@ -1083,14 +1083,14 @@
IMPLICIT NONE
INTEGER, INTENT(IN) :: iuni
REAL(dbl), INTENT(OUT) :: zmesh, xmin, dx
REAL(dbl), INTENT(OUT) :: r(0:), rab(0:), vnl(0:,0:), chi(0:,:)
REAL(dbl), INTENT(OUT) :: oc(:), rho_at(0:), rho_atc(0:)
REAL(dbl), INTENT(OUT) :: r(:), rab(:), vnl(:,0:), chi(:,:)
REAL(dbl), INTENT(OUT) :: oc(:), rho_at(:), rho_atc(:)
INTEGER, INTENT(OUT) :: mesh, msh, nchi, lchi(:)
LOGICAL, INTENT(OUT) :: numeric
REAL(dbl), INTENT(OUT) :: cc(2), alpc(2), zp, aps(6,0:3), alps(3,0:3), zv
INTEGER, INTENT(OUT) :: nlc, nnl, lmax, lloc
LOGICAL, INTENT(OUT) :: bhstype
REAL(dbl), INTENT(OUT) :: dion(:,:), betar(0:,:), qqq(:,:), qfunc(0:,:,:)
REAL(dbl), INTENT(OUT) :: dion(:,:), betar(:,:), qqq(:,:), qfunc(:,:,:)
REAL(dbl), INTENT(OUT) :: qfcoef(:,:,:,:), rinner(:)
INTEGER, INTENT(OUT) :: nh, nbeta, kkbeta, nqf, nqlc, ifqopt, lll(:), iver(:)
LOGICAL, INTENT(OUT) :: tvanp, okvan, newpseudo
@ -1215,11 +1215,11 @@
CALL errore( sub_name, ' wrong size ', 14 )
IF( ionode ) THEN
READ(iuni) r(0:mesh_), rab(0:mesh_), vnl(0:mesh_,0:lloc_), chi(0:mesh_,1:nchi_), &
oc(1:nchi_), rho_at(0:mesh_), rho_atc(0:mesh_), lchi(1:nchi_)
READ(iuni) r(1:mesh_), rab(1:mesh_), vnl(1:mesh_,0:lloc_), chi(1:mesh_,1:nchi_), &
oc(1:nchi_), rho_at(1:mesh_), rho_atc(1:mesh_), lchi(1:nchi_)
READ(iuni) cc(1:2), alpc(1:2), aps(1:6,0:3), alps(1:3,0:3)
READ(iuni) dion(1:nbeta_,1:nbeta_), betar(0:mesh_,1:nbeta_), qqq(1:nbeta_,1:nbeta_), &
qfunc(0:mesh_, 1:nbeta_, 1:nbeta_), qfcoef(1:nqf_, 1:nqlc_, 1:nbeta_, 1:nbeta_), &
READ(iuni) dion(1:nbeta_,1:nbeta_), betar(1:mesh_,1:nbeta_), qqq(1:nbeta_,1:nbeta_), &
qfunc(1:mesh_, 1:nbeta_, 1:nbeta_), qfcoef(1:nqf_, 1:nqlc_, 1:nbeta_, 1:nbeta_), &
rinner(1:nqlc_), lll(1:nbeta_), iver(1:3)
END IF
@ -1287,23 +1287,23 @@
CHARACTER(LEN=2) :: els(:) ! els(nwfc)
INTEGER :: lchi(:) ! lchi(nwfc)
REAL(dbl) :: oc(:) ! oc(nwfc)
REAL(dbl) :: r(0:) ! r(mesh)
REAL(dbl) :: rab(0:) ! rab(mesh)
REAL(dbl) :: rho_atc(0:) ! rho_atc(mesh)
REAL(dbl) :: vloc(0:) ! vloc(mesh)
REAL(dbl) :: r(:) ! r(mesh)
REAL(dbl) :: rab(:) ! rab(mesh)
REAL(dbl) :: rho_atc(:) ! rho_atc(mesh)
REAL(dbl) :: vloc(:) ! vloc(mesh)
INTEGER :: lll(:) ! lll(nbeta)
INTEGER :: kkbeta(:) ! kkbeta(nbeta)
REAL(dbl) :: beta(0:,:) ! beta(mesh,nbeta)
REAL(dbl) :: beta(:,:) ! beta(mesh,nbeta)
INTEGER :: nd
REAL(dbl) :: dion(:,:) ! dion(nbeta,nbeta)
INTEGER :: nqf
INTEGER :: nqlc
REAL(dbl) :: rinner(:) ! rinner(0:2*lmax)
REAL(dbl) :: qqq(:,:) ! qqq(nbeta,nbeta)
REAL(dbl) :: qfunc(0:,:,:) ! qfunc(mesh,nbeta,nbeta)
REAL(dbl) :: qfunc(:,:,:) ! qfunc(mesh,nbeta,nbeta)
REAL(dbl) :: qfcoef(:,:,:,:) ! qfcoef(nqf,0:2*lmax,nbeta,nbeta)
REAL(dbl) :: chi(0:,:) ! chi(mesh,nwfc)
REAL(dbl) :: rho_at(0:) ! rho_at(mesh)
REAL(dbl) :: chi(:,:) ! chi(mesh,nwfc)
REAL(dbl) :: rho_at(:) ! rho_at(mesh)
!
!
!
@ -1366,19 +1366,19 @@
CALL errore( sub_name, ' wrong size ', 2 )
IF( SIZE(oc) < nwfc ) &
CALL errore( sub_name, ' wrong size ', 3 )
IF( SIZE(r) < ( mesh + 1 ) ) &
IF( SIZE(r) < mesh ) &
CALL errore( sub_name, ' wrong size ', 4 )
IF( SIZE(rab) < ( mesh + 1 ) ) &
IF( SIZE(rab) < mesh ) &
CALL errore( sub_name, ' wrong size ', 5 )
IF( SIZE(rho_atc) < ( mesh + 1 ) ) &
IF( SIZE(rho_atc) < mesh ) &
CALL errore( sub_name, ' wrong size ', 6 )
IF( SIZE(vloc) < ( mesh + 1 ) ) &
IF( SIZE(vloc) < mesh ) &
CALL errore( sub_name, ' wrong size ', 7 )
IF( SIZE(lll) < nbeta ) &
CALL errore( sub_name, ' wrong size ', 8 )
IF( SIZE(kkbeta) < nbeta ) &
CALL errore( sub_name, ' wrong size ', 9 )
IF( ( SIZE(beta,1) < ( mesh + 1 ) ) .OR. ( SIZE(beta,2) < nbeta ) ) &
IF( ( SIZE(beta,1) < mesh ) .OR. ( SIZE(beta,2) < nbeta ) ) &
CALL errore( sub_name, ' wrong size ', 10 )
IF( ( SIZE(dion,1) < nbeta ) .OR. ( SIZE(dion,2) < nbeta ) ) &
CALL errore( sub_name, ' wrong size ', 11 )
@ -1386,25 +1386,25 @@
CALL errore( sub_name, ' wrong size ', 12 )
IF( ( SIZE(qqq,1) < nbeta ) .OR. ( SIZE(qqq,2) < nbeta ) ) &
CALL errore( sub_name, ' wrong size ', 13 )
IF( ( SIZE(qfunc,1) < ( mesh + 1 ) ) .OR. ( SIZE(qfunc,2) < nbeta ) .OR. &
IF( ( SIZE(qfunc,1) < mesh ) .OR. ( SIZE(qfunc,2) < nbeta ) .OR. &
( SIZE(qfunc,3) < nbeta ) ) &
CALL errore( sub_name, ' wrong size ', 14 )
IF( ( SIZE(qfcoef,1) < nqf ) .OR. ( SIZE(qfcoef,2) < nqlc ) .OR. &
( SIZE(qfcoef,3) < nbeta ) .OR. ( SIZE(qfcoef,4) < nbeta ) ) &
CALL errore( sub_name, ' wrong size ', 15 )
IF( ( SIZE(chi,1) < ( mesh + 1 ) ) .OR. ( SIZE(chi,2) < nwfc ) ) &
IF( ( SIZE(chi,1) < mesh ) .OR. ( SIZE(chi,2) < nwfc ) ) &
CALL errore( sub_name, ' wrong size ', 16 )
IF( SIZE(rho_at) < ( mesh + 1 ) ) &
IF( SIZE(rho_at) < mesh ) &
CALL errore( sub_name, ' wrong size ', 17 )
IF( ionode ) THEN
!
READ(iuni) els(1:nwfc), lchi(nwfc), oc(nwfc), r(0:mesh), rab(0:mesh), &
rho_atc(0:mesh), vloc(0:mesh), lll(1:nbeta), kkbeta(1:nbeta), &
beta(0:mesh,1:nbeta), &
READ(iuni) els(1:nwfc), lchi(nwfc), oc(nwfc), r(1:mesh), rab(1:mesh), &
rho_atc(1:mesh), vloc(1:mesh), lll(1:nbeta), kkbeta(1:nbeta), &
beta(1:mesh,1:nbeta), &
dion(1:nbeta,1:nbeta), rinner(1:nqlc), qqq(1:nbeta,1:nbeta), &
qfunc(0:mesh, 1:nbeta, 1:nbeta), qfcoef(1:nqf, 1:nqlc, 1:nbeta, 1:nbeta), &
chi(0:mesh, nwfc), rho_at(0:mesh)
qfunc(1:mesh, 1:nbeta, 1:nbeta), qfcoef(1:nqf, 1:nqlc, 1:nbeta, 1:nbeta), &
chi(1:mesh, nwfc), rho_at(1:mesh)
READ(iuni) idum
READ(iuni) idum
@ -1414,20 +1414,20 @@
CALL mp_bcast( els(1:nwfc), ionode_id )
CALL mp_bcast( lchi(nwfc), ionode_id )
CALL mp_bcast( oc(nwfc), ionode_id )
CALL mp_bcast( r(0:mesh), ionode_id )
CALL mp_bcast( rab(0:mesh), ionode_id )
CALL mp_bcast( rho_atc(0:mesh), ionode_id )
CALL mp_bcast( vloc(0:mesh), ionode_id )
CALL mp_bcast( r(mesh), ionode_id )
CALL mp_bcast( rab(mesh), ionode_id )
CALL mp_bcast( rho_atc(mesh), ionode_id )
CALL mp_bcast( vloc(mesh), ionode_id )
CALL mp_bcast( lll(1:nbeta), ionode_id )
CALL mp_bcast( kkbeta(1:nbeta), ionode_id )
CALL mp_bcast( beta(0:mesh,1:nbeta), ionode_id )
CALL mp_bcast( beta(1:mesh,1:nbeta), ionode_id )
CALL mp_bcast( dion(1:nbeta,1:nbeta), ionode_id )
CALL mp_bcast( rinner(1:nqlc), ionode_id )
CALL mp_bcast( qqq(1:nbeta,1:nbeta), ionode_id )
CALL mp_bcast( qfunc(0:mesh, 1:nbeta, 1:nbeta), ionode_id )
CALL mp_bcast( qfunc(1:mesh, 1:nbeta, 1:nbeta), ionode_id )
CALL mp_bcast( qfcoef(1:nqf, 1:nqlc, 1:nbeta, 1:nbeta), ionode_id )
CALL mp_bcast( chi(0:mesh, nwfc), ionode_id )
CALL mp_bcast( rho_at(0:mesh), ionode_id )
CALL mp_bcast( chi(1:mesh, nwfc), ionode_id )
CALL mp_bcast( rho_at(1:mesh), ionode_id )
!
RETURN
END SUBROUTINE

View File

@ -125,7 +125,6 @@ subroutine init_us_1
do l = 0, lmax (nt)
if (l.ne.lloc (nt) ) then
dion (nb, nb, nt) = 1.d0 / vll (l)
betar (0, nb, nt) = 0.d0
do ir = 1, kkbeta (nt)
betar (ir, nb, nt) = vnl (ir, l, nt) * chi (ir, l + 1, nt)
enddo

View File

@ -113,8 +113,6 @@ subroutine read_ncpp (np, iunps)
!
! compute the radial mesh
!
r (0, np) = 0.d0
rab (0, np) = 0.d0
do ir = 1, mesh (np)
x = xmin (np) + dble (ir - 1) * dx (np)
r (ir, np) = exp (x) / zmesh (np)

View File

@ -102,7 +102,6 @@ subroutine readnewvan (is, iunps)
do ir = ikk + 1, mesh (is)
betar (ir, nb, is) = 0.d0
enddo
betar (0, nb, is) = 0.d0
do mb = 1, nb
read (iunps, '(1p4e19.11)', err = 100, iostat = ios) dion (nb, mb, is)
dion (mb, nb, is) = dion (nb, mb, is)
@ -111,8 +110,7 @@ subroutine readnewvan (is, iunps)
qqq (mb, nb, is) = qqq (nb, mb, is)
read (iunps, '(1p4e19.11)', err = 100, iostat = ios) &
(qfunc (n, nb, mb, is) , n = 1, mesh (is) )
qfunc (0, nb, mb, is) = 0.d0
do n = 0, mesh (is)
do n = 1, mesh (is)
qfunc (n, mb, nb, is) = qfunc (n, nb, mb, is)
enddo
else
@ -131,21 +129,18 @@ subroutine readnewvan (is, iunps)
lloc (is) = 0
read (iunps, '(1p4e19.11)', err = 100, iostat = ios) rdum, &
(vnl (ir, lloc (is) , is) , ir = 1, mesh (is) )
vnl (0, lloc (is), is) = 0.d0
!
! reads the atomic charge
!
read (iunps, '(1p4e19.11)', err = 100, iostat = ios) (rho_at (ir, &
is) , ir = 1, mesh (is) )
rho_at (0, is) = 0.d0
!
! if present reads the core charge
!
if (nlcc (is) ) then
read (iunps, '(1p4e19.11)', err = 100, iostat = ios) (rho_atc ( &
ir, is) , ir = 1, mesh (is) )
rho_atc (0, is) = 0.d0
endif
!
! read the pseudo wavefunctions of the atom
@ -154,9 +149,6 @@ subroutine readnewvan (is, iunps)
nb, is) , ir = 1, mesh (is) ) , nb = 1, nwfs)
100 call errore ('readnewvan', 'Reading pseudo file', abs (ios) )
do nb = 1, nwfs
chi (0, nb, is) = 0.d0
enddo
!
! set several variables for compatibility with the rest of the
! code
@ -173,8 +165,6 @@ subroutine readnewvan (is, iunps)
!
! compute the radial mesh
!
r (0, is) = 0.d0
rab (0, is) = 0.d0
do ir = 1, mesh (is)
x = xmin (is) + dble (ir - 1) * dx (is)
r (ir, is) = exp (x) / zmesh (is)

View File

@ -61,7 +61,7 @@ implicit none
itp=itnew(alpha)
nbb=nbnew(alpha)
lb=ls(alpha)
nmesh=indexr(rsph(nbb,itp)*alat,msh(itp),r(0,itp))
nmesh=indexr(rsph(nbb,itp)*alat,msh(itp),r(1,itp))
dz1=dz/nz1
zsl(1)=(z(k)+dz1*0.5d0-taunew(3,alpha))*alat
do kz=2, nz1
@ -74,7 +74,7 @@ implicit none
gn=gnsh(ign)
do kz=1, nz1
if (abs(zsl(kz))+eps.le.rsph(nbb,itp)*alat) then
iz=indexr(zsl(kz),nmesh,r(0,itp))
iz=indexr(zsl(kz),nmesh,r(1,itp))
if ((nmesh-iz)/2*2.eq.nmesh-iz) then
nmeshs=nmesh
else
@ -220,11 +220,11 @@ function indexr(zz, ndim, r)
implicit none
integer :: iz, ndim, indexr
real(kind=DP) :: zz, r(0:ndim)
real(kind=DP) :: zz, r(ndim)
!
! abs(zz)<r(indexr)
!
iz=0
iz=1
do while(r(iz).le.abs(zz)+1.d-10)
iz=iz+1
enddo

View File

@ -18,7 +18,7 @@ subroutine ylmr2 (lmax2, ng, g, gg, ylm)
!
! Input
!
integer :: lmax2, ng, ngx
integer :: lmax2, ng
real(kind=DP) :: g (3, ng), gg (ng)
!
! Output