- File mp_buffers.f90 and ptoolkit.f90 moved to Module directory

- Some common parameters that were defined in different places for different codes,
  has been move to  Modules/parameters


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@106 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
cavazzon 2003-03-02 23:19:44 +00:00
parent b371f3eea6
commit c5443ef48e
13 changed files with 3268 additions and 99 deletions

View File

@ -649,7 +649,7 @@
! nfft=1 add real part of qv(r) to real part of array vr(r)
! nfft=2 add imaginary part of qv(r) to real part of array vr(r)
!
use ion_parameters
use parameters, only: natx, nsx
use parm
use parmb
#ifdef __PARA
@ -703,7 +703,7 @@
! add array qv(r) on box grid to array v(r) on dense grid
! irb : position of the box in the dense grid
!
use ion_parameters
use parameters, only: nsx, natx
use parm
use parmb
#ifdef __PARA
@ -758,7 +758,7 @@
! nfft=1 (2): use real (imaginary) part of qv(r)
! Parallel execution: remember to sum the contributions from other nodes
!
use ion_parameters
use parameters, only: nsx, natx
use parm
use parmb
#ifdef __PARA
@ -940,7 +940,7 @@
use ions_module
!
implicit none
real(kind=8) tau(3,nax,nsp), cdm(3)
real(kind=8) tau(3,natx,nsp), cdm(3)
! local variables
real(kind=8) tmas
integer is,i,ia
@ -1521,7 +1521,7 @@
use dqgb_mod
implicit none
! input
integer, intent(in) :: irb(3,nax,nsx)
integer, intent(in) :: irb(3,natx,nsx)
real(kind=8), intent(in):: rhovan(nat,nhx*(nhx+1)/2,nspin), &
& rhor(nnr,nspin)
complex(kind=8), intent(in):: eigrb(ngb,nas,nsp), rhog(ng,nspin)
@ -2021,14 +2021,14 @@
#endif
implicit none
! input
integer, intent(in) :: irb(3,nax,nsx)
integer, intent(in) :: irb(3,natx,nsx)
complex(kind=8), intent(in):: eigrb(ngb,nas,nsp)
real(kind=8), intent(in) :: vxc(nnr,nspin)
! output
real(kind=8), intent(inout):: fion1(3,nax,nsx)
real(kind=8), intent(inout):: fion1(3,natx,nsx)
! local
integer iss, ix, ig, is, ia, nfft, irb3, imin3, imax3
real(kind=8) fcc(3,nax,nsx), fac, boxdotgrid
real(kind=8) fcc(3,natx,nsx), fac, boxdotgrid
complex(kind=8) ci, facg
external boxdotgrid
!
@ -2036,7 +2036,7 @@
call tictac(21,0)
ci = (0.d0,1.d0)
fac = omega/dfloat(nr1*nr2*nr3*nspin)
call zero(3*nax*nsp,fcc)
call zero(3*natx*nsp,fcc)
do is=1,nsp
if (ifpcor(is).eq.0) go to 10
#ifdef __PARA
@ -2088,7 +2088,7 @@
10 continue
end do
!
call DAXPY(3*nax*nsp,1.d0,fcc,1,fion1,1)
call DAXPY(3*natx*nsp,1.d0,fcc,1,fion1,1)
!
call tictac(21,1)
return
@ -2100,15 +2100,16 @@
!
! forces on ions, ionic term in real space (also stress if requested)
!
use parameters, only: nsx, natx
use control_module, only: tpre
use cnst
use ions_module
use parm
implicit none
! input
real(kind=8) tau0(3,nax,nsx)
real(kind=8) tau0(3,natx,nsx)
! output
real(kind=8) fion(3,nax,nsx), dsr(3,3), esr
real(kind=8) fion(3,natx,nsx), dsr(3,3), esr
! local variables
integer i,j,k,l,m, ii, lax, inf
real(kind=8) rlm(3), rckj, rlmn, arg, addesr, addpre, repand, fxx
@ -2184,7 +2185,7 @@
& ei2(-nr2:nr2,nas,nsp), &
& ei3(-nr3:nr3,nas,nsp)
! output
real(kind=8) fion1(3,nax,nsx)
real(kind=8) fion1(3,natx,nsx)
! local
integer ig, is, isa, ism, ia, ix, iss, isup, isdw
real(kind=8) wz
@ -3406,7 +3407,7 @@
implicit none
!
integer ibrav
real(kind=8) tau(3,nax,nsx), celldm(6), ecut
real(kind=8) tau(3,natx,nsx), celldm(6), ecut
!
integer idum, ik, k, iss, i, in, is, ia
integer good_fft_dimension, good_fft_order
@ -3673,10 +3674,10 @@
use parmb
implicit none
! input
real(kind=8), intent(in):: tau0(3,nax,nsx)
real(kind=8), intent(in):: tau0(3,natx,nsx)
! output
integer, intent(out):: irb(3,nax,nsx)
real(kind=8), intent(out):: taub(3,nax,nsx)
integer, intent(out):: irb(3,natx,nsx)
real(kind=8), intent(out):: taub(3,natx,nsx)
! local
real(kind=8) x(3), xmod
integer nr(3), nrb(3), xint, is, ia, i
@ -4044,15 +4045,15 @@
!
implicit none
! input
integer irb(3,nax,nsx)
integer irb(3,natx,nsx)
complex(kind=8) eigrb(ngb,nas,nsp)
real(kind=8) vr(nnr,nspin), rhovan(nat,nhx*(nhx+1)/2,nspin)
! output
real(kind=8) deeq(nat,nhx,nhx,nspin), fion(3,nax,nsp)
real(kind=8) deeq(nat,nhx,nhx,nspin), fion(3,natx,nsp)
! local
integer isup,isdw,iss, iv,ijv,jv, ik, nfft, isa, ia, is, ig
integer irb3, imin3, imax3
real(kind=8) fvan(3,nax,nsx), fac, fac1, fac2, boxdotgrid
real(kind=8) fvan(3,natx,nsx), fac, fac1, fac2, boxdotgrid
complex(kind=8) ci, facg1, facg2
external boxdotgrid
!
@ -4060,7 +4061,7 @@
ci=(0.d0,1.d0)
fac=omegab/float(nr1b*nr2b*nr3b)
call zero(nat*nhx*nhx*nspin,deeq)
call zero(3*nax*nsx,fvan)
call zero(3*natx*nsx,fvan)
!
! calculation of deeq_i,lm = \int V_eff(r) q_i,lm(r) dr
!
@ -4252,9 +4253,9 @@
end do
end if
#ifdef __PARA
call reduce(3*nax*nvb,fvan)
call reduce(3*natx*nvb,fvan)
#endif
call DAXPY(3*nax*nvb,-1.d0,fvan,1,fion,1)
call DAXPY(3*natx*nvb,-1.d0,fvan,1,fion,1)
!
10 call tictac(11,1)
!
@ -4275,7 +4276,7 @@
!
implicit none
real(kind=8) bec(nhsa,n), becdr(nhsa,n,3), lambda(nx,nx)
real(kind=8) fion(3,nax,nsp)
real(kind=8) fion(3,natx,nsp)
!
integer k, is, ia, iv, jv, i, j, inl
real(kind=8) tt, SSUM
@ -4350,7 +4351,7 @@
real(kind=8) deeq(nat,nhx,nhx,nspin), bec(nhsa,n), becdr(nhsa,n,3),&
& c(2,ngw,n)
complex(kind=8) eigr(ngw,nas,nsp)
real(kind=8) fion(3,nax,nsx)
real(kind=8) fion(3,natx,nsx)
!
integer k, is, ia, isa, iss, inl, iv, jv, i
real(kind=8) tmpbec(nhx,n), tmpdr(nhx,n) ! automatic arrays
@ -4838,7 +4839,7 @@
use control_module
!
implicit none
real(kind=8) taub(3,nax,nsx)
real(kind=8) taub(3,natx,nsx)
complex(kind=8) eigrb(ngb,nas,nsp)
! local
integer i,j,k, is, ia, ig
@ -4964,7 +4965,7 @@
use control_module
!
implicit none
real(kind=8) tau0(3,nax,nsx)
real(kind=8) tau0(3,natx,nsx)
!
complex(kind=8) ei1(-nr1:nr1,nas,nsp), ei2(-nr2:nr2,nas,nsp), &
& ei3(-nr3:nr3,nas,nsp), eigr(ngw,nas,nsp)
@ -5356,15 +5357,15 @@
! iflag=+1 : read everything
!
use elct, only: n, nx, ngw, ng0
use ions_module, only: nsp, na, nax
use ions_module, only: nsp, na, natx
use parameters, only: nacx
!
implicit none
integer flag, ndr, nfi
real(kind=8) h(3,3), hold(3,3)
complex(kind=8) c0(ngw,n), cm(ngw,n)
real(kind=8) taum(3,nax,nsp),tau0(3,nax,nsp)
real(kind=8) vel(3,nax,nsp), velm(3,nax,nsp)
real(kind=8) taum(3,natx,nsp),tau0(3,natx,nsp)
real(kind=8) vel(3,natx,nsp), velm(3,natx,nsp)
real(kind=8) acc(nacx),lambda(nx,nx), lambdam(nx,nx)
real(kind=8) xnhe0,xnhem,vnhe,xnhp0,xnhpm,vnhp,ekincm
real(kind=8) xnhh0(3,3),xnhhm(3,3),vnhh(3,3),velh(3,3)
@ -5683,7 +5684,7 @@
! Output parameters in module "ncprm"
! info on DFT level in module "dft"
!
use ion_parameters
use parameters, only: nsx, natx
use ncprm
use dft_mod
use wfc_atomic
@ -6481,7 +6482,7 @@
real(kind=8) bec(nhsa,n), rhovan(nat,nhx*(nhx+1)/2,nspin)
real(kind=8) rhor(nnr,nspin), rhos(nnrs,nspin)
complex(kind=8) eigrb(ngb,nas,nsp), c(ngw,nx), rhog(ng,nspin)
integer irb(3,nax,nsx), nfi
integer irb(3,natx,nsx), nfi
! local variables
integer iss, isup, isdw, iss1, iss2, ios, i, ir, ig
real(kind=8) rsumr(2), rsumg(2), sa1, sa2, SSUM
@ -6762,7 +6763,7 @@
! where s=s(r(t+dt)) and s'=s(r(t))
! routine makes use of c(-q)=c*(q)
!
use ion_parameters
use parameters, only: nsx, natx
use cvan
use elct
!
@ -6846,7 +6847,7 @@
!
implicit none
!
integer, intent(in) :: irb(3,nax,nsx)
integer, intent(in) :: irb(3,natx,nsx)
real(kind=8), intent(in):: rhovan(nat,nhx*(nhx+1)/2,nspin)
complex(kind=8), intent(in):: eigrb(ngb,nas,nsp)
real(kind=8), intent(inout):: rhor(nnr,nspin)
@ -7114,7 +7115,7 @@
#endif
implicit none
! input
integer, intent(in) :: irb(3,nax,nsx)
integer, intent(in) :: irb(3,natx,nsx)
complex(kind=8), intent(in):: eigrb(ngb,nas,nsp)
! output
real(kind=8), intent(out) :: rhoc(nnr)
@ -7317,7 +7318,7 @@
! where s=s(r(t+dt))
! routine makes use of c(-q)=c*(q)
!
use ion_parameters
use parameters, only: natx, nsx
use cvan
use elct
!
@ -7562,7 +7563,7 @@
! where s=s(r(t+dt)) and s'=s(r(t))
! routine makes use of c(-q)=c*(q)
!
use ion_parameters
use parameters, only: nsx, natx
use cvan
use elct
!
@ -7741,14 +7742,14 @@
!
logical tlast,tfirst
integer nfi
real(kind=8) rhor(nnr,nspin), rhos(nnrs,nspin), fion(3,nax,nsx)
real(kind=8) rhoc(nnr), tau0(3,nax,nsp)
real(kind=8) rhor(nnr,nspin), rhos(nnrs,nspin), fion(3,natx,nsx)
real(kind=8) rhoc(nnr), tau0(3,natx,nsp)
complex(kind=8) ei1(-nr1:nr1,nas,nsp), ei2(-nr2:nr2,nas,nsp), &
& ei3(-nr3:nr3,nas,nsp), eigrb(ngb,nas,nsp), &
& rhog(ng,nspin), sfac(ngs,nsp)
!
integer irb(3,nax,nsx), iss, isup, isdw, ig, ir,i,j,k,is, ia
real(kind=8) fion1(3,nax,nsx), vave, ebac, wz, eh, SSUM
integer irb(3,natx,nsx), iss, isup, isdw, ig, ir,i,j,k,is, ia
real(kind=8) fion1(3,natx,nsx), vave, ebac, wz, eh, SSUM
complex(kind=8) fp, fm, ci, CSUM
complex(kind=8), pointer:: v(:), vs(:)
complex(kind=8), allocatable:: rhotmp(:), vtemp(:), drhotmp(:,:,:)
@ -7769,7 +7770,7 @@
! first routine in which fion is calculated: annihilation
!
do is=1,nsp
do ia=1,nax
do ia=1,natx
do i=1,3
fion (i,ia,is)=0.d0
fion1(i,ia,is)=0.d0
@ -7923,7 +7924,7 @@
if(tfor) then
if (nlcc.gt.0) call force_cc(irb,eigrb,rhor,fion1)
#ifdef __PARA
call reduce(3*nax*nsp,fion1)
call reduce(3*natx*nsp,fion1)
#endif
!
! add g-space ionic and core correction contributions to fion
@ -8083,15 +8084,15 @@
& xnhh0,xnhhm,vnhh,velh)
!-----------------------------------------------------------------------
use elct, only: n, nx, ngw
use ions_module, only: nsp, na, nax
use ions_module, only: nsp, na, natx
use parameters, only: nacx
!
implicit none
integer ndw, nfi
real(kind=8) h(3,3), hold(3,3)
complex(kind=8) c0(ngw,n), cm(ngw,n)
real(kind=8) taum(3,nax,nsp),tau0(3,nax,nsp)
real(kind=8) vel(3,nax,nsp), velm(3,nax,nsp)
real(kind=8) taum(3,natx,nsp),tau0(3,natx,nsp)
real(kind=8) vel(3,natx,nsp), velm(3,natx,nsp)
real(kind=8) acc(nacx),lambda(nx,nx), lambdam(nx,nx)
real(kind=8) xnhe0,xnhem,vnhe,xnhp0,xnhpm,vnhp,ekincm
real(kind=8) xnhh0(3,3),xnhhm(3,3),vnhh(3,3),velh(3,3)

View File

@ -105,8 +105,8 @@
!
! indexes, positions, and structure factors for the box grid
!
integer irb(3,nax,nsx)
real(kind=8) taub(3,nax,nsx)
integer irb(3,natx,nsx)
real(kind=8) taub(3,natx,nsx)
complex(kind=8), allocatable:: eigrb(:,:,:)
!
! charge densities and potentials
@ -141,17 +141,17 @@
!
! ionic positions, center of mass position
!
real(kind=8) tau0(3,nax,nsx), taum(3,nax,nsx), taup(3,nax,nsx)
real(kind=8) tau0(3,natx,nsx), taum(3,natx,nsx), taup(3,natx,nsx)
real(kind=8) cdm0(3),cdmvel(3)
!
! forces on ions
!
real(kind=8) fion(3,nax,nsx), fionm(3,nax,nsx)
integer iforce(3,nax,nsx)
real(kind=8) fion(3,natx,nsx), fionm(3,natx,nsx)
integer iforce(3,natx,nsx)
!
! for variable cell dynamics: scaled tau
!
real(kind=8) taus(3,nax,nsx)
real(kind=8) taus(3,natx,nsx)
integer iforceh(3,3)
!
integer ndr, ndw, nbeg, maxit, nomore
@ -174,8 +174,8 @@
!
! work variables, 2
!
real(kind=8) tausm(3,nax,nsx),tausp(3,nax,nsx)
real(kind=8) vels(3,nax,nsx),velsm(3,nax,nsx),velsp(3,nax,nsx)
real(kind=8) tausm(3,natx,nsx),tausp(3,natx,nsx)
real(kind=8) vels(3,natx,nsx),velsm(3,natx,nsx),velsp(3,natx,nsx)
real(kind=8) hnew(3,3),velh(3,3),hgamma(3,3)
real(kind=8) cdm(3)
real(kind=8) qr(3)

View File

@ -692,7 +692,7 @@
! input/output
integer ibrav, ndr, nbeg, iforceh(3,3)
logical tranp(nsx), tfirst, twmass, thdiag
real(kind=8) tau0(3,nax,nsx), taus(3,nax,nsx), amprp(nsx)
real(kind=8) tau0(3,natx,nsx), taus(3,natx,nsx), amprp(nsx)
real(kind=8) celldm(6), ecut, ecutw
real(kind=8) delt
! local

View File

@ -24,7 +24,7 @@
! ------------------------------------------------------------------
use control_module, only: iprsta
use cnst, only: pi, scmass
use ion_parameters, only: nsx, nax
use parameters, only: nsx, natx
use ions_module, only : nat, nsp, na, zv, pmass, rcmax, ipp ! ipp TEMP
use elct, only: f, nel, nspin, nupdwn, iupdwn, n, nx
use parm, only: nr1 ,nr2 ,nr3, alat, a1, a2, a3, omega
@ -43,8 +43,8 @@
real(kind=8) ampre, delt, ekincw, emass, emaec, eps, &
& frice, fricp, frich, grease, greasp, greash, &
& press, qnp, qne, qnh, tempw, temph, tolp, wmass, &
amprp(nsx), celldm(6), tau0(3,nax,nsx), ecut, ecutw
integer :: nbeg, ndr,ndw,nomore, iprint, max, iforce(3,nax,nsx)
amprp(nsx), celldm(6), tau0(3,natx,nsx), ecut, ecutw
integer :: nbeg, ndr,ndw,nomore, iprint, max, iforce(3,natx,nsx)
logical :: trane, tsde, twall, tortho, tnosee, tfor, tsdp, tcp, &
tcap, tnosep, trhor, trhow, tvlocw, tpre, thdyn, thdiag, &
@ -53,7 +53,7 @@
! local variables
!
real(kind=8), parameter:: terahertz = 2.418D-5, factem = 315795.26D0
real(kind=8) :: taus(3,nax,nsx)
real(kind=8) :: taus(3,natx,nsx)
character (len=30) :: atomic_positions
integer :: unit = 5, ionode_id = 0, i, ia, ios, is
!
@ -1025,7 +1025,7 @@
subroutine read_cards(ibrav, iforce, tau0, atomic_positions)
!-----------------------------------------------------------------------
!
use ion_parameters, only: nsx, nax
use parameters, only: nsx, natx
use ions_module, only : na, nat, nsp, ipp, pmass ! ipp TEMP
use elct, only: f, n
use parm, only: a1, a2, a3
@ -1033,8 +1033,8 @@
use parser
implicit none
integer :: ibrav, iforce(3, nax, nsp)
real(kind=8) :: tau0(3, nax, nsp)
integer :: ibrav, iforce(3, natx, nsp)
real(kind=8) :: tau0(3, natx, nsp)
character(len=*) :: atomic_positions
!
real(kind=8), allocatable :: tau_inp(:,:)
@ -1115,7 +1115,7 @@
do ia = 1, nat
if (ityp_inp(ia) == is) then
na(is) = na(is) + 1
if(na(is).gt.nax) call errore(' cards',' na > nax',na(is))
if(na(is).gt.natx) call errore(' cards',' na > natx',na(is))
do i = 1, 3
tau0(i, na(is), is ) = tau_inp(i, ia)
iforce(i, na(is), is ) = iforce_inp(i, ia)

View File

@ -6,12 +6,6 @@
! or http://www.gnu.org/copyleft/gpl.txt .
!
module ion_parameters
! nsx = max number of different species
! nax = max number of atoms in one particular species
integer, parameter:: nsx=5, nax=300
end module ion_parameters
module van_parameters
! nlx = combined angular momentum (for s,p,d states: nlx=9)
! lix = max angular momentum l+1 (lix=3 if s,p,d are included)
@ -22,7 +16,7 @@ end module van_parameters
module bhs
! analytical BHS pseudopotential parameters
use ion_parameters
use parameters, only: nsx
real(kind=8) rc1(nsx), rc2(nsx), wrc1(nsx), wrc2(nsx), &
rcl(3,nsx,3), al(3,nsx,3), bl(3,nsx,3)
integer lloc(nsx)
@ -58,7 +52,7 @@ end module cnst
module cvan
! ionic pseudo-potential variables
use ion_parameters
use parameters, only: nsx
use van_parameters
! ap = Clebsch-Gordan coefficients (?)
! lpx = max number of allowed Y_lm
@ -166,7 +160,7 @@ module gvecs
end module gvecs
module ions_module
use ion_parameters
use parameters, only: nsx, natx
! nsp = number of species
! na(is) = number of atoms of species is
! nas = max number of atoms of a given species
@ -181,7 +175,7 @@ end module ions_module
module ncprm
use ion_parameters
use parameters, only: nsx, mmaxx, nqfx=>nqfm, nbrx, lqx=>lqmax
use van_parameters
!
! lqx : maximum angular momentum of Q (Vanderbilt augmentation charges)
@ -189,8 +183,6 @@ module ncprm
! nbrx : maximum number of distinct radial beta functions
! mmaxx: maximum number of points in the radial grid
!
integer nqfx, lqx, nbrx, mmaxx
parameter (lqx=5, nqfx=8, nbrx=6, mmaxx=1301)
! ifpcor 1 if "partial core correction" of louie, froyen,
! & cohen to be used; 0 otherwise
@ -270,7 +262,7 @@ module pseu
end module pseu
module psfiles
use ion_parameters
use parameters, only: nsx
! psfile = name of files containing pseudopotential
character(len=80) :: pseudo_dir, psfile(nsx)
end module psfiles
@ -324,7 +316,7 @@ module timex_mod
end module timex_mod
module wfc_atomic
use ion_parameters, only:nsx
use parameters, only:nsx
use ncprm, only:mmaxx
! nchix= maximum number of pseudo wavefunctions
! nchi = number of atomic (pseudo-)wavefunctions

View File

@ -1525,15 +1525,15 @@ end module para_mod
use para_mod
use mp
use elct, only: n, nx, ngw, ng0
use ions_module, only: nsp, na, nax
use ions_module, only: nsp, na, natx
use parameters, only: nacx
!
implicit none
integer flag, ndr, nfi
real(kind=8) h(3,3), hold(3,3)
complex(kind=8) c0(ngw,n), cm(ngw,n)
real(kind=8) taum(3,nax,nsp),tau0(3,nax,nsp)
real(kind=8) vel(3,nax,nsp), velm(3,nax,nsp)
real(kind=8) taum(3,natx,nsp),tau0(3,natx,nsp)
real(kind=8) vel(3,natx,nsp), velm(3,natx,nsp)
real(kind=8) acc(nacx),lambda(nx,nx), lambdam(nx,nx)
real(kind=8) xnhe0,xnhem,vnhe,xnhp0,xnhpm,vnhp,ekincm
real(kind=8) xnhh0(3,3),xnhhm(3,3),vnhh(3,3),velh(3,3)
@ -1643,15 +1643,15 @@ end module para_mod
!
use para_mod
use elct, only: n, nx, ngw, ng0
use ions_module, only: nsp, na, nax
use ions_module, only: nsp, na, natx
use parameters, only: nacx
!
implicit none
integer ndw, nfi
real(kind=8) h(3,3), hold(3,3)
complex(kind=8) c0(ngw,n), cm(ngw,n)
real(kind=8) taum(3,nax,nsp),tau0(3,nax,nsp)
real(kind=8) vel(3,nax,nsp), velm(3,nax,nsp)
real(kind=8) taum(3,natx,nsp),tau0(3,natx,nsp)
real(kind=8) vel(3,natx,nsp), velm(3,natx,nsp)
real(kind=8) acc(nacx),lambda(nx,nx), lambdam(nx,nx)
real(kind=8) xnhe0,xnhem,vnhe,xnhp0,xnhpm,vnhp,ekincm
real(kind=8) xnhh0(3,3),xnhhm(3,3),vnhh(3,3),velh(3,3)

View File

@ -14,7 +14,7 @@ CONTAINS
! read from file and distribute data calculated in preceding iterations
!
use elct, only: n, nx, ngw, ng0, nspin, nel, ngw_g
use ions_module, only: nsp, na, nax
use ions_module, only: nsp, na, natx
use parm, ONLY: nr1, nr2, nr3
use gvec, ONLY: ng, ngl, mill_g, ng_g, mill_l, bi1, bi2, bi3, ig_l2g
use io_base, only: write_restart_header, write_restart_ions, &
@ -332,7 +332,7 @@ CONTAINS
! read from file and distribute data calculated in preceding iterations
!
use elct, only: n, nx, ngw, ng0, nspin, nel, ngw_g
use ions_module, only: nsp, na, nax
use ions_module, only: nsp, na, natx
use parm, ONLY: nr1, nr2, nr3
use gvec, ONLY: ng, ngl, mill_g, ng_g, mill_l, bi1, bi2, bi3, ig_l2g
use io_base, only: read_restart_header, read_restart_ions, &

View File

@ -11,11 +11,13 @@ io_global.o \
mp.o \
mp_global.o \
mp_wave.o \
mp_buffers.o \
parser.o \
readpseudo.o \
pseudodata.o \
cell_base.o \
pseudo_types.o
pseudo_types.o \
ptoolkit.o
#
include ../make.rules
#

316
Modules/mp_buffers.f90 Normal file
View File

@ -0,0 +1,316 @@
!
! Copyright (C) 2002 FPMD 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 .
!
!------------------------------------------------------------------------------!
! Carlo Cavazzoni
! Last update 19 May 2001
!------------------------------------------------------------------------------!
!------------------------------------------------------------------------------!
!
MODULE mp_buffers
! This module is used to implement, when possible, high efficient buffered
! communications among processors.
! In particular two buffers are defined:
!
! mp_snd_buffer Send buffer
!
! mp_rcv_buffer Receive buffer
!
! together with the buffers the module contains initialization and
! communication functions, that may depend on the particular hardware
!
!------------------------------------------------------------------------------!
USE kinds, ONLY : dbl
USE parallel_include
USE shmem_include
PRIVATE
PUBLIC :: mp_sendrecv_buffers, mp_allocate_buffers, mp_deallocate_buffers, &
mp_barrier_buffers, mp_alltoall_buffers,mp_excng, mp_sum_buffers, mp_report_buffers
SAVE
#if defined __SHMEM
pointer (mp_p_snd_buffer,mp_snd_buffer)
pointer (mp_p_rcv_buffer,mp_rcv_buffer)
complex (dbl) :: mp_snd_buffer(1)
complex (dbl) :: mp_rcv_buffer(1)
#else
integer :: mp_p_snd_buffer = 0
integer :: mp_p_rcv_buffer = 0
complex (dbl), pointer :: mp_snd_buffer(:)
complex (dbl), pointer :: mp_rcv_buffer(:)
#endif
PUBLIC :: mp_snd_buffer, mp_rcv_buffer, &
mp_p_snd_buffer, mp_p_rcv_buffer
integer :: mp_bufsize
integer :: mp_high_watermark = 0
#if defined COMPLEX_MESSAGE_MAX_SIZE
INTEGER, PARAMETER :: mp_bufsize_msgmax = COMPLEX_MESSAGE_MAX_SIZE
#else
INTEGER, PARAMETER :: mp_bufsize_msgmax = 2**20 ! 1Mb 2^20
#endif
PUBLIC :: mp_bufsize_msgmax
!------------------------------------------------------------------------------!
!
CONTAINS
!
!------------------------------------------------------------------------------!
!..mp_allocate_buffers
!..Carlo Cavazzoni
SUBROUTINE mp_allocate_buffers(bufsize)
IMPLICIT NONE
INTEGER, INTENT(IN) :: bufsize
INTEGER :: ERR
#if defined __SHMEM
CALL SHPALLOC(mp_p_snd_buffer,2*bufsize, err, 0)
#else
ALLOCATE(mp_snd_buffer(bufsize), STAT = err)
#endif
IF(ERR /= 0) CALL errore(' mp_allocate_buffers ', ' allocating mp_snd_buffer ',err)
#if defined __SHMEM
CALL SHPALLOC(mp_p_rcv_buffer,2*bufsize, err, 0)
#else
ALLOCATE(mp_rcv_buffer(bufsize), STAT = err)
#endif
IF(ERR /= 0) CALL errore(' mp_allocate_buffers ', ' allocating mp_rcv_buffer ',err)
mp_bufsize = bufsize
RETURN
END SUBROUTINE mp_allocate_buffers
!
!------------------------------------------------------------------------------!
!..mp_deallocate_buffers
!..Carlo Cavazzoni
SUBROUTINE mp_deallocate_buffers
IMPLICIT NONE
integer err
#if defined __SHMEM
CALL shmem_barrier_all
CALL SHPDEALLC(mp_p_rcv_buffer, err, 0)
#else
DEALLOCATE(mp_snd_buffer, STAT = err)
#endif
IF(ERR /= 0) CALL errore(' mp_deallocate_buffers ', ' deallocating mp_rcv_buffer ',err)
#if defined __SHMEM
CALL SHPDEALLC(mp_p_snd_buffer, err, 0)
#else
DEALLOCATE(mp_rcv_buffer, STAT = err)
#endif
IF(ERR /= 0) CALL errore(' mp_deallocate_buffers ', ' deallocating mp_snd_buffer ',err)
RETURN
END SUBROUTINE mp_deallocate_buffers
!
!------------------------------------------------------------------------------!
!..mp_barrier_buffers
!..Carlo Cavazzoni
SUBROUTINE mp_barrier_buffers
IMPLICIT NONE
#if defined __SHMEM
call shmem_barrier_all
#else
#endif
RETURN
END SUBROUTINE mp_barrier_buffers
!
!------------------------------------------------------------------------------!
!..mp_sum_buffers
!..Carlo Cavazzoni
SUBROUTINE mp_sum_buffers
IMPLICIT NONE
INTEGER ierr, pwrksize
#if defined __PARA
# if defined __SHMEM
pointer (p_pWrk,pWrk)
REAL(dbl) pWrk(1)
INTEGER :: nproc, num_pes
nproc = num_pes()
pwrksize = MAX(2*mp_bufsize,SHMEM_REDUCE_MIN_WRKDATA_SIZE)
CALL SHPALLOC(p_pWrk, pwrksize, ierr, 0)
IF(IERR /= 0) THEN
CALL errore(' mp_sum_buffers ', ' allocating p_pWrk ',ierr)
END IF
call shmem_barrier_all
CALL SHMEM_REAL8_SUM_TO_ALL(mp_rcv_buffer, mp_snd_buffer, &
2*mp_bufsize, 0, 0, nproc, pWrk, pSync_sta)
call shmem_barrier_all
CALL SHPDEALLC(p_pwrk, ierr, 0)
IF(IERR /= 0) call errore(' mp_sum_buffers ', &
' deallocating p_pWrk ',ierr)
# elif defined __MPI
CALL MPI_ALLREDUCE(mp_snd_buffer,mp_rcv_buffer,mp_bufsize, &
MPI_DOUBLE_COMPLEX, MPI_SUM, MPI_COMM_WORLD, IERR)
IF(IERR /= 0) call errore(' mp_sum_buffers ', ' mpi_allreduce ',ierr)
# endif
#else
call ZCOPY(mp_bufsize,mp_snd_buffer,1,mp_rcv_buffer,1)
#endif
mp_high_watermark = MAX( mp_high_watermark, 16 * mp_bufsize )
return
END SUBROUTINE mp_sum_buffers
!
!------------------------------------------------------------------------------!
!..mp_alltoall_buffers
!..Carlo Cavazzoni
SUBROUTINE mp_alltoall_buffers(mp_snd_buffer, mp_rcv_buffer)
IMPLICIT NONE
COMPLEX(dbl) :: mp_snd_buffer(:)
COMPLEX(dbl) :: mp_rcv_buffer(:)
INTEGER :: ierr, nproc, i
INTEGER :: msg_size
#if defined __PARA
# if defined __SHMEM
integer ip, isour, mpime, nproc
integer my_pe, num_pes
call shmem_barrier_all
mpime = my_pe()
nproc = num_pes()
msg_size = mp_bufsize/nproc
IF( (msg_size + 1) > mp_bufsize_msgmax ) THEN
CALL errore(' mp_alltoall_buffers ', ' bufsize too large ', msg_size)
END IF
do ip =1,nproc
ISOUR = MOD(MPIME-IP+NPROC,NPROC)
call shmem_get64(mp_rcv_buffer( 1 + isour*msg_size), &
mp_snd_buffer(1+mpime*msg_size), msg_size*2, isour)
end do
# elif defined __MPI
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, nproc, ierr)
msg_size = mp_bufsize/nproc
IF( (msg_size + 1) > mp_bufsize_msgmax ) THEN
CALL errore(' mp_alltoall_buffers ', ' bufsize too large ', msg_size)
END IF
!WRITE(6,*) ' MP_BUFFERS DEBUG ', msg_size
!WRITE(6,*) ' MP_BUFFERS DEBUG ', mp_snd_buffer(1)
!WRITE(6,*) ' MP_BUFFERS DEBUG ', mp_snd_buffer(1+msg_size)
call MPI_ALLTOALL(mp_snd_buffer,msg_size,MPI_DOUBLE_COMPLEX, &
mp_rcv_buffer,msg_size,MPI_DOUBLE_COMPLEX, &
MPI_COMM_WORLD,IERR)
!WRITE(6, fmt='(10D8.2)' ) mp_rcv_buffer(1:mp_bufsize)
!WRITE(6,*) ' MP_BUFFERS DEBUG ', mp_rcv_buffer(1)
!WRITE(6,*) ' MP_BUFFERS DEBUG ', mp_rcv_buffer(1+msg_size)
IF(IERR /= 0) call errore(' mp_alltoall_buffers ', ' mpi_alltoall ',ierr)
# endif
#else
msg_size = mp_bufsize
CALL ZCOPY(msg_size, mp_snd_buffer, 1, mp_rcv_buffer, 1)
#endif
mp_high_watermark = MAX( mp_high_watermark, 16 * msg_size )
return
END SUBROUTINE mp_alltoall_buffers
!
!------------------------------------------------------------------------------!
!..mp_sendrecv_buffers
!..Carlo Cavazzoni
SUBROUTINE mp_sendrecv_buffers(isour, idest, ip)
IMPLICIT NONE
INTEGER, INTENT(IN) :: isour, idest, ip
#if defined __PARA
# if defined __MPI
INTEGER :: istatus(MPI_STATUS_SIZE)
INTEGER :: ierr
# endif
# if defined __SHMEM
call shmem_barrier_all
call shmem_get64(mp_rcv_buffer, mp_snd_buffer, mp_bufsize*2, isour-1)
# elif defined __MPI
CALL MPI_SENDRECV(mp_snd_buffer, mp_bufsize, MPI_DOUBLE_COMPLEX, &
IDEST-1, ip, mp_rcv_buffer, mp_bufsize, MPI_DOUBLE_COMPLEX, &
ISOUR-1, ip, MPI_COMM_WORLD, ISTATUS, ierr)
IF(ierr /= 0) call errore(' mp_sendrecv_buffers ', ' MPI_SENDRECV ', ierr)
# endif
#else
CALL ZCOPY(mp_bufsize, mp_snd_buffer, 1, mp_rcv_buffer, 1)
#endif
mp_high_watermark = MAX( mp_high_watermark, 16 * mp_bufsize )
RETURN
END SUBROUTINE mp_sendrecv_buffers
SUBROUTINE mp_report_buffers
WRITE(6, *)
WRITE(6, *) ' mp_buffers: high_watermark (bytes): ', mp_high_watermark
RETURN
END SUBROUTINE mp_report_buffers
END MODULE mp_buffers

View File

@ -24,10 +24,16 @@ module parameters
npk = 40000, &! maximum number of k-points
ndm = 2000 ! maximum number of points in the radial mesh
integer , parameter :: DP = kind(0.0d0)
integer, parameter :: &
nbrx = 6, &! maximum number of beta functions
lqmax= 2*lmaxx+1, &! maximum number of angular momenta of Q
nqfm = 8 ! maximum number of coefficients in Q smoothing
!
! ... More parameter for the CP codes
!
INTEGER, PARAMETER :: cp_mmax = 809 ! maximum mesh size for pseudo
INTEGER, PARAMETER :: mmaxx = 1301 ! maximum mesh size for pseudo
INTEGER, PARAMETER :: cp_lmax = 4 ! maximum number of channels
! (s,p,d,f)
INTEGER, PARAMETER :: nacx = 10 ! maximum number of averaged

View File

@ -72,17 +72,17 @@
INTEGER :: igau
INTEGER :: lloc
INTEGER :: lnl
INTEGER :: indl(cp_lmax)
INTEGER :: indl(mmaxx)
INTEGER :: nchan
INTEGER :: mesh
REAL(dbl) :: zv
REAL(dbl) :: raggio
REAL(dbl) :: dx ! r(i) = cost * EXP( xmin + dx * (i-1) )
REAL(dbl) :: rab(cp_mmax)
REAL(dbl) :: rw(cp_mmax)
REAL(dbl) :: vnl(cp_mmax, cp_lmax)
REAL(dbl) :: vloc(cp_mmax)
REAL(dbl) :: vrps(cp_mmax, cp_lmax)
REAL(dbl) :: rab(mmaxx)
REAL(dbl) :: rw(mmaxx)
REAL(dbl) :: vnl(mmaxx, cp_lmax)
REAL(dbl) :: vloc(mmaxx)
REAL(dbl) :: vrps(mmaxx, cp_lmax)
REAL(dbl) :: wgv(cp_lmax)
REAL(dbl) :: rc(2)
REAL(dbl) :: wrc(2)
@ -92,8 +92,8 @@
INTEGER :: nrps ! number of atomic wave function
INTEGER :: lrps(cp_lmax) ! angular momentum
REAL(dbl) :: oc(cp_lmax) ! occupation for each rps
REAL(dbl) :: rps(cp_mmax, cp_lmax) ! atomic pseudo wave function
REAL(dbl) :: rhoc(cp_mmax) ! core charge
REAL(dbl) :: rps(mmaxx, cp_lmax) ! atomic pseudo wave function
REAL(dbl) :: rhoc(mmaxx) ! core charge
END TYPE pseudo_ncpp
! ----------------------------------------------

2854
Modules/ptoolkit.f90 Normal file

File diff suppressed because it is too large Load Diff

View File

@ -504,11 +504,9 @@ module us
! These parameters are needed with the US pseudopotentials
!
integer, parameter :: &
nbrx = 6, &! maximum number of beta functions
lqmax= 2*lmaxx+1, &! maximum number of angular momenta of Q
nlx = (lmaxx+1)**2,&! maximum number of combined angular momentum
mx = 2*lqmax-1, &! maximum magnetic angular momentum of Q
nqfm = 8 ! maximum number of coefficients in Q smoothing
mx = 2*lqmax-1 ! maximum magnetic angular momentum of Q
real(kind=DP), parameter:: &
dq = 0.01d0 ! space between points in the pseudopotential tab.
!