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 2413 by chuckv, Thu Nov 3 23:06:00 2005 UTC vs.
Revision 2434 by chuckv, Tue Nov 15 16:18:36 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 :: sc_err
74  
# 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
142    public :: calc_SC_prepair_rho
143 +  public :: calc_SC_preforce_Frho
144    public :: clean_SC
145    public :: destroySCtypes
146    public :: getSCCut
147 <  public :: setSCDefaultCutoff
148 <  public :: setSCUniformCutoff
147 > ! public :: setSCDefaultCutoff
148 > ! public :: setSCUniformCutoff
149 >  public :: useGeometricMixing
150  
151   contains
152  
153  
154 <  subroutine newSCtype(c,m,n,alpha,epsilon,c_ident,status)
155 <    real (kind = dp )                      :: lattice_constant
156 <    integer                                :: eam_nrho
157 <    real (kind = dp )                      :: eam_drho
158 <    integer                                :: eam_nr
159 <    real (kind = dp )                      :: eam_dr
160 <    real (kind = dp )                      :: rcut
161 <    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
154 >  subroutine newSCtype(c_ident,c,m,n,alpha,epsilon,status)
155 >    real (kind = dp )                      :: c ! Density Scaling
156 >    real (kind = dp )                      :: m ! Density Exponent
157 >    real (kind = dp )                      :: n ! Pair Potential Exponent
158 >    real (kind = dp )                      :: alpha ! Length Scaling
159 >    real (kind = dp )                      :: epsilon ! Energy Scaling
160 >
161 >
162      integer                                :: c_ident
163      integer                                :: status
164  
# Line 170 | Line 172 | contains
172  
173  
174      !! 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.
175  
176  
177      ! check to see if this is the first time into
178 <    if (.not.associated(SCTypeList%EAMParams)) then
178 >    if (.not.associated(SCList%SCTypes)) then
179         call getMatchingElementList(atypes, "is_SuttonChen", .true., nSCtypes, MatchList)
180 <       SCTypeList%nSCtypes = nSCtypes
181 <       allocate(SCTypeList%SCTypes(nSCTypes))
180 >       SCList%nSCtypes = nSCtypes
181 >       allocate(SCList%SCTypes(nSCTypes))
182         nAtypes = getSize(atypes)
183 <       allocate(SCTypeList%atidToSCType(nAtypes))
183 >       allocate(SCList%atidToSCType(nAtypes))
184      end if
185  
186 <    SCTypeList%currentSCType = SCTypeList%currentSCType + 1
187 <    current = SCTypeList%currentSCType
186 >    SCList%currentSCType = SCList%currentSCType + 1
187 >    current = SCList%currentSCType
188  
189      myATID =  getFirstMatchingElement(atypes, "c_ident", c_ident)
190 <    SCTypeList%atidToSCType(myATID) = current
190 >    SCList%atidToSCType(myATID) = current
191  
192  
193    
194 <    SCTypeList%SCTypes(current)%atid         = c_ident
195 <    SCTypeList%SCTypes(current)%alpha        = alpha
196 <    SCTypeList%SCTypes(current)%c            = c
197 <    SCTypeList%SCTypes(current)%m            = m
198 <    SCTypeList%SCTypes(current)%n            = n
199 <    SCTypeList%SCTypes(current)%epsilon      = epsilon
194 >    SCList%SCTypes(current)%atid         = c_ident
195 >    SCList%SCTypes(current)%alpha        = alpha
196 >    SCList%SCTypes(current)%c            = c
197 >    SCList%SCTypes(current)%m            = m
198 >    SCList%SCTypes(current)%n            = n
199 >    SCList%SCTypes(current)%epsilon      = epsilon
200    end subroutine newSCtype
201  
202    
203    subroutine destroySCTypes()
204 +    if (associated(SCList%SCtypes)) then
205 +       deallocate(SCList%SCTypes)
206 +       SCList%SCTypes=>null()
207 +    end if
208 +    if (associated(SCList%atidToSCtype)) then
209 +       deallocate(SCList%atidToSCtype)
210 +       SCList%atidToSCtype=>null()
211 +    end if
212  
204    
205    if(allocated(SCTypeList)) deallocate(SCTypeList)
213  
207
208
214    end subroutine destroySCTypes
215  
216  
217  
218    function getSCCut(atomID) result(cutValue)
219      integer, intent(in) :: atomID
220 <    integer :: eamID
220 >    integer :: scID
221      real(kind=dp) :: cutValue
222      
223 <    eamID = SCTypeList%atidToEAMType(atomID)
224 <    cutValue = SCTypeList%EAMParams(eamID)%eam_rcut
223 >    scID = SCList%atidToSCType(atomID)
224 >    cutValue = SCList%SCTypes(scID)%sc_rcut
225    end function getSCCut
226  
227  
# Line 254 | Line 259 | contains
259            n2 = SCList%SCtypes(j)%n
260            alpha2 = SCList%SCtypes(j)%alpha
261  
262 <          MixingMap(i,j)%epsilon = dsqrt(e1 * e2)
262 >          if (useGeometricDistanceMixing) then
263 >             MixingMap(i,j)%alpha = sqrt(alpha1 * alpha2) !SC formulation
264 >          else
265 >             MixingMap(i,j)%alpha = 0.5_dp * (alpha1 + alpha2) ! Goddard formulation
266 >          endif
267 >
268 >          MixingMap(i,j)%epsilon = sqrt(e1 * e2)
269            MixingMap(i,j)%m = 0.5_dp*(m1+m2)
270            MixingMap(i,j)%n = 0.5_dp*(n1+n2)
271            MixingMap(i,j)%alpha = 0.5_dp*(alpha1+alpha2)
272            MixingMap(i,j)%rcut = 2.0_dp *MixingMap(i,j)%alpha
273 <          MixingMap(i,j)%vpair_rcut = MixingMap%epsilon(i,j)* &
274 <               (MixingMap%alpha(i,j)/MixingMap(i,j)%rcut)**MixingMap(i,j)%n
275 <
273 >          MixingMap(i,j)%vpair_pot = MixingMap(i,j)%epsilon* &
274 >               (MixingMap(i,j)%alpha/MixingMap(i,j)%rcut)**MixingMap(i,j)%n
275 >          if (i.ne.j) then
276 >             MixingMap(j,i)%epsilon    = MixingMap(i,j)%epsilon
277 >             MixingMap(j,i)%m          = MixingMap(i,j)%m
278 >             MixingMap(j,i)%n          = MixingMap(i,j)%n
279 >             MixingMap(j,i)%alpha      = MixingMap(i,j)%alpha
280 >             MixingMap(j,i)%rcut = MixingMap(i,j)%rcut
281 >             MixingMap(j,i)%vpair_pot = MixingMap(i,j)%vpair_pot
282 >          endif
283         enddo
284      enddo
285      
# Line 311 | Line 329 | contains
329         return
330      end if
331  
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
332   #ifdef IS_MPI
333  
334      if (allocated(rho_tmp)) deallocate(rho_tmp)
# Line 346 | Line 357 | contains
357         status = -1
358         return
359      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
360  
361  
362      ! Now do column arrays
# Line 374 | Line 379 | contains
379         status = -1
380         return
381      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
382  
383   #endif
384  
# Line 397 | Line 396 | contains
396  
397    end subroutine setCutoffSC
398  
399 +  subroutine useGeometricMixing()
400 +    useGeometricDistanceMixing = .true.
401 +    haveMixingMap = .false.
402 +    return
403 +  end subroutine useGeometricMixing
404 +  
405  
406  
402  subroutine clean_EAM()
407  
408 +
409 +
410 +
411 +
412 +
413 +  subroutine clean_SC()
414 +
415      ! clean non-IS_MPI first
416      frho = 0.0_dp
417      rho  = 0.0_dp
# Line 415 | Line 426 | contains
426      dfrhodrho_row = 0.0_dp
427      dfrhodrho_col = 0.0_dp
428   #endif
429 <  end subroutine clean_EAM
429 >  end subroutine clean_SC
430  
431  
432  
# Line 431 | Line 442 | contains
442      real(kind = dp) :: rho_j_at_i
443  
444      ! we don't use the derivatives, dummy variables
445 <    real( kind = dp) :: drho,d2rho
445 >    real( kind = dp) :: drho
446      integer :: sc_err
447      
448      integer :: atid1,atid2 ! Global atid    
# Line 452 | Line 463 | contains
463      Atid2 = Atid(Atom2)
464   #endif
465  
466 <    Myid_atom1 = SCTypeList%atidtoSCtype(Atid1)
467 <    Myid_atom2 = SCTypeList%atidtoSCtype(Atid2)
466 >    Myid_atom1 = SCList%atidtoSCtype(Atid1)
467 >    Myid_atom2 = SCList%atidtoSCtype(Atid2)
468  
469  
470  
# Line 473 | Line 484 | contains
484  
485  
486   !! Calculate the rho_a for all local atoms
487 <  subroutine calc_eam_preforce_Frho(nlocal,pot)
487 >  subroutine calc_sc_preforce_Frho(nlocal,pot)
488      integer :: nlocal
489      real(kind=dp) :: pot
490      integer :: i,j
491      integer :: atom
492      real(kind=dp) :: U,U1,U2
493      integer :: atype1
494 <    integer :: me,atid1
495 <    integer :: n_rho_points
494 >    integer :: atid1
495 >    integer :: myid
496  
497  
498      cleanme = .true.
# Line 506 | Line 517 | contains
517  
518      !! Calculate F(rho) and derivative
519      do atom = 1, nlocal
520 <       Myid = ScTypeList%atidtoSctype(Atid(atom))
521 <       frho(atom) = -MixingMap(Myid,Myid)%c * MixingMap(Myid,Myid)%epsilon &
522 <            * sqrt(rho(i))
520 >       Myid = SCList%atidtoSctype(Atid(atom))
521 >       frho(atom) = -SCList%SCTypes(Myid)%c * &
522 >            SCList%SCTypes(Myid)%epsilon * sqrt(rho(i))
523 >
524         dfrhodrho(atom) = 0.5_dp*frho(atom)/rho(atom)
513       d2frhodrhodrho(atom) = -0.5_dp*dfrhodrho(atom)/rho(atom)
525         pot = pot + u
526      enddo
527  
528 <    #ifdef IS_MPI
528 > #ifdef IS_MPI
529      !! communicate f(rho) and derivatives back into row and column arrays
530      call gather(frho,frho_row,plan_atom_row, sc_err)
531      if (sc_err /=  0) then
# Line 532 | Line 543 | contains
543      if (sc_err /=  0) then
544         call handleError("cal_eam_forces()","MPI gather dfrhodrho_col failure")
545      endif
535
536    if (nmflag) then
537       call gather(d2frhodrhodrho,d2frhodrhodrho_row,plan_atom_row)
538       call gather(d2frhodrhodrho,d2frhodrhodrho_col,plan_atom_col)
539    endif
546   #endif
547      
548      
549 <  end subroutine calc_eam_preforce_Frho
549 >  end subroutine calc_sc_preforce_Frho
550  
551  
552    !! Does Sutton-Chen  pairwise Force calculation.  
553 <  subroutine do_eam_pair(atom1, atom2, d, rij, r2, sw, vpair, fpair, &
553 >  subroutine do_sc_pair(atom1, atom2, d, rij, r2, sw, vpair, fpair, &
554         pot, f, do_pot)
555      !Arguments    
556      integer, intent(in) ::  atom1, atom2
# Line 557 | Line 563 | contains
563      logical, intent(in) :: do_pot
564  
565      real( kind = dp ) :: drdx,drdy,drdz
566 <    real( kind = dp ) :: d2
567 <    real( kind = dp ) :: phab,pha,dvpdr,d2vpdrdr
562 <    real( kind = dp ) :: rha,drha,d2rha, dpha
563 <    real( kind = dp ) :: rhb,drhb,d2rhb, dphb
566 >    real( kind = dp ) :: dvpdr
567 >    real( kind = dp ) :: drhodr
568      real( kind = dp ) :: dudr
569      real( kind = dp ) :: rcij
570      real( kind = dp ) :: drhoidr,drhojdr
567    real( kind = dp ) :: d2rhoidrdr
568    real( kind = dp ) :: d2rhojdrdr
571      real( kind = dp ) :: Fx,Fy,Fz
572      real( kind = dp ) :: r,d2pha,phb,d2phb
573 <
573 >    real( kind = dp ) :: pot_temp,vptmp
574 >    real( kind = dp ) :: epsilonij,aij,nij,mij,vcij
575      integer :: id1,id2
576      integer  :: mytype_atom1
577      integer  :: mytype_atom2
# Line 577 | Line 580 | contains
580  
581      ! write(*,*) "Frho: ", Frho(atom1)
582  
583 <    phab = 0.0E0_DP
583 >
584      dvpdr = 0.0E0_DP
582    d2vpdrdr = 0.0E0_DP
585  
586  
587   #ifdef IS_MPI
# Line 590 | Line 592 | contains
592         atid2 = atid(atom2)
593   #endif
594  
595 <       mytype_atom1 = SCTypeList%atidToSCType(atid1)
596 <       mytype_atom2 = SCTypeList%atidTOSCType(atid2)
595 >       mytype_atom1 = SCList%atidToSCType(atid1)
596 >       mytype_atom2 = SCList%atidTOSCType(atid2)
597  
598         drdx = d(1)/rij
599         drdy = d(2)/rij
# Line 604 | Line 606 | contains
606         mij       = MixingMap(mytype_atom1,mytype_atom2)%m
607         vcij      = MixingMap(mytype_atom1,mytype_atom2)%vpair_pot              
608  
609 <       vptmp = dij*((aij/r)**nij)
609 >       vptmp = epsilonij*((aij/r)**nij)
610  
611  
612         dvpdr = -nij*vptmp/r
611       d2vpdrdr = -dvpdr*(nij+1.0d0)/r
612      
613         drhodr = -mij*((aij/r)**mij)/r
614 <       d2rhodrdr = -drhodr*(mij+1.0d0)/r
614 >
615        
616 <       dudr = drhodr*(dfrhodrho(i)+dfrhodrho(j)) &
616 >       dudr = drhodr*(dfrhodrho(atom1)+dfrhodrho(atom2)) &
617              + dvpdr
618 +      
619 +       pot_temp = vptmp + vcij
620  
619
621  
622   #ifdef IS_MPI
623         dudr = drhodr*(dfrhodrho_row(atom1)+dfrhodrho_col(atom2)) &
# Line 635 | Line 636 | contains
636  
637   #ifdef IS_MPI
638         if (do_pot) then
639 <          pot_Row(METALLIC_POT,atom1) = pot_Row(METALLIC_POT,atom1) + phab*0.5
640 <          pot_Col(METALLIC_POT,atom2) = pot_Col(METALLIC_POT,atom2) + phab*0.5
639 >          pot_Row(METALLIC_POT,atom1) = pot_Row(METALLIC_POT,atom1) + (pot_temp)*0.5
640 >          pot_Col(METALLIC_POT,atom2) = pot_Col(METALLIC_POT,atom2) + (pot_temp)*0.5
641         end if
642  
643         f_Row(1,atom1) = f_Row(1,atom1) + fx
# Line 649 | Line 650 | contains
650   #else
651  
652         if(do_pot) then
653 <          pot = pot + phab
653 >          pot = pot + pot_temp
654         end if
655  
656         f(1,atom1) = f(1,atom1) + fx
# Line 661 | Line 662 | contains
662         f(3,atom2) = f(3,atom2) - fz
663   #endif
664  
665 <       vpair = vpair + phab
665 >      
666   #ifdef IS_MPI
667         id1 = AtomRowToGlobal(atom1)
668         id2 = AtomColToGlobal(atom2)
# Line 678 | Line 679 | contains
679  
680         endif
681  
681       if (nmflag) then
682  
683 <          drhoidr = drha
684 <          drhojdr = drhb
685 <          d2rhoidrdr = d2rha
686 <          d2rhojdrdr = d2rhb
683 >  end subroutine do_sc_pair
684  
688 #ifdef IS_MPI
689          d2 = d2vpdrdr + &
690               d2rhoidrdr*dfrhodrho_col(atom2) + &
691               d2rhojdrdr*dfrhodrho_row(atom1) + &
692               drhoidr*drhoidr*d2frhodrhodrho_col(atom2) + &
693               drhojdr*drhojdr*d2frhodrhodrho_row(atom1)
685  
695 #else
686  
697          d2 = d2vpdrdr + &
698               d2rhoidrdr*dfrhodrho(atom2) + &
699               d2rhojdrdr*dfrhodrho(atom1) + &
700               drhoidr*drhoidr*d2frhodrhodrho(atom2) + &
701               drhojdr*drhojdr*d2frhodrhodrho(atom1)
702 #endif
703       end if
704
705    endif
706  end subroutine do_eam_pair
707
708
709
687   end module suttonchen

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines