Statistiques
| Révision :

root / src / egrad_chamfre.f90 @ 2

Historique | Voir | Annoter | Télécharger (24,8 ko)

1 1 equemene
!*************############### Attention	###############*************
2 1 equemene
!(a) Two parameters aa and br(3,3) must be provided in main program
3 1 equemene
!(b) At first, z=0 for the outmost surface
4 1 equemene
!(c) The units of all parameters are not atomic units, but angstrom, eV etc.
5 1 equemene
!(d) Before using this routine, you must confirm that the energy is CONSISTENT with its derivative.
6 1 equemene
!                        This check of consistency is VERY IMPORTANT for energy conservation in MD.
7 1 equemene
!!!
8 1 equemene
!!  xa, ya,za present the positions of atoms. v is the energy of the system. dvdr present the force along the x,y,z directions.
9 1 equemene
!!
10 1 equemene
subroutine egrad_chamfre(Nat,V,Geom,Grad)
11 1 equemene
! WAS xa,ya,za,v,dvdr)
12 1 equemene
13 1 equemene
14 1 equemene
  use Path_module, only : Lat_a,Lat_b,Lat_c,order,orderinv,renum
15 1 equemene
  use Io_module
16 1 equemene
17 1 equemene
18 1 equemene
   IMPLICIT NONE
19 1 equemene
20 1 equemene
       INTEGER(KINT), INTENT(IN) :: Nat
21 1 equemene
       REAL(KREAL), INTENT(OUT) :: V,grad(Nat*3)
22 1 equemene
       REAL(KREAL), INTENT(IN) :: Geom(Nat,3)
23 1 equemene
24 1 equemene
!     Bohr --> Angstr
25 1 equemene
      real(KREAL), parameter :: BOHR   = 0.52917726D+00
26 1 equemene
27 1 equemene
!! PFL 2010 Nov. 28 ->
28 1 equemene
! for now I keep this old F77 scheme. This has to be replaced by ALLOCATABLE
29 1 equemene
! things
30 1 equemene
! <- PFL 2010 Nov 28.
31 1 equemene
  REAL(KREAL) :: xa(100),ya(100),za(100),dvdr(100,3)
32 1 equemene
  REAL(KREAL) :: rshort,rlong,zshort,zlong
33 1 equemene
  REAL(KREAL), SAVE :: rnc,rnn,rhh,rch,rnh,ann(100),anc(100),anh(100),ach(100),ahh(100),a(100)
34 1 equemene
  REAL(KREAL) :: dv(100,10,3),df(100,10,3)
35 1 equemene
  REAL(KREAL) :: px(9000),py(9000),pz(9000),tmp,temp,rtemp,yf
36 1 equemene
  INTEGER(KINT) :: ka(9000),kx(9000),ky(9000),itx,ity,nf(100),mf(100,500)
37 1 equemene
  REAL(KREAL) :: xi(3),xj(3),xk(3),rij,rik,rjk,rji,rki,er,eb
38 1 equemene
  REAL(KREAL) :: fcut,tf,bodij,bodji,bod,cost,gtheta,dgdt,xt,t1,t2,t3
39 1 equemene
  REAL(KREAL) :: zi,fcut2
40 1 equemene
  INTEGER(KINT) :: np,nq,nh,nc
41 1 equemene
  INTEGER(KINT) :: i, j, nn, m, n, mid, n1, im, jm, n2,n3,n4, iat
42 1 equemene
  LOGICAL, SAVE :: First=.TRUE.
43 1 equemene
  LOGICAL :: debug, FExist
44 1 equemene
45 1 equemene
  common/zdis/zshort,zlong
46 1 equemene
  common/rdistanc/rshort,rlong
47 1 equemene
48 1 equemene
49 1 equemene
  INTERFACE
50 1 equemene
     function valid(string) result (isValid)
51 1 equemene
       CHARACTER(*), intent(in) :: string
52 1 equemene
       logical                  :: isValid
53 1 equemene
     END function VALID
54 1 equemene
55 1 equemene
  END INTERFACE
56 1 equemene
57 1 equemene
!**********************************************
58 1 equemene
59 1 equemene
60 1 equemene
  debug=valid('egrad_chamfre')
61 1 equemene
62 1 equemene
 if (debug) Call Header('Entering Egrad_chamfre')
63 1 equemene
64 1 equemene
  v=0.0;dvdr=0.0
65 1 equemene
!******prepare the parameters of REBO potential
66 1 equemene
!rshort=3.5
67 1 equemene
!rlong=3.9
68 1 equemene
zshort=3.5
69 1 equemene
zlong=4.5
70 1 equemene
71 1 equemene
rnn=3.2    !! to adjust
72 1 equemene
rnc=3.5    !! to adjust
73 1 equemene
rnh=3.0    !! to adjust
74 1 equemene
rch=3.2    !! to adjust
75 1 equemene
rhh=3.2    !! to adjust
76 1 equemene
77 1 equemene
!rph=rlong
78 1 equemene
79 1 equemene
 if (First) THEN
80 1 equemene
    First=.FALSE.
81 1 equemene
    INQUIRE(FILE="parameter.dat",EXIST=FExist)
82 1 equemene
    if (.NOT.Fexist) THEN
83 1 equemene
       WRITE(*,*) "!!!!!!!!!!!! ERROR !!!!!!!!!!!!!!!!"
84 1 equemene
       WRITE(*,*) "!!   egrad_chamfre             !!!!"
85 1 equemene
       WRITE(*,*) "The file parameter.dat does not exists."
86 1 equemene
       WRITE(*,*) "!!   egrad_chamfre             !!!!"
87 1 equemene
       WRITE(*,*) "!!!!!!!!!!!! ERROR !!!!!!!!!!!!!!!!"
88 1 equemene
       STOP
89 1 equemene
    END IF
90 1 equemene
open(1,file="parameter.dat")
91 1 equemene
do i=1,5   !Ni-Ni
92 1 equemene
read(1,*)ann(i)
93 1 equemene
enddo
94 1 equemene
95 1 equemene
do i=1,5   !Ni-C
96 1 equemene
read(1,*)anc(i)
97 1 equemene
enddo
98 1 equemene
99 1 equemene
do i=1,5   !Ni-H
100 1 equemene
read(1,*)anh(i)
101 1 equemene
enddo
102 1 equemene
103 1 equemene
do i=1,5   !H-H
104 1 equemene
read(1,*)ahh(i)
105 1 equemene
enddo
106 1 equemene
do i=1,5  !C-H
107 1 equemene
read(1,*)ach(i)
108 1 equemene
enddo
109 1 equemene
!********LONG INTERACTION **********
110 1 equemene
!do i=1,2
111 1 equemene
!read(1,*)a(i)
112 1 equemene
!enddo
113 1 equemene
close(1)
114 1 equemene
END IF
115 1 equemene
!************************************
116 1 equemene
np=45
117 1 equemene
nh=4
118 1 equemene
nc=1
119 1 equemene
nq=np+nh+nc
120 1 equemene
!************************************
121 1 equemene
122 1 equemene
 DO I=1,Nat
123 1 equemene
    Iat=Order(I)
124 1 equemene
    xa(I)=Geom(Iat,1)
125 1 equemene
    ya(I)=Geom(Iat,2)
126 1 equemene
    za(I)=Geom(Iat,3)
127 1 equemene
 END DO
128 1 equemene
129 1 equemene
px=0.0;py=0.0;pz=0.0
130 1 equemene
nn=0
131 1 equemene
 do m=-1,1
132 1 equemene
    do n=-1,1
133 1 equemene
       do i=1,nq
134 1 equemene
          if(m==0.and.n==0.and.i==1)mid=nn
135 1 equemene
            nn=nn+1
136 1 equemene
            px(nn)=xa(i)+m*lat_a(1)+n*lat_b(1)
137 1 equemene
            py(nn)=ya(i)+m*lat_a(2)+n*lat_b(2)
138 1 equemene
            pz(nn)=za(i)
139 1 equemene
            ka(nn)=i;kx(nn)=m;ky(nn)=n
140 1 equemene
       enddo
141 1 equemene
    enddo
142 1 equemene
 enddo
143 1 equemene
!***********************xyz file required for MS input
144 1 equemene
 open(123,file="111.xyz",ACCESS='APPEND')
145 1 equemene
    write(123,*)nn
146 1 equemene
    write(123,*)
147 1 equemene
   do i=1,nn
148 1 equemene
       if(ka(i)<(np+1))then
149 1 equemene
            write(123,10)'Ni',px(i),py(i),pz(i)
150 1 equemene
       elseif (ka(i)<np+5) then
151 1 equemene
            write(123,10)'H',px(i),py(i),pz(i)
152 1 equemene
       else
153 1 equemene
            write(123,10)'C',px(i),py(i),pz(i)
154 1 equemene
  10 format(a6,3f15.8)
155 1 equemene
       endif
156 1 equemene
   enddo
157 1 equemene
 close(123)
158 1 equemene
!******************************************
159 1 equemene
 do i=1,nq
160 1 equemene
    tmp=px(i);px(i)=px(i+mid);px(i+mid)=tmp
161 1 equemene
    tmp=py(i);py(i)=py(i+mid);py(i+mid)=tmp
162 1 equemene
    tmp=pz(i);pz(i)=pz(i+mid);pz(i+mid)=tmp
163 1 equemene
    itx=kx(i);kx(i)=kx(i+mid);kx(i+mid)=itx
164 1 equemene
    ity=ky(i);ky(i)=ky(i+mid);ky(i+mid)=ity
165 1 equemene
 enddo
166 1 equemene
 mid=0
167 1 equemene
!******************************************
168 1 equemene
  nf=0;mf=0
169 1 equemene
    do i=1,nq
170 1 equemene
        nf(i)=0
171 1 equemene
           do j=1,nn
172 1 equemene
             temp=sqrt((px(i)-px(j))**2+(py(i)-py(j))**2+(pz(i)-pz(j))**2)
173 1 equemene
!
174 1 equemene
!rtemp=rlong
175 1 equemene
    if (ka(i+mid)<np+1.and.ka(j+mid)<np+1)then     ! Ni-Ni
176 1 equemene
177 1 equemene
	      rtemp=rnn
178 1 equemene
	 endif
179 1 equemene
    if (ka(i+mid)<np+1.and.ka(j+mid)>np.and.ka(j+mid)<np+5)then  ! Ni-H
180 1 equemene
181 1 equemene
           rtemp=rnh
182 1 equemene
     endif
183 1 equemene
    if (ka(i+mid)<np+1.and.ka(j+mid)>np+4) then   ! Ni-C
184 1 equemene
185 1 equemene
           rtemp=rnc
186 1 equemene
     endif
187 1 equemene
      if (ka(i+mid)>np.and.ka(i+mid)<np+5.and.ka(j+mid)>np+4)  then ! H-C
188 1 equemene
189 1 equemene
            rtemp=rch
190 1 equemene
     endif
191 1 equemene
    if (ka(i+mid)>np.and.ka(i+mid)<np+5.and.ka(j+mid)>np.and.ka(j+mid)<np+5)then  ! H-H
192 1 equemene
193 1 equemene
	        rtemp=rhh
194 1 equemene
	 endif
195 1 equemene
    if (ka(i+mid)>np.and.ka(i+mid)<np+5.and.ka(j+mid)<np+1) then  ! H-Ni
196 1 equemene
197 1 equemene
             rtemp=rnh
198 1 equemene
       endif
199 1 equemene
    if (ka(i+mid)>np+4.and.ka(j+mid)<np+1) then !  C-Ni
200 1 equemene
201 1 equemene
             rtemp=rnc
202 1 equemene
     endif
203 1 equemene
    if (ka(i+mid)>np+4.and.ka(j+mid)>np.and.ka(j+mid)<np+5) then ! C-H
204 1 equemene
205 1 equemene
              rtemp=rch
206 1 equemene
     endif
207 1 equemene
208 1 equemene
      if(temp>0.1.and.temp<rtemp)then
209 1 equemene
         nf(i)=nf(i)+1
210 1 equemene
         mf(i,nf(i))=j
211 1 equemene
      endif
212 1 equemene
!
213 1 equemene
    enddo
214 1 equemene
  !write(*,*)nf(i)
215 1 equemene
 enddo
216 1 equemene
!**************************************
217 1 equemene
!stop
218 1 equemene
219 1 equemene
!*************************************Starting to calculate the sum
220 1 equemene
  yf=0.0;dvdr=0.0
221 1 equemene
   do i=1,nq
222 1 equemene
      er=0.0;eb=0.0
223 1 equemene
      dv=0.0;df=0.0
224 1 equemene
      do j=1,nf(i)
225 1 equemene
226 1 equemene
             xi(1)=px(i);      xi(2)=py(i);      xi(3)=pz(i)
227 1 equemene
             xj(1)=px(mf(i,j));xj(2)=py(mf(i,j));xj(3)=pz(mf(i,j))
228 1 equemene
             rij=sqrt((xj(1)-xi(1))**2.0+(xj(2)-xi(2))**2.0+(xj(3)-xi(3))**2.0)
229 1 equemene
             n1=ka(i)/(np+1);n2=ka(mf(i,j))/(np+1)    !!!  Ni 46  H  50  C
230 1 equemene
             n3=ka(i)/(np+5);n4=ka(mf(i,j))/(np+5)
231 1 equemene
232 1 equemene
 !**********************************Ni-Ni interaction
233 1 equemene
 ! **********
234 1 equemene
         if(n1==0.and.n3==0.and.n2==0.and.n4==0)then		 !Ni-Ni
235 1 equemene
           call fctNiNi(rnn,rij,fcut)
236 1 equemene
           call dfcutNiNi(rnn,rij,tf)
237 1 equemene
            eb=eb+ann(5)*exp(-2.0*ann(1)*(rij/ann(3)-1.0))*fcut
238 1 equemene
            er=er+ann(4)*exp(-1.0*ann(2)*(rij/ann(3)-1.0))*fcut
239 1 equemene
240 1 equemene
!Calculation of FORCE
241 1 equemene
do im=1,3
242 1 equemene
dv(i,1,im)=dv(i,1,im)+ann(4)*exp(-1.0*ann(2)*(rij/ann(3)-1.0))*fcut*(-ann(2)/ann(3))*(xi(im)-xj(im))/rij
243 1 equemene
dv(i,2,im)=dv(i,2,im)+ann(5)*exp(-2.0*ann(1)*(rij/ann(3)-1.0))*fcut
244 1 equemene
dv(i,3,im)=dv(i,3,im)+ann(5)*exp(-2.0*ann(1)*(rij/ann(3)-1.0))*fcut*(-2.0*ann(1)/ann(3))*(xi(im)-xj(im))/rij
245 1 equemene
dv(ka(mf(i+mid,j)),1,im)=dv(ka(mf(i+mid,j)),1,im)+ann(4)*exp(-1.0*ann(2)*(rij/ann(3)-1.0))*fcut*(-ann(2)/ann(3))*(xj(im)-xi(im))/rij
246 1 equemene
dv(ka(mf(i+mid,j)),2,im)=dv(ka(mf(i+mid,j)),2,im)+ann(5)*exp(-2.0*ann(1)*(rij/ann(3)-1.0))*fcut
247 1 equemene
dv(ka(mf(i+mid,j)),3,im)=dv(ka(mf(i+mid,j)),3,im)+ann(5)*exp(-2.0*ann(1)*(rij/ann(3)-1.0))*fcut*(-2.0*ann(1)/ann(3))*(xj(im)-xi(im))/rij
248 1 equemene
249 1 equemene
df(i,1,im)=df(i,1,im)+ann(4)*exp(-1.0*ann(2)*(rij/ann(3)-1.0))*tf*(xi(im)-xj(im))/rij
250 1 equemene
df(i,2,im)=df(i,2,im)+ann(5)*exp(-2.0*ann(1)*(rij/ann(3)-1.0))*fcut
251 1 equemene
df(i,3,im)=df(i,3,im)+ann(5)*exp(-2.0*ann(1)*(rij/ann(3)-1.0))*tf*(xi(im)-xj(im))/rij
252 1 equemene
df(ka(mf(i+mid,j)),1,im)=df(ka(mf(i+mid,j)),1,im)+ann(4)*exp(-1.0*ann(2)*(rij/ann(3)-1.0))*tf*(xj(im)-xi(im))/rij
253 1 equemene
df(ka(mf(i+mid,j)),2,im)=df(ka(mf(i+mid,j)),2,im)+ann(5)*exp(-2.0*ann(1)*(rij/ann(3)-1.0))*fcut
254 1 equemene
df(ka(mf(i+mid,j)),3,im)=df(ka(mf(i+mid,j)),3,im)+ann(5)*exp(-2.0*ann(1)*(rij/ann(3)-1.0))*tf*(xj(im)-xi(im))/rij
255 1 equemene
enddo
256 1 equemene
!
257 1 equemene
             endif
258 1 equemene
259 1 equemene
 !**********************************Ni-H interaction
260 1 equemene
! **********
261 1 equemene
         if(n1==0.and.n3==0.and.n2==1.and.n4==0)then		 !Ni-H
262 1 equemene
           call fctNiH(rnh,rij,fcut)
263 1 equemene
           call dfcutNiH(rnh,rij,tf)
264 1 equemene
             eb=eb+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut
265 1 equemene
             er=er+anh(4)*exp(-1.0*anh(2)*(rij/anh(3)-1.0))*fcut
266 1 equemene
267 1 equemene
!Calculation of FORCE
268 1 equemene
do im=1,3
269 1 equemene
dv(i,1,im)=dv(i,1,im)+anh(4)*exp(-1.0*anh(2)*(rij/anh(3)-1.0))*fcut*(-anh(2)/anh(3))*(xi(im)-xj(im))/rij
270 1 equemene
dv(i,2,im)=dv(i,2,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut
271 1 equemene
dv(i,3,im)=dv(i,3,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut*(-2.0*anh(1)/anh(3))*(xi(im)-xj(im))/rij
272 1 equemene
dv(ka(mf(i+mid,j)),1,im)=dv(ka(mf(i+mid,j)),1,im)+anh(4)*exp(-1.0*anh(2)*(rij/anh(3)-1.0))*fcut*(-anh(2)/anh(3))*(xj(im)-xi(im))/rij
273 1 equemene
dv(ka(mf(i+mid,j)),2,im)=dv(ka(mf(i+mid,j)),2,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut
274 1 equemene
dv(ka(mf(i+mid,j)),3,im)=dv(ka(mf(i+mid,j)),3,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut*(-2.0*anh(1)/anh(3))*(xj(im)-xi(im))/rij
275 1 equemene
276 1 equemene
df(i,1,im)=df(i,1,im)+anh(4)*exp(-1.0*anh(2)*(rij/anh(3)-1.0))*tf*(xi(im)-xj(im))/rij
277 1 equemene
df(i,2,im)=df(i,2,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut
278 1 equemene
df(i,3,im)=df(i,3,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*tf*(xi(im)-xj(im))/rij
279 1 equemene
df(ka(mf(i+mid,j)),1,im)=df(ka(mf(i+mid,j)),1,im)+anh(4)*exp(-1.0*anh(2)*(rij/anh(3)-1.0))*tf*(xj(im)-xi(im))/rij
280 1 equemene
df(ka(mf(i+mid,j)),2,im)=df(ka(mf(i+mid,j)),2,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut
281 1 equemene
df(ka(mf(i+mid,j)),3,im)=df(ka(mf(i+mid,j)),3,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*tf*(xj(im)-xi(im))/rij
282 1 equemene
enddo
283 1 equemene
!
284 1 equemene
!
285 1 equemene
             endif
286 1 equemene
287 1 equemene
!**********************************Ni-C interaction
288 1 equemene
! **********
289 1 equemene
         if(n1==0.and.n3==0.and.n2==1.and.n4==1)then		 !Ni-C
290 1 equemene
           call fctNiC(rnc,rij,fcut)
291 1 equemene
           call dfcutNiC(rnc,rij,tf)
292 1 equemene
            eb=eb+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut
293 1 equemene
            er=er+anc(4)*exp(-1.0*anc(2)*(rij/anc(3)-1.0))*fcut
294 1 equemene
295 1 equemene
!Calculation of FORCE
296 1 equemene
do im=1,3
297 1 equemene
dv(i,1,im)=dv(i,1,im)+anc(4)*exp(-1.0*anc(2)*(rij/anc(3)-1.0))*fcut*(-anc(2)/anc(3))*(xi(im)-xj(im))/rij
298 1 equemene
dv(i,2,im)=dv(i,2,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut
299 1 equemene
dv(i,3,im)=dv(i,3,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut*(-2.0*anc(1)/anc(3))*(xi(im)-xj(im))/rij
300 1 equemene
dv(ka(mf(i+mid,j)),1,im)=dv(ka(mf(i+mid,j)),1,im)+anc(4)*exp(-1.0*anc(2)*(rij/anc(3)-1.0))*fcut*(-anc(2)/anc(3))*(xj(im)-xi(im))/rij
301 1 equemene
dv(ka(mf(i+mid,j)),2,im)=dv(ka(mf(i+mid,j)),2,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut
302 1 equemene
dv(ka(mf(i+mid,j)),3,im)=dv(ka(mf(i+mid,j)),3,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut*(-2.0*anc(1)/anc(3))*(xj(im)-xi(im))/rij
303 1 equemene
304 1 equemene
df(i,1,im)=df(i,1,im)+anc(4)*exp(-1.0*anc(2)*(rij/anc(3)-1.0))*tf*(xi(im)-xj(im))/rij
305 1 equemene
df(i,2,im)=df(i,2,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut
306 1 equemene
df(i,3,im)=df(i,3,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*tf*(xi(im)-xj(im))/rij
307 1 equemene
df(ka(mf(i+mid,j)),1,im)=df(ka(mf(i+mid,j)),1,im)+anc(4)*exp(-1.0*anc(2)*(rij/anc(3)-1.0))*tf*(xj(im)-xi(im))/rij
308 1 equemene
df(ka(mf(i+mid,j)),2,im)=df(ka(mf(i+mid,j)),2,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut
309 1 equemene
df(ka(mf(i+mid,j)),3,im)=df(ka(mf(i+mid,j)),3,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*tf*(xj(im)-xi(im))/rij
310 1 equemene
enddo
311 1 equemene
!
312 1 equemene
               endif
313 1 equemene
!!**********************************H-Ni interaction
314 1 equemene
! **********
315 1 equemene
         if(n1==1.and.n3==0.and.n2==0.and.n4==0)then        ! H-Ni
316 1 equemene
           call fctNiH(rnh,rij,fcut)
317 1 equemene
           call dfcutNiH(rnh,rij,tf)
318 1 equemene
             eb=eb+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut
319 1 equemene
             er=er+anh(4)*exp(-1.0*anh(2)*(rij/anh(3)-1.0))*fcut
320 1 equemene
321 1 equemene
!Calculation of FORCE
322 1 equemene
do im=1,3
323 1 equemene
dv(i,1,im)=dv(i,1,im)+anh(4)*exp(-1.0*anh(2)*(rij/anh(3)-1.0))*fcut*(-anh(2)/anh(3))*(xi(im)-xj(im))/rij
324 1 equemene
dv(i,2,im)=dv(i,2,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut
325 1 equemene
dv(i,3,im)=dv(i,3,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut*(-2.0*anh(1)/anh(3))*(xi(im)-xj(im))/rij
326 1 equemene
dv(ka(mf(i+mid,j)),1,im)=dv(ka(mf(i+mid,j)),1,im)+anh(4)*exp(-1.0*anh(2)*(rij/anh(3)-1.0))*fcut*(-anh(2)/anh(3))*(xj(im)-xi(im))/rij
327 1 equemene
dv(ka(mf(i+mid,j)),2,im)=dv(ka(mf(i+mid,j)),2,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut
328 1 equemene
dv(ka(mf(i+mid,j)),3,im)=dv(ka(mf(i+mid,j)),3,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut*(-2.0*anh(1)/anh(3))*(xj(im)-xi(im))/rij
329 1 equemene
330 1 equemene
df(i,1,im)=df(i,1,im)+anh(4)*exp(-1.0*anh(2)*(rij/anh(3)-1.0))*tf*(xi(im)-xj(im))/rij
331 1 equemene
df(i,2,im)=df(i,2,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut
332 1 equemene
df(i,3,im)=df(i,3,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*tf*(xi(im)-xj(im))/rij
333 1 equemene
df(ka(mf(i+mid,j)),1,im)=df(ka(mf(i+mid,j)),1,im)+anh(4)*exp(-1.0*anh(2)*(rij/anh(3)-1.0))*tf*(xj(im)-xi(im))/rij
334 1 equemene
df(ka(mf(i+mid,j)),2,im)=df(ka(mf(i+mid,j)),2,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*fcut
335 1 equemene
df(ka(mf(i+mid,j)),3,im)=df(ka(mf(i+mid,j)),3,im)+anh(5)*exp(-2.0*anh(1)*(rij/anh(3)-1.0))*tf*(xj(im)-xi(im))/rij
336 1 equemene
enddo
337 1 equemene
!
338 1 equemene
              endif
339 1 equemene
!!**********************************H-H interaction
340 1 equemene
! **********
341 1 equemene
        if(n1==1.and.n3==0.and.n2==1.and.n4==0)then   !H-H
342 1 equemene
           call fctHH(rhh,rij,fcut)
343 1 equemene
           call dfcutHH(rhh,rij,tf)
344 1 equemene
              eb=eb+ahh(5)*exp(-2.0*ahh(1)*(rij/ahh(3)-1.0))*fcut
345 1 equemene
              er=er+ahh(4)*exp(-1.0*ahh(2)*(rij/ahh(3)-1.0))*fcut
346 1 equemene
347 1 equemene
!Calculation of FORCE
348 1 equemene
do im=1,3
349 1 equemene
dv(i,1,im)=dv(i,1,im)+ahh(4)*exp(-1.0*ahh(2)*(rij/ahh(3)-1.0))*fcut*(-ahh(2)/ahh(3))*(xi(im)-xj(im))/rij
350 1 equemene
dv(i,2,im)=dv(i,2,im)+ahh(5)*exp(-2.0*ahh(1)*(rij/ahh(3)-1.0))*fcut
351 1 equemene
dv(i,3,im)=dv(i,3,im)+ahh(5)*exp(-2.0*ahh(1)*(rij/ahh(3)-1.0))*fcut*(-2.0*ahh(1)/ahh(3))*(xi(im)-xj(im))/rij
352 1 equemene
dv(ka(mf(i+mid,j)),1,im)=dv(ka(mf(i+mid,j)),1,im)+ahh(4)*exp(-1.0*ahh(2)*(rij/ahh(3)-1.0))*fcut*(-ahh(2)/ahh(3))*(xj(im)-xi(im))/rij
353 1 equemene
dv(ka(mf(i+mid,j)),2,im)=dv(ka(mf(i+mid,j)),2,im)+ahh(5)*exp(-2.0*ahh(1)*(rij/ahh(3)-1.0))*fcut
354 1 equemene
dv(ka(mf(i+mid,j)),3,im)=dv(ka(mf(i+mid,j)),3,im)+ahh(5)*exp(-2.0*ahh(1)*(rij/ahh(3)-1.0))*fcut*(-2.0*ahh(1)/ahh(3))*(xj(im)-xi(im))/rij
355 1 equemene
356 1 equemene
df(i,1,im)=df(i,1,im)+ahh(4)*exp(-1.0*ahh(2)*(rij/ahh(3)-1.0))*tf*(xi(im)-xj(im))/rij
357 1 equemene
df(i,2,im)=df(i,2,im)+ahh(5)*exp(-2.0*ahh(1)*(rij/ahh(3)-1.0))*fcut
358 1 equemene
df(i,3,im)=df(i,3,im)+ahh(5)*exp(-2.0*ahh(1)*(rij/ahh(3)-1.0))*tf*(xi(im)-xj(im))/rij
359 1 equemene
df(ka(mf(i+mid,j)),1,im)=df(ka(mf(i+mid,j)),1,im)+ahh(4)*exp(-1.0*ahh(2)*(rij/ahh(3)-1.0))*tf*(xj(im)-xi(im))/rij
360 1 equemene
df(ka(mf(i+mid,j)),2,im)=df(ka(mf(i+mid,j)),2,im)+ahh(5)*exp(-2.0*ahh(1)*(rij/ahh(3)-1.0))*fcut
361 1 equemene
df(ka(mf(i+mid,j)),3,im)=df(ka(mf(i+mid,j)),3,im)+ahh(5)*exp(-2.0*ahh(1)*(rij/ahh(3)-1.0))*tf*(xj(im)-xi(im))/rij
362 1 equemene
enddo
363 1 equemene
!
364 1 equemene
             endif
365 1 equemene
366 1 equemene
367 1 equemene
!!**********************************H-C interaction
368 1 equemene
! **********
369 1 equemene
        if(n1==1.and.n3==0.and.n2==1.and.n4==1)then   !H-C
370 1 equemene
            call fctCH(rch,rij,fcut)
371 1 equemene
            call dfcutCH(rch,rij,tf)
372 1 equemene
             eb=eb+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut
373 1 equemene
             er=er+ach(4)*exp(-1.0*ach(2)*(rij/ach(3)-1.0))*fcut
374 1 equemene
375 1 equemene
!Calculation of FORCE
376 1 equemene
do im=1,3
377 1 equemene
dv(i,1,im)=dv(i,1,im)+ach(4)*exp(-1.0*ach(2)*(rij/ach(3)-1.0))*fcut*(-ach(2)/ach(3))*(xi(im)-xj(im))/rij
378 1 equemene
dv(i,2,im)=dv(i,2,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut
379 1 equemene
dv(i,3,im)=dv(i,3,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut*(-2.0*ach(1)/ach(3))*(xi(im)-xj(im))/rij
380 1 equemene
dv(ka(mf(i+mid,j)),1,im)=dv(ka(mf(i+mid,j)),1,im)+ach(4)*exp(-1.0*ach(2)*(rij/ach(3)-1.0))*fcut*(-ach(2)/ach(3))*(xj(im)-xi(im))/rij
381 1 equemene
dv(ka(mf(i+mid,j)),2,im)=dv(ka(mf(i+mid,j)),2,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut
382 1 equemene
dv(ka(mf(i+mid,j)),3,im)=dv(ka(mf(i+mid,j)),3,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut*(-2.0*ach(1)/ach(3))*(xj(im)-xi(im))/rij
383 1 equemene
384 1 equemene
df(i,1,im)=df(i,1,im)+ach(4)*exp(-1.0*ach(2)*(rij/ach(3)-1.0))*tf*(xi(im)-xj(im))/rij
385 1 equemene
df(i,2,im)=df(i,2,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut
386 1 equemene
df(i,3,im)=df(i,3,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*tf*(xi(im)-xj(im))/rij
387 1 equemene
df(ka(mf(i+mid,j)),1,im)=df(ka(mf(i+mid,j)),1,im)+ach(4)*exp(-1.0*ach(2)*(rij/ach(3)-1.0))*tf*(xj(im)-xi(im))/rij
388 1 equemene
df(ka(mf(i+mid,j)),2,im)=df(ka(mf(i+mid,j)),2,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut
389 1 equemene
df(ka(mf(i+mid,j)),3,im)=df(ka(mf(i+mid,j)),3,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*tf*(xj(im)-xi(im))/rij
390 1 equemene
enddo
391 1 equemene
!
392 1 equemene
                endif
393 1 equemene
!!**********************************C-Ni interaction
394 1 equemene
! **********
395 1 equemene
        if(n1==1.and.n3==1.and.n2==0.and.n4==0)then   !C-Ni
396 1 equemene
            call fctNiC(rnc,rij,fcut)
397 1 equemene
            call dfcutNiC(rnc,rij,tf)
398 1 equemene
             eb=eb+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut
399 1 equemene
             er=er+anc(4)*exp(-1.0*anc(2)*(rij/anc(3)-1.0))*fcut
400 1 equemene
401 1 equemene
!Calculation of FORCE
402 1 equemene
do im=1,3
403 1 equemene
dv(i,1,im)=dv(i,1,im)+anc(4)*exp(-1.0*anc(2)*(rij/anc(3)-1.0))*fcut*(-anc(2)/anc(3))*(xi(im)-xj(im))/rij
404 1 equemene
dv(i,2,im)=dv(i,2,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut
405 1 equemene
dv(i,3,im)=dv(i,3,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut*(-2.0*anc(1)/anc(3))*(xi(im)-xj(im))/rij
406 1 equemene
dv(ka(mf(i+mid,j)),1,im)=dv(ka(mf(i+mid,j)),1,im)+anc(4)*exp(-1.0*anc(2)*(rij/anc(3)-1.0))*fcut*(-anc(2)/anc(3))*(xj(im)-xi(im))/rij
407 1 equemene
dv(ka(mf(i+mid,j)),2,im)=dv(ka(mf(i+mid,j)),2,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut
408 1 equemene
dv(ka(mf(i+mid,j)),3,im)=dv(ka(mf(i+mid,j)),3,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut*(-2.0*anc(1)/anc(3))*(xj(im)-xi(im))/rij
409 1 equemene
410 1 equemene
df(i,1,im)=df(i,1,im)+anc(4)*exp(-1.0*anc(2)*(rij/anc(3)-1.0))*tf*(xi(im)-xj(im))/rij
411 1 equemene
df(i,2,im)=df(i,2,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut
412 1 equemene
df(i,3,im)=df(i,3,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*tf*(xi(im)-xj(im))/rij
413 1 equemene
df(ka(mf(i+mid,j)),1,im)=df(ka(mf(i+mid,j)),1,im)+anc(4)*exp(-1.0*anc(2)*(rij/anc(3)-1.0))*tf*(xj(im)-xi(im))/rij
414 1 equemene
df(ka(mf(i+mid,j)),2,im)=df(ka(mf(i+mid,j)),2,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*fcut
415 1 equemene
df(ka(mf(i+mid,j)),3,im)=df(ka(mf(i+mid,j)),3,im)+anc(5)*exp(-2.0*anc(1)*(rij/anc(3)-1.0))*tf*(xj(im)-xi(im))/rij
416 1 equemene
enddo
417 1 equemene
!
418 1 equemene
419 1 equemene
               endif
420 1 equemene
!!**********************************C-H interaction
421 1 equemene
! **********
422 1 equemene
       if(n1==1.and.n3==1.and.n2==1.and.n4==0)then   !C-H
423 1 equemene
           call fctCH(rch,rij,fcut)
424 1 equemene
           call dfcutCH(rch,rij,tf)
425 1 equemene
             eb=eb+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut
426 1 equemene
             er=er+ach(4)*exp(-1.0*ach(2)*(rij/ach(3)-1.0))*fcut
427 1 equemene
428 1 equemene
429 1 equemene
   !Calculation of FORCE
430 1 equemene
do im=1,3
431 1 equemene
dv(i,1,im)=dv(i,1,im)+ach(4)*exp(-1.0*ach(2)*(rij/ach(3)-1.0))*fcut*(-ach(2)/ach(3))*(xi(im)-xj(im))/rij
432 1 equemene
dv(i,2,im)=dv(i,2,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut
433 1 equemene
dv(i,3,im)=dv(i,3,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut*(-2.0*ach(1)/ach(3))*(xi(im)-xj(im))/rij
434 1 equemene
dv(ka(mf(i+mid,j)),1,im)=dv(ka(mf(i+mid,j)),1,im)+ach(4)*exp(-1.0*ach(2)*(rij/ach(3)-1.0))*fcut*(-ach(2)/ach(3))*(xj(im)-xi(im))/rij
435 1 equemene
dv(ka(mf(i+mid,j)),2,im)=dv(ka(mf(i+mid,j)),2,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut
436 1 equemene
dv(ka(mf(i+mid,j)),3,im)=dv(ka(mf(i+mid,j)),3,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut*(-2.0*ach(1)/ach(3))*(xj(im)-xi(im))/rij
437 1 equemene
438 1 equemene
df(i,1,im)=df(i,1,im)+ach(4)*exp(-1.0*ach(2)*(rij/ach(3)-1.0))*tf*(xi(im)-xj(im))/rij
439 1 equemene
df(i,2,im)=df(i,2,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut
440 1 equemene
df(i,3,im)=df(i,3,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*tf*(xi(im)-xj(im))/rij
441 1 equemene
df(ka(mf(i+mid,j)),1,im)=df(ka(mf(i+mid,j)),1,im)+ach(4)*exp(-1.0*ach(2)*(rij/ach(3)-1.0))*tf*(xj(im)-xi(im))/rij
442 1 equemene
df(ka(mf(i+mid,j)),2,im)=df(ka(mf(i+mid,j)),2,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*fcut
443 1 equemene
df(ka(mf(i+mid,j)),3,im)=df(ka(mf(i+mid,j)),3,im)+ach(5)*exp(-2.0*ach(1)*(rij/ach(3)-1.0))*tf*(xj(im)-xi(im))/rij
444 1 equemene
enddo
445 1 equemene
!
446 1 equemene
447 1 equemene
        endif
448 1 equemene
  !!***************************ONE end****************
449 1 equemene
450 1 equemene
enddo
451 1 equemene
!!******** CALCULATION ENERGY
452 1 equemene
!
453 1 equemene
        yf=yf+er-sqrt(eb)
454 1 equemene
!!*********
455 1 equemene
       do im=1,3
456 1 equemene
            dvdr(i,im)=dvdr(i,im)+dv(i,1,im)-0.5/(dv(i,2,im))**0.5*dv(i,3,im)
457 1 equemene
            dvdr(i,im)=dvdr(i,im)+df(i,1,im)-0.5/(df(i,2,im))**0.5*df(i,3,im)
458 1 equemene
         do j=1,nf(i+mid)
459 1 equemene
             jm=ka(mf(i+mid,j))
460 1 equemene
             dvdr(jm,im)=dvdr(jm,im)+dv(jm,1,im)-0.5/(dv(i,2,im))**0.5*dv(jm,3,im)
461 1 equemene
             dvdr(jm,im)=dvdr(jm,im)+df(jm,1,im)-0.5/(df(i,2,im))**0.5*df(jm,3,im)
462 1 equemene
         enddo
463 1 equemene
       enddo
464 1 equemene
!
465 1 equemene
enddo
466 1 equemene
!!*****************************TWO ENDS**************************
467 1 equemene
!***************************************Long-ranged interaction
468 1 equemene
!do i=nq-4,nq
469 1 equemene
!     zi=pz(i+mid) !-0.3*aa*br(3,3)
470 1 equemene
!     call fct2(zshort,zlong,zi,fcut2)
471 1 equemene
 !    call dfcut2(zshort,zlong,zi,tf)
472 1 equemene
 !    yf=yf+fcut2*(a(6)-a(7)/zi**2.0)
473 1 equemene
474 1 equemene
 !  dvdr(i,3)=dvdr(i,3)+fcut2*(a(7)*2.0/zi**3.0)+tf*(a(6)-a(7)/zi**2.0)
475 1 equemene
476 1 equemene
!enddo
477 1 equemene
!*******************************************************************
478 1 equemene
  v=yf
479 1 equemene
   do im=1,3
480 1 equemene
      do jm=1,nq
481 1 equemene
          dvdr(jm,im)=dvdr(jm,im)
482 1 equemene
      enddo
483 1 equemene
  enddo
484 1 equemene
485 1 equemene
!PFL: We convert dvdr into Grad
486 1 equemene
      do jm=1,nq
487 1 equemene
          Iat=Jm
488 1 equemene
          if (renum) Iat=order(jm)
489 1 equemene
          Grad(3*Iat-2:3*Iat)=dvdr(jm,1:3)
490 1 equemene
      enddo
491 1 equemene
492 1 equemene
 if (debug) WRITE(*,*) "EGRAD_CHAMFRE, E=",V
493 1 equemene
494 1 equemene
 if (debug) call Header('Egrad_chamfre OVER')
495 1 equemene
496 1 equemene
!********************************************ENDENDENDENDENDENDENDEND
497 1 equemene
return
498 1 equemene
end subroutine egrad_chamfre
499 1 equemene
500 1 equemene
!******************************************
501 1 equemene
!**********PARAMETERS**********************
502 1 equemene
subroutine fctNiNi(r2,r,fcut)
503 1 equemene
504 1 equemene
   IMPLICIT NONE
505 1 equemene
     integer, parameter :: KINT = kind(1)
506 1 equemene
     integer, parameter :: KREAL = kind(1.0d0)
507 1 equemene
508 1 equemene
 REAL(KREAL) :: r2,r,fcut,r1,pi
509 1 equemene
pi=4.0*atan(1.0)
510 1 equemene
r1=r2-0.5
511 1 equemene
512 1 equemene
if(r<=r1)then
513 1 equemene
fcut=1.0
514 1 equemene
endif
515 1 equemene
if(r>r1.and.r<=r2)then
516 1 equemene
fcut=(1.0+cos(pi*(r-r1)/(r2-r1)))/2.0
517 1 equemene
endif
518 1 equemene
if(r>r2)then
519 1 equemene
fcut=0.0
520 1 equemene
endif
521 1 equemene
return
522 1 equemene
end subroutine fctNiNi
523 1 equemene
!!************
524 1 equemene
subroutine dfcutNiNi(r2,r,df)
525 1 equemene
   IMPLICIT NONE
526 1 equemene
     integer, parameter :: KINT = kind(1)
527 1 equemene
     integer, parameter :: KREAL = kind(1.0d0)
528 1 equemene
  REAL(KREAL) :: r, r2,df,pi,r1
529 1 equemene
pi=4.0*atan(1.0)
530 1 equemene
r1=r2-0.5
531 1 equemene
532 1 equemene
if(r<=r1)then
533 1 equemene
df=0.0
534 1 equemene
endif
535 1 equemene
if(r>r1.and.r<=r2)then
536 1 equemene
df=-pi/2.0/(r2-r1)*sin(pi*(r-r1)/(r2-r1))
537 1 equemene
endif
538 1 equemene
if(r>r2)then
539 1 equemene
df=0.0
540 1 equemene
endif
541 1 equemene
return
542 1 equemene
end subroutine dfcutNiNi
543 1 equemene
544 1 equemene
545 1 equemene
!!************
546 1 equemene
subroutine fctNiH(r2,r,fcut)
547 1 equemene
   IMPLICIT NONE
548 1 equemene
     integer, parameter :: KINT = kind(1)
549 1 equemene
     integer, parameter :: KREAL = kind(1.0d0)
550 1 equemene
551 1 equemene
 REAL(KREAL) ::r2,r,fcut
552 1 equemene
REAL(KREAL) ::rshort,rlong,r1,pi
553 1 equemene
554 1 equemene
 rshort=2.7
555 1 equemene
 rlong=3.0
556 1 equemene
 pi=4.0*atan(1.0)
557 1 equemene
 r1=rshort
558 1 equemene
 r2=rlong
559 1 equemene
if(r<=r1)then
560 1 equemene
 fcut=1.0
561 1 equemene
endif
562 1 equemene
if(r>r1.and.r<=r2)then
563 1 equemene
 fcut=(1.0+cos(pi*(r-r1)/(r2-r1)))/2.0
564 1 equemene
endif
565 1 equemene
if(r>r2)then
566 1 equemene
 fcut=0.0
567 1 equemene
endif
568 1 equemene
return
569 1 equemene
end subroutine fctNiH
570 1 equemene
!!**********
571 1 equemene
572 1 equemene
subroutine dfcutNiH(r2,r,df)
573 1 equemene
574 1 equemene
575 1 equemene
   IMPLICIT NONE
576 1 equemene
     integer, parameter :: KINT = kind(1)
577 1 equemene
     integer, parameter :: KREAL = kind(1.0d0)
578 1 equemene
579 1 equemene
580 1 equemene
REAL(KREAL) ::r2,r,df
581 1 equemene
REAL(KREAL) ::rshort,rlong,r1,pi
582 1 equemene
583 1 equemene
 rshort=2.7
584 1 equemene
 rlong=3.0
585 1 equemene
 pi=4.0*atan(1.0)
586 1 equemene
 r1=rshort
587 1 equemene
 r2=rlong
588 1 equemene
if(r<=r1)then
589 1 equemene
 df=0.0
590 1 equemene
endif
591 1 equemene
if(r>r1.and.r<=r2)then
592 1 equemene
 df=-pi/2.0/(r2-r1)*sin(pi*(r-r1)/(r2-r1))
593 1 equemene
endif
594 1 equemene
if(r>r2)then
595 1 equemene
 df=0.0
596 1 equemene
endif
597 1 equemene
return
598 1 equemene
end subroutine dfcutNiH
599 1 equemene
600 1 equemene
!!************
601 1 equemene
subroutine fctNiC(r2,r,fcut)
602 1 equemene
603 1 equemene
   IMPLICIT NONE
604 1 equemene
     integer, parameter :: KINT = kind(1)
605 1 equemene
     integer, parameter :: KREAL = kind(1.0d0)
606 1 equemene
607 1 equemene
608 1 equemene
REAL(KREAL) ::r2,r,fcut
609 1 equemene
REAL(KREAL) ::rshort,rlong,r1,pi
610 1 equemene
611 1 equemene
 rshort=3.2
612 1 equemene
 rlong=3.5
613 1 equemene
 pi=4.0*atan(1.0)
614 1 equemene
 r1=rshort
615 1 equemene
 r2=rlong
616 1 equemene
if(r<=r1)then
617 1 equemene
 fcut=1.0
618 1 equemene
endif
619 1 equemene
if(r>r1.and.r<=r2)then
620 1 equemene
 fcut=(1.0+cos(pi*(r-r1)/(r2-r1)))/2.0
621 1 equemene
endif
622 1 equemene
if(r>r2)then
623 1 equemene
 fcut=0.0
624 1 equemene
endif
625 1 equemene
return
626 1 equemene
end subroutine fctNiC
627 1 equemene
628 1 equemene
!!***********
629 1 equemene
subroutine dfcutNiC(r2,r,df)
630 1 equemene
631 1 equemene
   IMPLICIT NONE
632 1 equemene
     integer, parameter :: KINT = kind(1)
633 1 equemene
     integer, parameter :: KREAL = kind(1.0d0)
634 1 equemene
635 1 equemene
636 1 equemene
REAL(KREAL) ::r2,r,df
637 1 equemene
REAL(KREAL) ::rshort,rlong,r1,pi
638 1 equemene
639 1 equemene
 rshort=3.2
640 1 equemene
 rlong=3.5
641 1 equemene
 pi=4.0*atan(1.0)
642 1 equemene
 r1=rshort
643 1 equemene
 r2=rlong
644 1 equemene
if(r<=r1)then
645 1 equemene
 df=0.0
646 1 equemene
endif
647 1 equemene
if(r>r1.and.r<=r2)then
648 1 equemene
 df=-pi/2.0/(r2-r1)*sin(pi*(r-r1)/(r2-r1))
649 1 equemene
endif
650 1 equemene
if(r>r2)then
651 1 equemene
 df=0.0
652 1 equemene
endif
653 1 equemene
return
654 1 equemene
end subroutine dfcutNiC
655 1 equemene
656 1 equemene
!!************
657 1 equemene
subroutine fctCH(r2,r,fcut)
658 1 equemene
659 1 equemene
660 1 equemene
   IMPLICIT NONE
661 1 equemene
     integer, parameter :: KINT = kind(1)
662 1 equemene
     integer, parameter :: KREAL = kind(1.0d0)
663 1 equemene
664 1 equemene
665 1 equemene
REAL(KREAL) ::r2,r,fcut
666 1 equemene
REAL(KREAL) ::rshort,rlong,r1,pi
667 1 equemene
668 1 equemene
 rshort=2.1
669 1 equemene
 rlong=3.2
670 1 equemene
 pi=4.0*atan(1.0)
671 1 equemene
 r1=rshort
672 1 equemene
 r2=rlong
673 1 equemene
if(r<=r1)then
674 1 equemene
 fcut=1.0
675 1 equemene
endif
676 1 equemene
if(r>r1.and.r<=r2)then
677 1 equemene
 fcut=(1.0+cos(pi*(r-r1)/(r2-r1)))/2.0
678 1 equemene
endif
679 1 equemene
if(r>r2)then
680 1 equemene
 fcut=0.0
681 1 equemene
endif
682 1 equemene
return
683 1 equemene
end subroutine fctCH
684 1 equemene
!!*****************
685 1 equemene
686 1 equemene
subroutine dfcutCH(r2,r,df)
687 1 equemene
688 1 equemene
689 1 equemene
   IMPLICIT NONE
690 1 equemene
     integer, parameter :: KINT = kind(1)
691 1 equemene
     integer, parameter :: KREAL = kind(1.0d0)
692 1 equemene
693 1 equemene
694 1 equemene
REAL(KREAL) ::r2,r,df
695 1 equemene
REAL(KREAL) ::rshort,rlong,r1,pi
696 1 equemene
697 1 equemene
 rshort=2.1
698 1 equemene
 rlong=3.2
699 1 equemene
 pi=4.0*atan(1.0)
700 1 equemene
 r1=rshort
701 1 equemene
 r2=rlong
702 1 equemene
if(r<=r1)then
703 1 equemene
 df=0.0
704 1 equemene
endif
705 1 equemene
if(r>r1.and.r<=r2)then
706 1 equemene
 df=-pi/2.0/(r2-r1)*sin(pi*(r-r1)/(r2-r1))
707 1 equemene
endif
708 1 equemene
if(r>r2)then
709 1 equemene
 df=0.0
710 1 equemene
endif
711 1 equemene
return
712 1 equemene
end subroutine dfcutCH
713 1 equemene
!!************
714 1 equemene
subroutine fctHH(r2,r,fcut)
715 1 equemene
716 1 equemene
   IMPLICIT NONE
717 1 equemene
     integer, parameter :: KINT = kind(1)
718 1 equemene
     integer, parameter :: KREAL = kind(1.0d0)
719 1 equemene
720 1 equemene
721 1 equemene
REAL(KREAL) ::r2,r,fcut,r1,pi
722 1 equemene
pi=4.0*atan(1.0)
723 1 equemene
r1=r2-1.1
724 1 equemene
if(r<=r1)then
725 1 equemene
 fcut=1.0
726 1 equemene
endif
727 1 equemene
if(r>r1.and.r<=r2)then
728 1 equemene
 fcut=(1.0+cos(pi*(r-r1)/(r2-r1)))/2.0
729 1 equemene
endif
730 1 equemene
if(r>r2)then
731 1 equemene
 fcut=0.0
732 1 equemene
endif
733 1 equemene
return
734 1 equemene
end subroutine fctHH
735 1 equemene
!!************
736 1 equemene
subroutine dfcutHH(r2,r,df)
737 1 equemene
738 1 equemene
739 1 equemene
   IMPLICIT NONE
740 1 equemene
     integer, parameter :: KINT = kind(1)
741 1 equemene
     integer, parameter :: KREAL = kind(1.0d0)
742 1 equemene
743 1 equemene
744 1 equemene
REAL(KREAL) ::r2,r,df,r1,pi
745 1 equemene
pi=4.0*atan(1.0)
746 1 equemene
r1=r2-1.1
747 1 equemene
if(r<=r1)then
748 1 equemene
 df=0.0
749 1 equemene
endif
750 1 equemene
if(r>r1.and.r<=r2)then
751 1 equemene
 df=-pi/2.0/(r2-r1)*sin(pi*(r-r1)/(r2-r1))
752 1 equemene
endif
753 1 equemene
if(r>r2)then
754 1 equemene
 df=0.0
755 1 equemene
endif
756 1 equemene
return
757 1 equemene
end subroutine dfcutHH
758 1 equemene
759 1 equemene
!!*********************LONG INTERACTION
760 1 equemene
761 1 equemene
subroutine dfcut2(zshort,zlong,r,df)
762 1 equemene
763 1 equemene
764 1 equemene
   IMPLICIT NONE
765 1 equemene
     integer, parameter :: KINT = kind(1)
766 1 equemene
     integer, parameter :: KREAL = kind(1.0d0)
767 1 equemene
768 1 equemene
769 1 equemene
REAL(KREAL) ::zshort,zlong,r,df,pi, r1, r2
770 1 equemene
771 1 equemene
pi=4.0*atan(1.0)
772 1 equemene
773 1 equemene
r1=zshort
774 1 equemene
r2=zlong
775 1 equemene
776 1 equemene
if(r<=r1)then
777 1 equemene
df=0.0
778 1 equemene
endif
779 1 equemene
if(r>r1.and.r<=r2)then
780 1 equemene
df=pi/2.0/(r2-r1)*sin(pi*(r-r1)/(r2-r1))
781 1 equemene
endif
782 1 equemene
if(r>r2)then
783 1 equemene
df=0.0
784 1 equemene
endif
785 1 equemene
786 1 equemene
return
787 1 equemene
end subroutine dfcut2
788 1 equemene
789 1 equemene
subroutine fct2(zshort,zlong,r,fcut)
790 1 equemene
791 1 equemene
   IMPLICIT NONE
792 1 equemene
     integer, parameter :: KINT = kind(1)
793 1 equemene
     integer, parameter :: KREAL = kind(1.0d0)
794 1 equemene
795 1 equemene
796 1 equemene
REAL(KREAL) ::zshort,zlong,r,fcut,pi,r1,r2
797 1 equemene
798 1 equemene
pi=4.0*atan(1.0)
799 1 equemene
800 1 equemene
r1=zshort
801 1 equemene
r2=zlong
802 1 equemene
803 1 equemene
if(r<=r1)then
804 1 equemene
fcut=0.0
805 1 equemene
endif
806 1 equemene
if(r>r1.and.r<=r2)then
807 1 equemene
fcut=1.0-(1.0+cos(pi*(r-r1)/(r2-r1)))/2.0
808 1 equemene
endif
809 1 equemene
if(r>r2)then
810 1 equemene
fcut=1.0
811 1 equemene
endif
812 1 equemene
813 1 equemene
return
814 1 equemene
end subroutine fct2