ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-4/src/UseTheForce/DarkSide/suttonchen.F90
(Generate patch)

Comparing trunk/OOPSE-4/src/UseTheForce/DarkSide/suttonchen.F90 (file contents):
Revision 2412 by chuckv, Wed Nov 2 23:50:56 2005 UTC vs.
Revision 2430 by chuckv, Mon Nov 14 22:20:35 2005 UTC

# Line 63 | Line 63 | module suttonchen
63    integer, save :: SC_Mixing_Policy
64    real(kind = dp), save :: SC_rcut
65    logical, save :: haveRcut = .false.
66 <  logical, save,:: haveMixingMap = .false.
66 >  logical, save :: haveMixingMap = .false.
67 >  logical, save :: useGeometricDistanceMixing = .false.
68  
69 +
70 +
71 +
72    character(len = statusMsgSize) :: errMesg
73 <  integer :: eam_err
73 >  integer :: sc_err
74  
75    character(len = 200) :: errMsg
76    character(len=*), parameter :: RoutineName =  "Sutton-Chen MODULE"
# Line 82 | Line 86 | module suttonchen
86       real(kind=dp)     :: n
87       real(kind=dp)     :: alpha
88       real(kind=dp)     :: epsilon
89 +     real(kind=dp)     :: sc_rcut
90    end type SCtype
91  
92  
# Line 89 | Line 94 | module suttonchen
94    real( kind = dp), dimension(:), allocatable :: rho
95    real( kind = dp), dimension(:), allocatable :: frho
96    real( kind = dp), dimension(:), allocatable :: dfrhodrho
92  real( kind = dp), dimension(:), allocatable :: d2frhodrhodrho
97  
98  
99 +
100    !! Arrays for MPI storage
101   #ifdef IS_MPI
102    real( kind = dp),save, dimension(:), allocatable :: dfrhodrho_col
# Line 101 | Line 106 | module suttonchen
106    real( kind = dp),save, dimension(:), allocatable :: rho_row
107    real( kind = dp),save, dimension(:), allocatable :: rho_col
108    real( kind = dp),save, dimension(:), allocatable :: rho_tmp
104  real( kind = dp),save, dimension(:), allocatable :: d2frhodrhodrho_col
105  real( kind = dp),save, dimension(:), allocatable :: d2frhodrhodrho_row
109   #endif
110  
111    type, private :: SCTypeList
# Line 121 | Line 124 | module suttonchen
124   type :: MixParameters
125       real(kind=DP) :: alpha
126       real(kind=DP) :: epsilon
127 <     real(kind=dp) :: sigma6
127 >     real(kind=DP) :: m
128 >     real(Kind=DP) :: n
129 >     real(kind=DP) :: vpair_pot
130       real(kind=dp) :: rCut
126     real(kind=dp) :: vpair_pot
131       logical       :: rCutWasSet = .false.
132 <     logical       :: shiftedPot
129 <     logical       :: isSoftCore = .false.
132 >
133    end type MixParameters
134  
135    type(MixParameters), dimension(:,:), allocatable :: MixingMap
136  
137  
138  
136  public :: init_SC_FF
139    public :: setCutoffSC
140    public :: do_SC_pair
141    public :: newSCtype
# Line 141 | Line 143 | module suttonchen
143    public :: clean_SC
144    public :: destroySCtypes
145    public :: getSCCut
146 <  public :: setSCDefaultCutoff
147 <  public :: setSCUniformCutoff
146 > ! public :: setSCDefaultCutoff
147 > ! public :: setSCUniformCutoff
148 >  public :: useGeometricMixing
149  
150   contains
151  
152  
153 <  subroutine newSCtype(c,m,n,alpha,epsilon,c_ident,status)
154 <    real (kind = dp )                      :: lattice_constant
155 <    integer                                :: eam_nrho
156 <    real (kind = dp )                      :: eam_drho
157 <    integer                                :: eam_nr
158 <    real (kind = dp )                      :: eam_dr
159 <    real (kind = dp )                      :: rcut
160 <    real (kind = dp ), dimension(eam_nr)   :: eam_Z_r
158 <    real (kind = dp ), dimension(eam_nr)   :: eam_rho_r
159 <    real (kind = dp ), dimension(eam_nrho) :: eam_F_rho
153 >  subroutine newSCtype(c_ident,c,m,n,alpha,epsilon,status)
154 >    real (kind = dp )                      :: c ! Density Scaling
155 >    real (kind = dp )                      :: m ! Density Exponent
156 >    real (kind = dp )                      :: n ! Pair Potential Exponent
157 >    real (kind = dp )                      :: alpha ! Length Scaling
158 >    real (kind = dp )                      :: epsilon ! Energy Scaling
159 >
160 >
161      integer                                :: c_ident
162      integer                                :: status
163  
# Line 170 | Line 171 | contains
171  
172  
173      !! Assume that atypes has already been set and get the total number of types in atypes
173    !! Also assume that every member of atypes is a EAM model.
174  
175  
176      ! check to see if this is the first time into
177 <    if (.not.associated(EAMList%EAMParams)) then
177 >    if (.not.associated(SCList%SCTypes)) then
178         call getMatchingElementList(atypes, "is_SuttonChen", .true., nSCtypes, MatchList)
179 <       SCTypeList%nSCtypes = nSCtypes
180 <       allocate(SCTypeList%SCTypes(nSCTypes))
179 >       SCList%nSCtypes = nSCtypes
180 >       allocate(SCList%SCTypes(nSCTypes))
181         nAtypes = getSize(atypes)
182 <       allocate(SCTypeList%atidToSCType(nAtypes))
182 >       allocate(SCList%atidToSCType(nAtypes))
183      end if
184  
185 <    SCTypeList%currentSCType = SCTypeList%currentSCType + 1
186 <    current = SCTypeList%currentSCType
185 >    SCList%currentSCType = SCList%currentSCType + 1
186 >    current = SCList%currentSCType
187  
188      myATID =  getFirstMatchingElement(atypes, "c_ident", c_ident)
189 <    SCTypeList%atidToSCType(myATID) = current
189 >    SCList%atidToSCType(myATID) = current
190  
191  
192    
193 <    SCTypeList%SCTypes(current)%atid         = c_ident
194 <    SCTypeList%SCTypes(current)%alpha        = alpha
195 <    SCTypeList%SCTypes(current)%c            = c
196 <    SCTypeList%SCTypes(current)%m            = m
197 <    SCTypeList%SCTypes(current)%n            = n
198 <    SCTypeList%SCTypes(current)%epsilon      = epsilon
193 >    SCList%SCTypes(current)%atid         = c_ident
194 >    SCList%SCTypes(current)%alpha        = alpha
195 >    SCList%SCTypes(current)%c            = c
196 >    SCList%SCTypes(current)%m            = m
197 >    SCList%SCTypes(current)%n            = n
198 >    SCList%SCTypes(current)%epsilon      = epsilon
199    end subroutine newSCtype
200  
201    
202    subroutine destroySCTypes()
203 +    if (associated(SCList%SCtypes)) then
204 +       deallocate(SCList%SCTypes)
205 +       SCList%SCTypes=>null()
206 +    end if
207 +    if (associated(SCList%atidToSCtype)) then
208 +       deallocate(SCList%atidToSCtype)
209 +       SCList%atidToSCtype=>null()
210 +    end if
211  
204    
205    if(allocated(SCTypeList)) deallocate(SCTypeList)
212  
207
208
213    end subroutine destroySCTypes
214  
215  
216  
217    function getSCCut(atomID) result(cutValue)
218      integer, intent(in) :: atomID
219 <    integer :: eamID
219 >    integer :: scID
220      real(kind=dp) :: cutValue
221      
222 <    eamID = EAMList%atidToEAMType(atomID)
223 <    cutValue = EAMList%EAMParams(eamID)%eam_rcut
222 >    scID = SCList%atidToSCType(atomID)
223 >    cutValue = SCList%SCTypes(scID)%sc_rcut
224    end function getSCCut
225  
226  
# Line 254 | Line 258 | contains
258            n2 = SCList%SCtypes(j)%n
259            alpha2 = SCList%SCtypes(j)%alpha
260  
261 <          MixingMap(i,j)%epsilon = dsqrt(e1 * e2)
261 >          if (useGeometricDistanceMixing) then
262 >             MixingMap(i,j)%alpha = sqrt(alpha1 * alpha2) !SC formulation
263 >          else
264 >             MixingMap(i,j)%alpha = 0.5_dp * (alpha1 + alpha2) ! Goddard formulation
265 >          endif
266 >
267 >          MixingMap(i,j)%epsilon = sqrt(e1 * e2)
268            MixingMap(i,j)%m = 0.5_dp*(m1+m2)
269            MixingMap(i,j)%n = 0.5_dp*(n1+n2)
270            MixingMap(i,j)%alpha = 0.5_dp*(alpha1+alpha2)
271            MixingMap(i,j)%rcut = 2.0_dp *MixingMap(i,j)%alpha
272 <          MixingMap(i,j)%vpair_rcut = MixingMap%epsilon(i,j)* &
273 <               (MixingMap%alpha(i,j)/MixingMap(i,j)%rcut)**MixingMap(i,j)%n
274 <
272 >          MixingMap(i,j)%vpair_pot = MixingMap(i,j)%epsilon* &
273 >               (MixingMap(i,j)%alpha/MixingMap(i,j)%rcut)**MixingMap(i,j)%n
274 >          if (i.ne.j) then
275 >             MixingMap(j,i)%epsilon    = MixingMap(i,j)%epsilon
276 >             MixingMap(j,i)%m          = MixingMap(i,j)%m
277 >             MixingMap(j,i)%n          = MixingMap(i,j)%n
278 >             MixingMap(j,i)%alpha      = MixingMap(i,j)%alpha
279 >             MixingMap(j,i)%rcut = MixingMap(i,j)%rcut
280 >             MixingMap(j,i)%vpair_pot = MixingMap(i,j)%vpair_pot
281 >          endif
282         enddo
283      enddo
284      
# Line 311 | Line 328 | contains
328         return
329      end if
330  
314    if (allocated(d2frhodrhodrho)) deallocate(d2frhodrhodrho)
315    allocate(d2frhodrhodrho(nlocal),stat=alloc_stat)
316    if (alloc_stat /= 0) then
317       status = -1
318       return
319    end if
320
331   #ifdef IS_MPI
332  
333      if (allocated(rho_tmp)) deallocate(rho_tmp)
# Line 346 | Line 356 | contains
356         status = -1
357         return
358      end if
349    if (allocated(d2frhodrhodrho_row)) deallocate(d2frhodrhodrho_row)
350    allocate(d2frhodrhodrho_row(nAtomsInRow),stat=alloc_stat)
351    if (alloc_stat /= 0) then
352       status = -1
353       return
354    end if
359  
360  
361      ! Now do column arrays
# Line 374 | Line 378 | contains
378         status = -1
379         return
380      end if
377    if (allocated(d2frhodrhodrho_col)) deallocate(d2frhodrhodrho_col)
378    allocate(d2frhodrhodrho_col(nAtomsInCol),stat=alloc_stat)
379    if (alloc_stat /= 0) then
380       status = -1
381       return
382    end if
381  
382   #endif
383  
# Line 397 | Line 395 | contains
395  
396    end subroutine setCutoffSC
397  
398 +  subroutine useGeometricMixing()
399 +    useGeometricDistanceMixing = .true.
400 +    haveMixingMap = .false.
401 +    return
402 +  end subroutine useGeometricMixing
403 +  
404  
405  
406 <  subroutine clean_EAM()
406 >
407  
408 +
409 +
410 +
411 +
412 +  subroutine clean_SC()
413 +
414      ! clean non-IS_MPI first
415      frho = 0.0_dp
416      rho  = 0.0_dp
# Line 415 | Line 425 | contains
425      dfrhodrho_row = 0.0_dp
426      dfrhodrho_col = 0.0_dp
427   #endif
428 <  end subroutine clean_EAM
428 >  end subroutine clean_SC
429  
430  
431  
# Line 431 | Line 441 | contains
441      real(kind = dp) :: rho_j_at_i
442  
443      ! we don't use the derivatives, dummy variables
444 <    real( kind = dp) :: drho,d2rho
445 <    integer :: eam_err
444 >    real( kind = dp) :: drho
445 >    integer :: sc_err
446      
447      integer :: atid1,atid2 ! Global atid    
448      integer :: myid_atom1 ! EAM atid
# Line 452 | Line 462 | contains
462      Atid2 = Atid(Atom2)
463   #endif
464  
465 <    Myid_atom1 = SCTypeList%atidtoSCtype(Atid1)
466 <    Myid_atom2 = SCTypeList%atidtoSCtype(Atid2)
465 >    Myid_atom1 = SCList%atidtoSCtype(Atid1)
466 >    Myid_atom2 = SCList%atidtoSCtype(Atid2)
467  
468  
469  
# Line 469 | Line 479 | contains
479         rho(atom1) = rho(atom1) + rho_j_at_i
480   #endif
481  
472
473
482    end subroutine calc_sc_prepair_rho
483  
484  
485 < !! Calculate the functional F(rho) for all local atoms
486 <  subroutine calc_eam_preforce_Frho(nlocal,pot)
485 > !! Calculate the rho_a for all local atoms
486 >  subroutine calc_sc_preforce_Frho(nlocal,pot)
487      integer :: nlocal
488      real(kind=dp) :: pot
489      integer :: i,j
490      integer :: atom
491      real(kind=dp) :: U,U1,U2
492      integer :: atype1
493 <    integer :: me,atid1
494 <    integer :: n_rho_points
493 >    integer :: atid1
494 >    integer :: myid
495  
496  
497      cleanme = .true.
498      !! Scatter the electron density from  pre-pair calculation back to local atoms
499   #ifdef IS_MPI
500 <    call scatter(rho_row,rho,plan_atom_row,eam_err)
501 <    if (eam_err /= 0 ) then
500 >    call scatter(rho_row,rho,plan_atom_row,sc_err)
501 >    if (sc_err /= 0 ) then
502         write(errMsg,*) " Error scattering rho_row into rho"
503         call handleError(RoutineName,errMesg)
504      endif
505 <    call scatter(rho_col,rho_tmp,plan_atom_col,eam_err)
506 <    if (eam_err /= 0 ) then
505 >    call scatter(rho_col,rho_tmp,plan_atom_col,sc_err)
506 >    if (sc_err /= 0 ) then
507         write(errMsg,*) " Error scattering rho_col into rho"
508         call handleError(RoutineName,errMesg)
509  
# Line 508 | Line 516 | contains
516  
517      !! Calculate F(rho) and derivative
518      do atom = 1, nlocal
519 <       Myid = ScTypeList%atidtoSctype(Atid(atom))
520 <       frho(atom) = -MixingMap(Myid,Myid)%c * MixingMap(Myid,Myid)%epsilon &
521 <            * sqrt(rho(i))
519 >       Myid = SCList%atidtoSctype(Atid(atom))
520 >       frho(atom) = -SCList%SCTypes(Myid)%c * &
521 >            SCList%SCTypes(Myid)%epsilon * sqrt(rho(i))
522 >
523         dfrhodrho(atom) = 0.5_dp*frho(atom)/rho(atom)
515       d2frhodrhodrho(atom) = -0.5_dp*dfrhodrho(atom)/rho(atom)
524         pot = pot + u
525      enddo
526  
527 <    #ifdef IS_MPI
527 > #ifdef IS_MPI
528      !! communicate f(rho) and derivatives back into row and column arrays
529 <    call gather(frho,frho_row,plan_atom_row, eam_err)
530 <    if (eam_err /=  0) then
529 >    call gather(frho,frho_row,plan_atom_row, sc_err)
530 >    if (sc_err /=  0) then
531         call handleError("cal_eam_forces()","MPI gather frho_row failure")
532      endif
533 <    call gather(dfrhodrho,dfrhodrho_row,plan_atom_row, eam_err)
534 <    if (eam_err /=  0) then
533 >    call gather(dfrhodrho,dfrhodrho_row,plan_atom_row, sc_err)
534 >    if (sc_err /=  0) then
535         call handleError("cal_eam_forces()","MPI gather dfrhodrho_row failure")
536      endif
537 <    call gather(frho,frho_col,plan_atom_col, eam_err)
538 <    if (eam_err /=  0) then
537 >    call gather(frho,frho_col,plan_atom_col, sc_err)
538 >    if (sc_err /=  0) then
539         call handleError("cal_eam_forces()","MPI gather frho_col failure")
540      endif
541 <    call gather(dfrhodrho,dfrhodrho_col,plan_atom_col, eam_err)
542 <    if (eam_err /=  0) then
541 >    call gather(dfrhodrho,dfrhodrho_col,plan_atom_col, sc_err)
542 >    if (sc_err /=  0) then
543         call handleError("cal_eam_forces()","MPI gather dfrhodrho_col failure")
544      endif
537
538    if (nmflag) then
539       call gather(d2frhodrhodrho,d2frhodrhodrho_row,plan_atom_row)
540       call gather(d2frhodrhodrho,d2frhodrhodrho_col,plan_atom_col)
541    endif
545   #endif
546      
547      
548 <  end subroutine calc_eam_preforce_Frho
548 >  end subroutine calc_sc_preforce_Frho
549  
550  
551    !! Does Sutton-Chen  pairwise Force calculation.  
552 <  subroutine do_eam_pair(atom1, atom2, d, rij, r2, sw, vpair, fpair, &
552 >  subroutine do_sc_pair(atom1, atom2, d, rij, r2, sw, vpair, fpair, &
553         pot, f, do_pot)
554      !Arguments    
555      integer, intent(in) ::  atom1, atom2
# Line 559 | Line 562 | contains
562      logical, intent(in) :: do_pot
563  
564      real( kind = dp ) :: drdx,drdy,drdz
565 <    real( kind = dp ) :: d2
566 <    real( kind = dp ) :: phab,pha,dvpdr,d2vpdrdr
564 <    real( kind = dp ) :: rha,drha,d2rha, dpha
565 <    real( kind = dp ) :: rhb,drhb,d2rhb, dphb
565 >    real( kind = dp ) :: dvpdr
566 >    real( kind = dp ) :: drhodr
567      real( kind = dp ) :: dudr
568 <    real( kind = dp ) :: rci,rcj
568 >    real( kind = dp ) :: rcij
569      real( kind = dp ) :: drhoidr,drhojdr
569    real( kind = dp ) :: d2rhoidrdr
570    real( kind = dp ) :: d2rhojdrdr
570      real( kind = dp ) :: Fx,Fy,Fz
571      real( kind = dp ) :: r,d2pha,phb,d2phb
572 <
572 >    real( kind = dp ) :: pot_temp,vptmp
573 >    real( kind = dp ) :: epsilonij,aij,nij,mij,vcij
574      integer :: id1,id2
575      integer  :: mytype_atom1
576      integer  :: mytype_atom2
# Line 579 | Line 579 | contains
579  
580      ! write(*,*) "Frho: ", Frho(atom1)
581  
582 <    phab = 0.0E0_DP
582 >
583      dvpdr = 0.0E0_DP
584    d2vpdrdr = 0.0E0_DP
584  
586    if (rij .lt. EAM_rcut) then
585  
586   #ifdef IS_MPI
587         atid1 = atid_row(atom1)
# Line 593 | Line 591 | contains
591         atid2 = atid(atom2)
592   #endif
593  
594 <       mytype_atom1 = EAMList%atidToEAMType(atid1)
595 <       mytype_atom2 = EAMList%atidTOEAMType(atid2)
594 >       mytype_atom1 = SCList%atidToSCType(atid1)
595 >       mytype_atom2 = SCList%atidTOSCType(atid2)
596  
599
600       ! get cutoff for atom 1
601       rci = EAMList%EAMParams(mytype_atom1)%eam_rcut
602       ! get type specific cutoff for atom 2
603       rcj = EAMList%EAMParams(mytype_atom2)%eam_rcut
604
597         drdx = d(1)/rij
598         drdy = d(2)/rij
599         drdz = d(3)/rij
600  
601 <       if (rij.lt.rci) then
602 <          call eam_splint(EAMList%EAMParams(mytype_atom1)%eam_nr, &
603 <               EAMList%EAMParams(mytype_atom1)%eam_rvals, &
604 <               EAMList%EAMParams(mytype_atom1)%eam_rho_r, &
605 <               EAMList%EAMParams(mytype_atom1)%eam_rho_r_pp, &
606 <               rij, rha,drha,d2rha)
615 <          !! Calculate Phi(r) for atom1.
616 <          call eam_splint(EAMList%EAMParams(mytype_atom1)%eam_nr, &
617 <               EAMList%EAMParams(mytype_atom1)%eam_rvals, &
618 <               EAMList%EAMParams(mytype_atom1)%eam_phi_r, &
619 <               EAMList%EAMParams(mytype_atom1)%eam_phi_r_pp, &
620 <               rij, pha,dpha,d2pha)
621 <       endif
601 >                
602 >       epsilonij = MixingMap(mytype_atom1,mytype_atom2)%epsilon
603 >       aij       = MixingMap(mytype_atom1,mytype_atom2)%alpha
604 >       nij       = MixingMap(mytype_atom1,mytype_atom2)%n
605 >       mij       = MixingMap(mytype_atom1,mytype_atom2)%m
606 >       vcij      = MixingMap(mytype_atom1,mytype_atom2)%vpair_pot              
607  
608 <       if (rij.lt.rcj) then      
624 <          ! Calculate rho,drho and d2rho for atom1
625 <          call eam_splint(EAMList%EAMParams(mytype_atom2)%eam_nr, &
626 <               EAMList%EAMParams(mytype_atom2)%eam_rvals, &
627 <               EAMList%EAMParams(mytype_atom2)%eam_rho_r, &
628 <               EAMList%EAMParams(mytype_atom2)%eam_rho_r_pp, &
629 <               rij, rhb,drhb,d2rhb)
608 >       vptmp = epsilonij*((aij/r)**nij)
609  
631          !! Calculate Phi(r) for atom2.
632          call eam_splint(EAMList%EAMParams(mytype_atom2)%eam_nr, &
633               EAMList%EAMParams(mytype_atom2)%eam_rvals, &
634               EAMList%EAMParams(mytype_atom2)%eam_phi_r, &
635               EAMList%EAMParams(mytype_atom2)%eam_phi_r_pp, &
636               rij, phb,dphb,d2phb)
637       endif
610  
611 <       if (rij.lt.rci) then
612 <          phab = phab + 0.5E0_DP*(rhb/rha)*pha
641 <          dvpdr = dvpdr + 0.5E0_DP*((rhb/rha)*dpha + &
642 <               pha*((drhb/rha) - (rhb*drha/rha/rha)))
643 <          d2vpdrdr = d2vpdrdr + 0.5E0_DP*((rhb/rha)*d2pha + &
644 <               2.0E0_DP*dpha*((drhb/rha) - (rhb*drha/rha/rha)) + &
645 <               pha*((d2rhb/rha) - 2.0E0_DP*(drhb*drha/rha/rha) + &
646 <               (2.0E0_DP*rhb*drha*drha/rha/rha/rha) - (rhb*d2rha/rha/rha)))
647 <       endif
611 >       dvpdr = -nij*vptmp/r
612 >       drhodr = -mij*((aij/r)**mij)/r
613  
614 <       if (rij.lt.rcj) then
615 <          phab = phab + 0.5E0_DP*(rha/rhb)*phb
616 <          dvpdr = dvpdr + 0.5E0_DP*((rha/rhb)*dphb + &
617 <               phb*((drha/rhb) - (rha*drhb/rhb/rhb)))
618 <          d2vpdrdr = d2vpdrdr + 0.5E0_DP*((rha/rhb)*d2phb + &
619 <               2.0E0_DP*dphb*((drha/rhb) - (rha*drhb/rhb/rhb)) + &
655 <               phb*((d2rha/rhb) - 2.0E0_DP*(drha*drhb/rhb/rhb) + &
656 <               (2.0E0_DP*rha*drhb*drhb/rhb/rhb/rhb) - (rha*d2rhb/rhb/rhb)))
657 <       endif
614 >      
615 >       dudr = drhodr*(dfrhodrho(atom1)+dfrhodrho(atom2)) &
616 >            + dvpdr
617 >      
618 >       pot_temp = vptmp + vcij
619 >
620  
659       drhoidr = drha
660       drhojdr = drhb
661
662       d2rhoidrdr = d2rha
663       d2rhojdrdr = d2rhb
664
665
621   #ifdef IS_MPI
622 <       dudr = drhojdr*dfrhodrho_row(atom1)+drhoidr*dfrhodrho_col(atom2) &
622 >       dudr = drhodr*(dfrhodrho_row(atom1)+dfrhodrho_col(atom2)) &
623              + dvpdr
624  
625   #else
626 <       dudr = drhojdr*dfrhodrho(atom1)+drhoidr*dfrhodrho(atom2) &
626 >       dudr = drhodr*(dfrhodrho(atom1)+dfrhodrho(atom2)) &
627              + dvpdr
673       ! write(*,*) "Atom1,Atom2, dfrhodrho(atom1) dfrhodrho(atom2): ", atom1,atom2,dfrhodrho(atom1),dfrhodrho(atom2)
628   #endif
629  
630 +
631         fx = dudr * drdx
632         fy = dudr * drdy
633         fz = dudr * drdz
# Line 680 | Line 635 | contains
635  
636   #ifdef IS_MPI
637         if (do_pot) then
638 <          pot_Row(METALLIC_POT,atom1) = pot_Row(METALLIC_POT,atom1) + phab*0.5
639 <          pot_Col(METALLIC_POT,atom2) = pot_Col(METALLIC_POT,atom2) + phab*0.5
638 >          pot_Row(METALLIC_POT,atom1) = pot_Row(METALLIC_POT,atom1) + (pot_temp)*0.5
639 >          pot_Col(METALLIC_POT,atom2) = pot_Col(METALLIC_POT,atom2) + (pot_temp)*0.5
640         end if
641  
642         f_Row(1,atom1) = f_Row(1,atom1) + fx
# Line 694 | Line 649 | contains
649   #else
650  
651         if(do_pot) then
652 <          pot = pot + phab
652 >          pot = pot + pot_temp
653         end if
654  
655         f(1,atom1) = f(1,atom1) + fx
# Line 706 | Line 661 | contains
661         f(3,atom2) = f(3,atom2) - fz
662   #endif
663  
664 <       vpair = vpair + phab
664 >      
665   #ifdef IS_MPI
666         id1 = AtomRowToGlobal(atom1)
667         id2 = AtomColToGlobal(atom2)
# Line 723 | Line 678 | contains
678  
679         endif
680  
726       if (nmflag) then
681  
682 <          drhoidr = drha
729 <          drhojdr = drhb
730 <          d2rhoidrdr = d2rha
731 <          d2rhojdrdr = d2rhb
682 >  end subroutine do_sc_pair
683  
733 #ifdef IS_MPI
734          d2 = d2vpdrdr + &
735               d2rhoidrdr*dfrhodrho_col(atom2) + &
736               d2rhojdrdr*dfrhodrho_row(atom1) + &
737               drhoidr*drhoidr*d2frhodrhodrho_col(atom2) + &
738               drhojdr*drhojdr*d2frhodrhodrho_row(atom1)
684  
740 #else
685  
742          d2 = d2vpdrdr + &
743               d2rhoidrdr*dfrhodrho(atom2) + &
744               d2rhojdrdr*dfrhodrho(atom1) + &
745               drhoidr*drhoidr*d2frhodrhodrho(atom2) + &
746               drhojdr*drhojdr*d2frhodrhodrho(atom1)
747 #endif
748       end if
749
750    endif
751  end subroutine do_eam_pair
752
753
754
686   end module suttonchen

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines