forked from lijiext/lammps
283 lines
9.0 KiB
Fortran
Executable File
283 lines
9.0 KiB
Fortran
Executable File
c Extern "C" declaration has the form:
|
|
c
|
|
c void meam_dens_final_(int *, int *, int *, int *, int *, double *, double *,
|
|
c int *, int *, int *,
|
|
c double *, double *, double *, double *, double *, double *,
|
|
c double *, double *, double *, double *, double *, double *,
|
|
c double *, double *, double *, double *, double *, int *);
|
|
c
|
|
c Call from pair_meam.cpp has the form:
|
|
c
|
|
c meam_dens_final_(&nlocal,&nmax,&eflag_either,&eflag_global,&eflag_atom,
|
|
c &eng_vdwl,eatom,ntype,type,fmap,
|
|
c &arho1[0][0],&arho2[0][0],arho2b,&arho3[0][0],
|
|
c &arho3b[0][0],&t_ave[0][0],&tsq_ave[0][0],gamma,dgamma1,
|
|
c dgamma2,dgamma3,rho,rho0,rho1,rho2,rho3,frhop,&errorflag);
|
|
c
|
|
|
|
subroutine meam_dens_final(nlocal, nmax,
|
|
$ eflag_either, eflag_global, eflag_atom, eng_vdwl, eatom,
|
|
$ ntype, type, fmap,
|
|
$ Arho1, Arho2, Arho2b, Arho3, Arho3b, t_ave, tsq_ave,
|
|
$ Gamma, dGamma1, dGamma2, dGamma3,
|
|
$ rho, rho0, rho1, rho2, rho3, fp, errorflag)
|
|
|
|
use meam_data
|
|
implicit none
|
|
|
|
integer nlocal, nmax, eflag_either, eflag_global, eflag_atom
|
|
integer ntype, type, fmap
|
|
real*8 eng_vdwl, eatom, Arho1, Arho2
|
|
real*8 Arho2b, Arho3, Arho3b
|
|
real*8 t_ave, tsq_ave
|
|
real*8 Gamma, dGamma1, dGamma2, dGamma3
|
|
real*8 rho, rho0, rho1, rho2, rho3
|
|
real*8 fp
|
|
integer errorflag
|
|
|
|
dimension eatom(nmax)
|
|
dimension type(nmax), fmap(ntype)
|
|
dimension Arho1(3,nmax), Arho2(6,nmax), Arho2b(nmax)
|
|
dimension Arho3(10,nmax), Arho3b(3,nmax), t_ave(3,nmax)
|
|
dimension tsq_ave(3,nmax)
|
|
dimension Gamma(nmax), dGamma1(nmax), dGamma2(nmax)
|
|
dimension dGamma3(nmax), rho(nmax), rho0(nmax)
|
|
dimension rho1(nmax), rho2(nmax), rho3(nmax)
|
|
dimension fp(nmax)
|
|
|
|
integer i, elti
|
|
integer m
|
|
real*8 rhob, G, dG, Gbar, dGbar, gam, shp(3), shpi(3), Z
|
|
real*8 B, denom, rho_bkgd
|
|
|
|
c Complete the calculation of density
|
|
|
|
do i = 1,nlocal
|
|
|
|
elti = fmap(type(i))
|
|
if (elti.gt.0) then
|
|
rho1(i) = 0.d0
|
|
rho2(i) = -1.d0/3.d0*Arho2b(i)*Arho2b(i)
|
|
rho3(i) = 0.d0
|
|
do m = 1,3
|
|
rho1(i) = rho1(i) + Arho1(m,i)*Arho1(m,i)
|
|
rho3(i) = rho3(i) - 3.d0/5.d0*Arho3b(m,i)*Arho3b(m,i)
|
|
enddo
|
|
do m = 1,6
|
|
rho2(i) = rho2(i) + v2D(m)*Arho2(m,i)*Arho2(m,i)
|
|
enddo
|
|
do m = 1,10
|
|
rho3(i) = rho3(i) + v3D(m)*Arho3(m,i)*Arho3(m,i)
|
|
enddo
|
|
|
|
if( rho0(i) .gt. 0.0 ) then
|
|
if (ialloy.eq.1) then
|
|
t_ave(1,i) = t_ave(1,i)/tsq_ave(1,i)
|
|
t_ave(2,i) = t_ave(2,i)/tsq_ave(2,i)
|
|
t_ave(3,i) = t_ave(3,i)/tsq_ave(3,i)
|
|
else if (ialloy.eq.2) then
|
|
t_ave(1,i) = t1_meam(elti)
|
|
t_ave(2,i) = t2_meam(elti)
|
|
t_ave(3,i) = t3_meam(elti)
|
|
else
|
|
t_ave(1,i) = t_ave(1,i)/rho0(i)
|
|
t_ave(2,i) = t_ave(2,i)/rho0(i)
|
|
t_ave(3,i) = t_ave(3,i)/rho0(i)
|
|
endif
|
|
endif
|
|
|
|
Gamma(i) = t_ave(1,i)*rho1(i)
|
|
$ + t_ave(2,i)*rho2(i) + t_ave(3,i)*rho3(i)
|
|
|
|
if( rho0(i) .gt. 0.0 ) then
|
|
Gamma(i) = Gamma(i)/(rho0(i)*rho0(i))
|
|
end if
|
|
|
|
Z = Z_meam(elti)
|
|
|
|
call G_gam(Gamma(i),ibar_meam(elti),
|
|
$ gsmooth_factor,G,errorflag)
|
|
if (errorflag.ne.0) return
|
|
if (ibar_meam(elti).le.0) then
|
|
Gbar = 1.d0
|
|
else
|
|
call get_shpfcn(shp,lattce_meam(elti,elti))
|
|
if (mix_ref_t.eq.1) then
|
|
gam = (t_ave(1,i)*shpi(1)+t_ave(2,i)*shpi(2)
|
|
$ +t_ave(3,i)*shpi(3))/(Z*Z)
|
|
else
|
|
gam = (t1_meam(elti)*shp(1)+t2_meam(elti)*shp(2)
|
|
$ +t3_meam(elti)*shp(3))/(Z*Z)
|
|
endif
|
|
call G_gam(gam,ibar_meam(elti),gsmooth_factor,
|
|
$ Gbar,errorflag)
|
|
endif
|
|
rho(i) = rho0(i) * G
|
|
|
|
if (mix_ref_t.eq.1) then
|
|
if (ibar_meam(elti).le.0) then
|
|
Gbar = 1.d0
|
|
dGbar = 0.d0
|
|
else
|
|
call get_shpfcn(shpi,lattce_meam(elti,elti))
|
|
gam = (t_ave(1,i)*shpi(1)+t_ave(2,i)*shpi(2)
|
|
$ +t_ave(3,i)*shpi(3))/(Z*Z)
|
|
call dG_gam(gam,ibar_meam(elti),gsmooth_factor,
|
|
$ Gbar,dGbar)
|
|
endif
|
|
rho_bkgd = rho0_meam(elti)*Z*Gbar
|
|
else
|
|
if (bkgd_dyn.eq.1) then
|
|
rho_bkgd = rho0_meam(elti)*Z
|
|
else
|
|
rho_bkgd = rho_ref_meam(elti)
|
|
endif
|
|
endif
|
|
rhob = rho(i)/rho_bkgd
|
|
denom = 1.d0/rho_bkgd
|
|
|
|
call dG_gam(Gamma(i),ibar_meam(elti),gsmooth_factor,G,dG)
|
|
|
|
dGamma1(i) = (G - 2*dG*Gamma(i))*denom
|
|
|
|
if( rho0(i) .ne. 0.d0 ) then
|
|
dGamma2(i) = (dG/rho0(i))*denom
|
|
else
|
|
dGamma2(i) = 0.d0
|
|
end if
|
|
|
|
c dGamma3 is nonzero only if we are using the "mixed" rule for
|
|
c computing t in the reference system (which is not correct, but
|
|
c included for backward compatibility
|
|
if (mix_ref_t.eq.1) then
|
|
dGamma3(i) = rho0(i)*G*dGbar/(Gbar*Z*Z)*denom
|
|
else
|
|
dGamma3(i) = 0.0
|
|
endif
|
|
|
|
B = A_meam(elti)*Ec_meam(elti,elti)
|
|
|
|
if( rhob .ne. 0.d0 ) then
|
|
if (emb_lin_neg.eq.1 .and. rhob.le.0) then
|
|
fp(i) = -B
|
|
else
|
|
fp(i) = B*(log(rhob)+1.d0)
|
|
endif
|
|
if (eflag_either.ne.0) then
|
|
if (eflag_global.ne.0) then
|
|
if (emb_lin_neg.eq.1 .and. rhob.le.0) then
|
|
eng_vdwl = eng_vdwl - B*rhob
|
|
else
|
|
eng_vdwl = eng_vdwl + B*rhob*log(rhob)
|
|
endif
|
|
endif
|
|
if (eflag_atom.ne.0) then
|
|
if (emb_lin_neg.eq.1 .and. rhob.le.0) then
|
|
eatom(i) = eatom(i) - B*rhob
|
|
else
|
|
eatom(i) = eatom(i) + B*rhob*log(rhob)
|
|
endif
|
|
endif
|
|
endif
|
|
else
|
|
if (emb_lin_neg.eq.1) then
|
|
fp(i) = -B
|
|
else
|
|
fp(i) = B
|
|
endif
|
|
endif
|
|
endif
|
|
enddo
|
|
|
|
return
|
|
end
|
|
|
|
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
|
|
|
|
subroutine G_gam(Gamma,ibar,gsmooth_factor,G,errorflag)
|
|
c Compute G(Gamma) based on selection flag ibar:
|
|
c 0 => G = sqrt(1+Gamma)
|
|
c 1 => G = exp(Gamma/2)
|
|
c 2 => not implemented
|
|
c 3 => G = 2/(1+exp(-Gamma))
|
|
c 4 => G = sqrt(1+Gamma)
|
|
c -5 => G = +-sqrt(abs(1+Gamma))
|
|
implicit none
|
|
real*8 Gamma,G
|
|
real*8 gsmooth_factor, gsmooth_switchpoint
|
|
integer ibar, errorflag
|
|
if (ibar.eq.0.or.ibar.eq.4) then
|
|
gsmooth_switchpoint = -gsmooth_factor / (gsmooth_factor+1)
|
|
if (Gamma.lt.gsmooth_switchpoint) then
|
|
c e.g. gsmooth_factor is 99, then:
|
|
c gsmooth_switchpoint = -0.99
|
|
c G = 0.01*(-0.99/Gamma)**99
|
|
G = 1/(gsmooth_factor+1)
|
|
$ *(gsmooth_switchpoint/Gamma)**gsmooth_factor
|
|
G = sqrt(G)
|
|
else
|
|
G = sqrt(1.d0+Gamma)
|
|
endif
|
|
else if (ibar.eq.1) then
|
|
G = exp(Gamma/2.d0)
|
|
else if (ibar.eq.3) then
|
|
G = 2.d0/(1.d0+exp(-Gamma))
|
|
else if (ibar.eq.-5) then
|
|
if ((1.d0+Gamma).ge.0) then
|
|
G = sqrt(1.d0+Gamma)
|
|
else
|
|
G = -sqrt(-1.d0-Gamma)
|
|
endif
|
|
else
|
|
errorflag = 1
|
|
endif
|
|
return
|
|
end
|
|
|
|
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
|
|
|
|
subroutine dG_gam(Gamma,ibar,gsmooth_factor,G,dG)
|
|
c Compute G(Gamma) and dG(gamma) based on selection flag ibar:
|
|
c 0 => G = sqrt(1+Gamma)
|
|
c 1 => G = exp(Gamma/2)
|
|
c 2 => not implemented
|
|
c 3 => G = 2/(1+exp(-Gamma))
|
|
c 4 => G = sqrt(1+Gamma)
|
|
c -5 => G = +-sqrt(abs(1+Gamma))
|
|
real*8 Gamma,G,dG
|
|
real*8 gsmooth_factor, gsmooth_switchpoint
|
|
integer ibar
|
|
if (ibar.eq.0.or.ibar.eq.4) then
|
|
gsmooth_switchpoint = -gsmooth_factor / (gsmooth_factor+1)
|
|
if (Gamma.lt.gsmooth_switchpoint) then
|
|
c e.g. gsmooth_factor is 99, then:
|
|
c gsmooth_switchpoint = -0.99
|
|
c G = 0.01*(-0.99/Gamma)**99
|
|
G = 1/(gsmooth_factor+1)
|
|
$ *(gsmooth_switchpoint/Gamma)**gsmooth_factor
|
|
G = sqrt(G)
|
|
dG = -gsmooth_factor*G/(2.0*Gamma)
|
|
else
|
|
G = sqrt(1.d0+Gamma)
|
|
dG = 1.d0/(2.d0*G)
|
|
endif
|
|
else if (ibar.eq.1) then
|
|
G = exp(Gamma/2.d0)
|
|
dG = G/2.d0
|
|
else if (ibar.eq.3) then
|
|
G = 2.d0/(1.d0+exp(-Gamma))
|
|
dG = G*(2.d0-G)/2
|
|
else if (ibar.eq.-5) then
|
|
if ((1.d0+Gamma).ge.0) then
|
|
G = sqrt(1.d0+Gamma)
|
|
dG = 1.d0/(2.d0*G)
|
|
else
|
|
G = -sqrt(-1.d0-Gamma)
|
|
dG = -1.d0/(2.d0*G)
|
|
endif
|
|
endif
|
|
return
|
|
end
|
|
|
|
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
|