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

Comparing trunk/OOPSE-4/src/UseTheForce/doForces.F90 (file contents):
Revision 2317 by chrisfen, Wed Sep 21 17:20:14 2005 UTC vs.
Revision 2411 by chrisfen, Wed Nov 2 21:01:21 2005 UTC

# Line 45 | Line 45
45  
46   !! @author Charles F. Vardeman II
47   !! @author Matthew Meineke
48 < !! @version $Id: doForces.F90,v 1.48 2005-09-21 17:20:10 chrisfen Exp $, $Date: 2005-09-21 17:20:10 $, $Name: not supported by cvs2svn $, $Revision: 1.48 $
48 > !! @version $Id: doForces.F90,v 1.67 2005-11-02 21:01:18 chrisfen Exp $, $Date: 2005-11-02 21:01:18 $, $Name: not supported by cvs2svn $, $Revision: 1.67 $
49  
50  
51   module doForces
# Line 58 | Line 58 | module doForces
58    use lj
59    use sticky
60    use electrostatic_module
61 <  use reaction_field_module
62 <  use gb_pair
61 >  use gayberne
62    use shapes
63    use vector_class
64    use eam
# Line 124 | Line 123 | module doForces
123    ! Bit hash to determine pair-pair interactions.
124    integer, dimension(:,:), allocatable :: InteractionHash
125    real(kind=dp), dimension(:), allocatable :: atypeMaxCutoff
126 <  real(kind=dp), dimension(:), allocatable :: groupMaxCutoff
127 <  integer, dimension(:), allocatable :: groupToGtype
128 <  real(kind=dp), dimension(:), allocatable :: gtypeMaxCutoff
126 >  real(kind=dp), dimension(:), allocatable, target :: groupMaxCutoffRow
127 >  real(kind=dp), dimension(:), pointer :: groupMaxCutoffCol
128 >
129 >  integer, dimension(:), allocatable, target :: groupToGtypeRow
130 >  integer, dimension(:), pointer :: groupToGtypeCol => null()
131 >
132 >  real(kind=dp), dimension(:), allocatable,target :: gtypeMaxCutoffRow
133 >  real(kind=dp), dimension(:), pointer :: gtypeMaxCutoffCol
134    type ::gtypeCutoffs
135       real(kind=dp) :: rcut
136       real(kind=dp) :: rcutsq
# Line 136 | Line 140 | module doForces
140  
141    integer, save :: cutoffPolicy = TRADITIONAL_CUTOFF_POLICY
142    real(kind=dp),save :: defaultRcut, defaultRsw, defaultRlist
143 +  real(kind=dp),save :: listSkin
144    
145   contains
146  
# Line 179 | Line 184 | contains
184  
185      if (.not. allocated(InteractionHash)) then
186         allocate(InteractionHash(nAtypes,nAtypes))
187 +    else
188 +       deallocate(InteractionHash)
189 +       allocate(InteractionHash(nAtypes,nAtypes))
190      endif
191  
192      if (.not. allocated(atypeMaxCutoff)) then
193 +       allocate(atypeMaxCutoff(nAtypes))
194 +    else
195 +       deallocate(atypeMaxCutoff)
196         allocate(atypeMaxCutoff(nAtypes))
197      endif
198          
# Line 259 | Line 270 | contains
270      logical :: GtypeFound
271  
272      integer :: myStatus, nAtypes,  i, j, istart, iend, jstart, jend
273 <    integer :: n_in_i, me_i, ia, g, atom1, nGroupTypes
273 >    integer :: n_in_i, me_i, ia, g, atom1, ja, n_in_j,me_j
274      integer :: nGroupsInRow
275 <    real(kind=dp):: thisSigma, bigSigma, thisRcut, tol, skin
275 >    integer :: nGroupsInCol
276 >    integer :: nGroupTypesRow,nGroupTypesCol
277 >    real(kind=dp):: thisSigma, bigSigma, thisRcut, tradRcut, tol, skin
278      real(kind=dp) :: biggestAtypeCutoff
279  
280      stat = 0
# Line 275 | Line 288 | contains
288      endif
289   #ifdef IS_MPI
290      nGroupsInRow = getNgroupsInRow(plan_group_row)
291 +    nGroupsInCol = getNgroupsInCol(plan_group_col)
292   #endif
293      nAtypes = getSize(atypes)
294   ! Set all of the initial cutoffs to zero.
# Line 331 | Line 345 | contains
345         endif
346      enddo
347    
348 <    nGroupTypes = 0
348 >
349      
350      istart = 1
351 +    jstart = 1
352   #ifdef IS_MPI
353      iend = nGroupsInRow
354 +    jend = nGroupsInCol
355   #else
356      iend = nGroups
357 +    jend = nGroups
358   #endif
359      
360      !! allocate the groupToGtype and gtypeMaxCutoff here.
361 <    if(.not.allocated(groupToGtype)) then
362 <       allocate(groupToGtype(iend))
363 <       allocate(groupMaxCutoff(iend))
364 <       allocate(gtypeMaxCutoff(iend))
365 <       groupMaxCutoff = 0.0_dp
366 <       gtypeMaxCutoff = 0.0_dp
361 >    if(.not.allocated(groupToGtypeRow)) then
362 >     !  allocate(groupToGtype(iend))
363 >       allocate(groupToGtypeRow(iend))
364 >    else
365 >       deallocate(groupToGtypeRow)
366 >       allocate(groupToGtypeRow(iend))
367      endif
368 +    if(.not.allocated(groupMaxCutoffRow)) then
369 +       allocate(groupMaxCutoffRow(iend))
370 +    else
371 +       deallocate(groupMaxCutoffRow)
372 +       allocate(groupMaxCutoffRow(iend))
373 +    end if
374 +
375 +    if(.not.allocated(gtypeMaxCutoffRow)) then
376 +       allocate(gtypeMaxCutoffRow(iend))
377 +    else
378 +       deallocate(gtypeMaxCutoffRow)
379 +       allocate(gtypeMaxCutoffRow(iend))
380 +    endif
381 +
382 +
383 + #ifdef IS_MPI
384 +       ! We only allocate new storage if we are in MPI because Ncol /= Nrow
385 +    if(.not.associated(groupToGtypeCol)) then
386 +       allocate(groupToGtypeCol(jend))
387 +    else
388 +       deallocate(groupToGtypeCol)
389 +       allocate(groupToGtypeCol(jend))
390 +    end if
391 +
392 +    if(.not.associated(groupToGtypeCol)) then
393 +       allocate(groupToGtypeCol(jend))
394 +    else
395 +       deallocate(groupToGtypeCol)
396 +       allocate(groupToGtypeCol(jend))
397 +    end if
398 +    if(.not.associated(gtypeMaxCutoffCol)) then
399 +       allocate(gtypeMaxCutoffCol(jend))
400 +    else
401 +       deallocate(gtypeMaxCutoffCol)      
402 +       allocate(gtypeMaxCutoffCol(jend))
403 +    end if
404 +
405 +       groupMaxCutoffCol = 0.0_dp
406 +       gtypeMaxCutoffCol = 0.0_dp
407 +
408 + #endif
409 +       groupMaxCutoffRow = 0.0_dp
410 +       gtypeMaxCutoffRow = 0.0_dp
411 +
412 +
413      !! first we do a single loop over the cutoff groups to find the
414      !! largest cutoff for any atypes present in this group.  We also
415      !! create gtypes at this point.
416      
417      tol = 1.0d-6
418 <    
418 >    nGroupTypesRow = 0
419 >
420      do i = istart, iend      
421         n_in_i = groupStartRow(i+1) - groupStartRow(i)
422 <       groupMaxCutoff(i) = 0.0_dp
422 >       groupMaxCutoffRow(i) = 0.0_dp
423         do ia = groupStartRow(i), groupStartRow(i+1)-1
424            atom1 = groupListRow(ia)
425   #ifdef IS_MPI
# Line 364 | Line 427 | contains
427   #else
428            me_i = atid(atom1)
429   #endif          
430 <          if (atypeMaxCutoff(me_i).gt.groupMaxCutoff(i)) then
431 <             groupMaxCutoff(i)=atypeMaxCutoff(me_i)
430 >          if (atypeMaxCutoff(me_i).gt.groupMaxCutoffRow(i)) then
431 >             groupMaxCutoffRow(i)=atypeMaxCutoff(me_i)
432            endif          
433         enddo
434  
435 <       if (nGroupTypes.eq.0) then
436 <          nGroupTypes = nGroupTypes + 1
437 <          gtypeMaxCutoff(nGroupTypes) = groupMaxCutoff(i)
438 <          groupToGtype(i) = nGroupTypes
435 >       if (nGroupTypesRow.eq.0) then
436 >          nGroupTypesRow = nGroupTypesRow + 1
437 >          gtypeMaxCutoffRow(nGroupTypesRow) = groupMaxCutoffRow(i)
438 >          groupToGtypeRow(i) = nGroupTypesRow
439         else
440            GtypeFound = .false.
441 <          do g = 1, nGroupTypes
442 <             if ( abs(groupMaxCutoff(i) - gtypeMaxCutoff(g)).lt.tol) then
443 <                groupToGtype(i) = g
441 >          do g = 1, nGroupTypesRow
442 >             if ( abs(groupMaxCutoffRow(i) - gtypeMaxCutoffRow(g)).lt.tol) then
443 >                groupToGtypeRow(i) = g
444                  GtypeFound = .true.
445               endif
446            enddo
447            if (.not.GtypeFound) then            
448 <             nGroupTypes = nGroupTypes + 1
449 <             gtypeMaxCutoff(nGroupTypes) = groupMaxCutoff(i)
450 <             groupToGtype(i) = nGroupTypes
448 >             nGroupTypesRow = nGroupTypesRow + 1
449 >             gtypeMaxCutoffRow(nGroupTypesRow) = groupMaxCutoffRow(i)
450 >             groupToGtypeRow(i) = nGroupTypesRow
451            endif
452         endif
453      enddo    
454  
455 + #ifdef IS_MPI
456 +    do j = jstart, jend      
457 +       n_in_j = groupStartCol(j+1) - groupStartCol(j)
458 +       groupMaxCutoffCol(j) = 0.0_dp
459 +       do ja = groupStartCol(j), groupStartCol(j+1)-1
460 +          atom1 = groupListCol(ja)
461 +
462 +          me_j = atid_col(atom1)
463 +
464 +          if (atypeMaxCutoff(me_j).gt.groupMaxCutoffCol(j)) then
465 +             groupMaxCutoffCol(j)=atypeMaxCutoff(me_j)
466 +          endif          
467 +       enddo
468 +
469 +       if (nGroupTypesCol.eq.0) then
470 +          nGroupTypesCol = nGroupTypesCol + 1
471 +          gtypeMaxCutoffCol(nGroupTypesCol) = groupMaxCutoffCol(j)
472 +          groupToGtypeCol(j) = nGroupTypesCol
473 +       else
474 +          GtypeFound = .false.
475 +          do g = 1, nGroupTypesCol
476 +             if ( abs(groupMaxCutoffCol(j) - gtypeMaxCutoffCol(g)).lt.tol) then
477 +                groupToGtypeCol(j) = g
478 +                GtypeFound = .true.
479 +             endif
480 +          enddo
481 +          if (.not.GtypeFound) then            
482 +             nGroupTypesCol = nGroupTypesCol + 1
483 +             gtypeMaxCutoffCol(nGroupTypesCol) = groupMaxCutoffCol(j)
484 +             groupToGtypeCol(j) = nGroupTypesCol
485 +          endif
486 +       endif
487 +    enddo    
488 +
489 + #else
490 + ! Set pointers to information we just found
491 +    nGroupTypesCol = nGroupTypesRow
492 +    groupToGtypeCol => groupToGtypeRow
493 +    gtypeMaxCutoffCol => gtypeMaxCutoffRow
494 +    groupMaxCutoffCol => groupMaxCutoffRow
495 + #endif
496 +
497 +
498 +
499 +
500 +
501      !! allocate the gtypeCutoffMap here.
502 <    allocate(gtypeCutoffMap(nGroupTypes,nGroupTypes))
502 >    allocate(gtypeCutoffMap(nGroupTypesRow,nGroupTypesCol))
503      !! then we do a double loop over all the group TYPES to find the cutoff
504      !! map between groups of two types
505 <    
506 <    do i = 1, nGroupTypes
507 <       do j = 1, nGroupTypes
505 >    tradRcut = max(maxval(gtypeMaxCutoffRow),maxval(gtypeMaxCutoffCol))
506 >
507 >    do i = 1, nGroupTypesRow
508 >       do j = 1, nGroupTypesCol
509        
510            select case(cutoffPolicy)
511            case(TRADITIONAL_CUTOFF_POLICY)
512 <             thisRcut = maxval(gtypeMaxCutoff)
512 >             thisRcut = tradRcut
513            case(MIX_CUTOFF_POLICY)
514 <             thisRcut = 0.5_dp * (gtypeMaxCutoff(i) + gtypeMaxCutoff(j))
514 >             thisRcut = 0.5_dp * (gtypeMaxCutoffRow(i) + gtypeMaxCutoffCol(j))
515            case(MAX_CUTOFF_POLICY)
516 <             thisRcut = max(gtypeMaxCutoff(i), gtypeMaxCutoff(j))
516 >             thisRcut = max(gtypeMaxCutoffRow(i), gtypeMaxCutoffCol(j))
517            case default
518               call handleError("createGtypeCutoffMap", "Unknown Cutoff Policy")
519               return
# Line 411 | Line 521 | contains
521            gtypeCutoffMap(i,j)%rcut = thisRcut
522            gtypeCutoffMap(i,j)%rcutsq = thisRcut*thisRcut
523            skin = defaultRlist - defaultRcut
524 +          listSkin = skin ! set neighbor list skin thickness
525            gtypeCutoffMap(i,j)%rlistsq = (thisRcut + skin)**2
526  
527            ! sanity check
# Line 422 | Line 533 | contains
533            endif
534         enddo
535      enddo
536 <
536 >    if(allocated(gtypeMaxCutoffRow)) deallocate(gtypeMaxCutoffRow)
537 >    if(allocated(groupMaxCutoffRow)) deallocate(groupMaxCutoffRow)
538 >    if(allocated(atypeMaxCutoff)) deallocate(atypeMaxCutoff)
539 > #ifdef IS_MPI
540 >    if(associated(groupMaxCutoffCol)) deallocate(groupMaxCutoffCol)
541 >    if(associated(gtypeMaxCutoffCol)) deallocate(gtypeMaxCutoffCol)
542 > #endif
543 >    groupMaxCutoffCol => null()
544 >    gtypeMaxCutoffCol => null()
545 >    
546      haveGtypeCutoffMap = .true.
547     end subroutine createGtypeCutoffMap
548  
# Line 524 | Line 644 | contains
644      integer, intent(out) :: thisStat  
645      integer :: my_status, nMatches
646      integer, pointer :: MatchList(:) => null()
527    real(kind=dp) :: rcut, rrf, rt, dielect
647  
648      !! assume things are copacetic, unless they aren't
649      thisStat = 0
# Line 560 | Line 679 | contains
679  
680      haveSaneForceField = .true.
681  
563    !! check to make sure the reaction field setting makes sense
564
565    if (FF_uses_Dipoles) then
566       if (electrostaticSummationMethod == REACTION_FIELD) then
567          dielect = getDielect()
568          call initialize_rf(dielect)
569       endif
570    else
571       if (electrostaticSummationMethod == REACTION_FIELD) then
572          write(default_error,*) 'Using Reaction Field with no dipoles?  Huh?'
573          thisStat = -1
574          haveSaneForceField = .false.
575          return
576       endif
577    endif
578
682      if (FF_uses_EAM) then
683         call init_EAM_FF(my_status)
684         if (my_status /= 0) then
# Line 586 | Line 689 | contains
689         end if
690      endif
691  
589    if (FF_uses_GayBerne) then
590       call check_gb_pair_FF(my_status)
591       if (my_status .ne. 0) then
592          thisStat = -1
593          haveSaneForceField = .false.
594          return
595       endif
596    endif
597
692      if (.not. haveNeighborList) then
693         !! Create neighbor lists
694         call expandNeighborList(nLocal, my_status)
# Line 628 | Line 722 | contains
722  
723      !! Stress Tensor
724      real( kind = dp), dimension(9) :: tau  
725 <    real ( kind = dp ) :: pot
725 >    real ( kind = dp ),dimension(LR_POT_TYPES) :: pot
726      logical ( kind = 2) :: do_pot_c, do_stress_c
727      logical :: do_pot
728      logical :: do_stress
729      logical :: in_switching_region
730   #ifdef IS_MPI
731 <    real( kind = DP ) :: pot_local
731 >    real( kind = DP ), dimension(LR_POT_TYPES) :: pot_local
732      integer :: nAtomsInRow
733      integer :: nAtomsInCol
734      integer :: nprocs
# Line 649 | Line 743 | contains
743      integer :: nlist
744      real( kind = DP ) :: ratmsq, rgrpsq, rgrp, vpair, vij
745      real( kind = DP ) :: sw, dswdr, swderiv, mf
746 +    real( kind = DP ) :: rVal
747      real(kind=dp),dimension(3) :: d_atm, d_grp, fpair, fij
748      real(kind=dp) :: rfpot, mu_i, virial
749      integer :: me_i, me_j, n_in_i, n_in_j
# Line 659 | Line 754 | contains
754      integer :: propPack_i, propPack_j
755      integer :: loopStart, loopEnd, loop
756      integer :: iHash
757 <    real(kind=dp) :: listSkin = 1.0  
757 >    integer :: i1
758 >  
759  
760      !! initialize local variables  
761  
# Line 786 | Line 882 | contains
882                    q_group(:,j), d_grp, rgrpsq)
883   #endif      
884  
885 <             if (rgrpsq < gtypeCutoffMap(groupToGtype(i),groupToGtype(j))%rListsq) then
885 >             if (rgrpsq < gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rListsq) then
886                  if (update_nlist) then
887                     nlist = nlist + 1
888  
# Line 806 | Line 902 | contains
902  
903                     list(nlist) = j
904                  endif
905 +                
906 +                if (rgrpsq < gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rCutsq) then
907  
908 <                if (loop .eq. PAIR_LOOP) then
909 <                   vij = 0.0d0
910 <                   fij(1:3) = 0.0d0
911 <                endif
912 <
913 <                call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
914 <                     in_switching_region)
915 <
916 <                n_in_j = groupStartCol(j+1) - groupStartCol(j)
917 <
918 <                do ia = groupStartRow(i), groupStartRow(i+1)-1
919 <
920 <                   atom1 = groupListRow(ia)
921 <
922 <                   inner: do jb = groupStartCol(j), groupStartCol(j+1)-1
923 <
924 <                      atom2 = groupListCol(jb)
925 <
926 <                      if (skipThisPair(atom1, atom2)) cycle inner
927 <
928 <                      if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
929 <                         d_atm(1:3) = d_grp(1:3)
930 <                         ratmsq = rgrpsq
931 <                      else
932 < #ifdef IS_MPI
933 <                         call get_interatomic_vector(q_Row(:,atom1), &
934 <                              q_Col(:,atom2), d_atm, ratmsq)
935 < #else
936 <                         call get_interatomic_vector(q(:,atom1), &
937 <                              q(:,atom2), d_atm, ratmsq)
938 < #endif
939 <                      endif
940 <
941 <                      if (loop .eq. PREPAIR_LOOP) then
908 >                   if (loop .eq. PAIR_LOOP) then
909 >                      vij = 0.0d0
910 >                      fij(1:3) = 0.0d0
911 >                   endif
912 >                  
913 >                   call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
914 >                        in_switching_region)
915 >                  
916 >                   n_in_j = groupStartCol(j+1) - groupStartCol(j)
917 >                  
918 >                   do ia = groupStartRow(i), groupStartRow(i+1)-1
919 >                      
920 >                      atom1 = groupListRow(ia)
921 >                      
922 >                      inner: do jb = groupStartCol(j), groupStartCol(j+1)-1
923 >                        
924 >                         atom2 = groupListCol(jb)
925 >                        
926 >                         if (skipThisPair(atom1, atom2))  cycle inner
927 >                        
928 >                         if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
929 >                            d_atm(1:3) = d_grp(1:3)
930 >                            ratmsq = rgrpsq
931 >                         else
932 > #ifdef IS_MPI
933 >                            call get_interatomic_vector(q_Row(:,atom1), &
934 >                                 q_Col(:,atom2), d_atm, ratmsq)
935 > #else
936 >                            call get_interatomic_vector(q(:,atom1), &
937 >                                 q(:,atom2), d_atm, ratmsq)
938 > #endif
939 >                         endif
940 >                        
941 >                         if (loop .eq. PREPAIR_LOOP) then
942   #ifdef IS_MPI                      
943 <                         call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
944 <                              rgrpsq, d_grp, do_pot, do_stress, &
945 <                              eFrame, A, f, t, pot_local)
943 >                            call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
944 >                                 rgrpsq, d_grp, do_pot, do_stress, &
945 >                                 eFrame, A, f, t, pot_local)
946   #else
947 <                         call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
948 <                              rgrpsq, d_grp, do_pot, do_stress, &
949 <                              eFrame, A, f, t, pot)
947 >                            call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
948 >                                 rgrpsq, d_grp, do_pot, do_stress, &
949 >                                 eFrame, A, f, t, pot)
950   #endif                                              
951 <                      else
951 >                         else
952   #ifdef IS_MPI                      
953 <                         call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
954 <                              do_pot, &
955 <                              eFrame, A, f, t, pot_local, vpair, fpair)
953 >                            call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
954 >                                 do_pot, eFrame, A, f, t, pot_local, vpair, &
955 >                                 fpair, d_grp, rgrp)
956   #else
957 <                         call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
958 <                              do_pot,  &
959 <                              eFrame, A, f, t, pot, vpair, fpair)
957 >                            call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
958 >                                 do_pot, eFrame, A, f, t, pot, vpair, fpair, &
959 >                                 d_grp, rgrp)
960   #endif
961 +                            vij = vij + vpair
962 +                            fij(1:3) = fij(1:3) + fpair(1:3)
963 +                         endif
964 +                      enddo inner
965 +                   enddo
966  
967 <                         vij = vij + vpair
968 <                         fij(1:3) = fij(1:3) + fpair(1:3)
969 <                      endif
970 <                   enddo inner
971 <                enddo
972 <
973 <                if (loop .eq. PAIR_LOOP) then
974 <                   if (in_switching_region) then
975 <                      swderiv = vij*dswdr/rgrp
976 <                      fij(1) = fij(1) + swderiv*d_grp(1)
874 <                      fij(2) = fij(2) + swderiv*d_grp(2)
875 <                      fij(3) = fij(3) + swderiv*d_grp(3)
876 <
877 <                      do ia=groupStartRow(i), groupStartRow(i+1)-1
878 <                         atom1=groupListRow(ia)
879 <                         mf = mfactRow(atom1)
967 >                   if (loop .eq. PAIR_LOOP) then
968 >                      if (in_switching_region) then
969 >                         swderiv = vij*dswdr/rgrp
970 >                         fij(1) = fij(1) + swderiv*d_grp(1)
971 >                         fij(2) = fij(2) + swderiv*d_grp(2)
972 >                         fij(3) = fij(3) + swderiv*d_grp(3)
973 >                        
974 >                         do ia=groupStartRow(i), groupStartRow(i+1)-1
975 >                            atom1=groupListRow(ia)
976 >                            mf = mfactRow(atom1)
977   #ifdef IS_MPI
978 <                         f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf
979 <                         f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf
980 <                         f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf
978 >                            f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf
979 >                            f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf
980 >                            f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf
981   #else
982 <                         f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf
983 <                         f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf
984 <                         f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
982 >                            f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf
983 >                            f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf
984 >                            f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
985   #endif
986 <                      enddo
987 <
988 <                      do jb=groupStartCol(j), groupStartCol(j+1)-1
989 <                         atom2=groupListCol(jb)
990 <                         mf = mfactCol(atom2)
986 >                         enddo
987 >                        
988 >                         do jb=groupStartCol(j), groupStartCol(j+1)-1
989 >                            atom2=groupListCol(jb)
990 >                            mf = mfactCol(atom2)
991   #ifdef IS_MPI
992 <                         f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf
993 <                         f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf
994 <                         f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf
992 >                            f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf
993 >                            f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf
994 >                            f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf
995   #else
996 <                         f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf
997 <                         f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf
998 <                         f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf
996 >                            f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf
997 >                            f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf
998 >                            f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf
999   #endif
1000 <                      enddo
1001 <                   endif
1000 >                         enddo
1001 >                      endif
1002  
1003 <                   if (do_stress) call add_stress_tensor(d_grp, fij)
1003 >                      if (do_stress) call add_stress_tensor(d_grp, fij)
1004 >                   endif
1005                  endif
1006 <             end if
1006 >             endif
1007            enddo
1008 +          
1009         enddo outer
1010  
1011         if (update_nlist) then
# Line 966 | Line 1065 | contains
1065  
1066      if (do_pot) then
1067         ! scatter/gather pot_row into the members of my column
1068 <       call scatter(pot_Row, pot_Temp, plan_atom_row)
1069 <
1068 >       do i = 1,LR_POT_TYPES
1069 >          call scatter(pot_Row(i,:), pot_Temp(i,:), plan_atom_row)
1070 >       end do
1071         ! scatter/gather pot_local into all other procs
1072         ! add resultant to get total pot
1073         do i = 1, nlocal
1074 <          pot_local = pot_local + pot_Temp(i)
1074 >          pot_local(1:LR_POT_TYPES) = pot_local(1:LR_POT_TYPES) &
1075 >               + pot_Temp(1:LR_POT_TYPES,i)
1076         enddo
1077  
1078         pot_Temp = 0.0_DP
1079 <
1080 <       call scatter(pot_Col, pot_Temp, plan_atom_col)
1079 >       do i = 1,LR_POT_TYPES
1080 >          call scatter(pot_Col(i,:), pot_Temp(i,:), plan_atom_col)
1081 >       end do
1082         do i = 1, nlocal
1083 <          pot_local = pot_local + pot_Temp(i)
1083 >          pot_local(1:LR_POT_TYPES) = pot_local(1:LR_POT_TYPES)&
1084 >               + pot_Temp(1:LR_POT_TYPES,i)
1085         enddo
1086  
1087      endif
1088   #endif
1089  
1090 <    if (FF_RequiresPostpairCalc() .and. SIM_requires_postpair_calc) then
1090 >    if (SIM_requires_postpair_calc) then
1091 >       do i = 1, nlocal            
1092 >          
1093 >          ! we loop only over the local atoms, so we don't need row and column
1094 >          ! lookups for the types
1095 >          
1096 >          me_i = atid(i)
1097 >          
1098 >          ! is the atom electrostatic?  See if it would have an
1099 >          ! electrostatic interaction with itself
1100 >          iHash = InteractionHash(me_i,me_i)
1101  
1102 <       if (electrostaticSummationMethod == REACTION_FIELD) then
990 <
1102 >          if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1103   #ifdef IS_MPI
1104 <          call scatter(rf_Row,rf,plan_atom_row_3d)
1105 <          call scatter(rf_Col,rf_Temp,plan_atom_col_3d)
994 <          do i = 1,nlocal
995 <             rf(1:3,i) = rf(1:3,i) + rf_Temp(1:3,i)
996 <          end do
997 < #endif
998 <
999 <          do i = 1, nLocal
1000 <
1001 <             rfpot = 0.0_DP
1002 < #ifdef IS_MPI
1003 <             me_i = atid_row(i)
1104 >             call self_self(i, eFrame, pot_local(ELECTROSTATIC_POT), &
1105 >                  t, do_pot)
1106   #else
1107 <             me_i = atid(i)
1107 >             call self_self(i, eFrame, pot(ELECTROSTATIC_POT), &
1108 >                  t, do_pot)
1109   #endif
1110 <             iHash = InteractionHash(me_i,me_j)
1110 >          endif
1111 >  
1112 >          
1113 >          if (electrostaticSummationMethod.eq.REACTION_FIELD) then
1114              
1115 <             if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1116 <
1117 <                mu_i = getDipoleMoment(me_i)
1118 <
1119 <                !! The reaction field needs to include a self contribution
1120 <                !! to the field:
1121 <                call accumulate_self_rf(i, mu_i, eFrame)
1122 <                !! Get the reaction field contribution to the
1123 <                !! potential and torques:
1124 <                call reaction_field_final(i, mu_i, eFrame, rfpot, t, do_pot)
1115 >             ! loop over the excludes to accumulate RF stuff we've
1116 >             ! left out of the normal pair loop
1117 >            
1118 >             do i1 = 1, nSkipsForAtom(i)
1119 >                j = skipsForAtom(i, i1)
1120 >                
1121 >                ! prevent overcounting of the skips
1122 >                if (i.lt.j) then
1123 >                   call get_interatomic_vector(q(:,i), &
1124 >                        q(:,j), d_atm, ratmsq)
1125 >                   rVal = dsqrt(ratmsq)
1126 >                   call get_switch(ratmsq, sw, dswdr, rVal, group_switch, &
1127 >                        in_switching_region)
1128   #ifdef IS_MPI
1129 <                pot_local = pot_local + rfpot
1129 >                   call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, &
1130 >                        vpair, pot_local(ELECTROSTATIC_POT), f, t, do_pot)
1131   #else
1132 <                pot = pot + rfpot
1133 <
1132 >                   call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, &
1133 >                        vpair, pot(ELECTROSTATIC_POT), f, t, do_pot)
1134   #endif
1135 <             endif
1136 <          enddo
1137 <       endif
1135 >                endif
1136 >             enddo
1137 >          endif
1138 >       enddo
1139      endif
1140 <
1030 <
1140 >    
1141   #ifdef IS_MPI
1142 <
1142 >    
1143      if (do_pot) then
1144 <       pot = pot + pot_local
1145 <       !! we assume the c code will do the allreduce to get the total potential
1036 <       !! we could do it right here if we needed to...
1144 >       call mpi_allreduce(pot_local, pot, LR_POT_TYPES,mpi_double_precision,mpi_sum, &
1145 >            mpi_comm_world,mpi_err)            
1146      endif
1147 <
1147 >    
1148      if (do_stress) then
1149         call mpi_allreduce(tau_Temp, tau, 9,mpi_double_precision,mpi_sum, &
1150              mpi_comm_world,mpi_err)
1151         call mpi_allreduce(virial_Temp, virial,1,mpi_double_precision,mpi_sum, &
1152              mpi_comm_world,mpi_err)
1153      endif
1154 <
1154 >    
1155   #else
1156 <
1156 >    
1157      if (do_stress) then
1158         tau = tau_Temp
1159         virial = virial_Temp
1160      endif
1161 <
1161 >    
1162   #endif
1163 <
1163 >    
1164    end subroutine do_force_loop
1165  
1166    subroutine do_pair(i, j, rijsq, d, sw, do_pot, &
1167 <       eFrame, A, f, t, pot, vpair, fpair)
1167 >       eFrame, A, f, t, pot, vpair, fpair, d_grp, r_grp)
1168  
1169 <    real( kind = dp ) :: pot, vpair, sw
1169 >    real( kind = dp ) :: vpair, sw
1170 >    real( kind = dp ), dimension(LR_POT_TYPES) :: pot
1171      real( kind = dp ), dimension(3) :: fpair
1172      real( kind = dp ), dimension(nLocal)   :: mfact
1173      real( kind = dp ), dimension(9,nLocal) :: eFrame
# Line 1068 | Line 1178 | contains
1178      logical, intent(inout) :: do_pot
1179      integer, intent(in) :: i, j
1180      real ( kind = dp ), intent(inout) :: rijsq
1181 <    real ( kind = dp )                :: r
1181 >    real ( kind = dp ), intent(inout) :: r_grp
1182      real ( kind = dp ), intent(inout) :: d(3)
1183 +    real ( kind = dp ), intent(inout) :: d_grp(3)
1184 +    real ( kind = dp ) :: r
1185      integer :: me_i, me_j
1186  
1187      integer :: iHash
# Line 1087 | Line 1199 | contains
1199   #endif
1200  
1201      iHash = InteractionHash(me_i, me_j)
1202 <
1202 >    
1203      if ( iand(iHash, LJ_PAIR).ne.0 ) then
1204 <       call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, do_pot)
1204 >       call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1205 >            pot(VDW_POT), f, do_pot)
1206      endif
1207 <
1207 >    
1208      if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1209         call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
1210 <            pot, eFrame, f, t, do_pot)
1098 <
1099 <       if (electrostaticSummationMethod == REACTION_FIELD) then
1100 <
1101 <          ! CHECK ME (RF needs to know about all electrostatic types)
1102 <          call accumulate_rf(i, j, r, eFrame, sw)
1103 <          call rf_correct_forces(i, j, d, r, eFrame, sw, f, fpair)
1104 <       endif
1105 <
1210 >            pot(ELECTROSTATIC_POT), eFrame, f, t, do_pot)
1211      endif
1212 <
1212 >    
1213      if ( iand(iHash, STICKY_PAIR).ne.0 ) then
1214         call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1215 <            pot, A, f, t, do_pot)
1215 >            pot(HB_POT), A, f, t, do_pot)
1216      endif
1217 <
1217 >    
1218      if ( iand(iHash, STICKYPOWER_PAIR).ne.0 ) then
1219         call do_sticky_power_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1220 <            pot, A, f, t, do_pot)
1220 >            pot(HB_POT), A, f, t, do_pot)
1221      endif
1222 <
1222 >    
1223      if ( iand(iHash, GAYBERNE_PAIR).ne.0 ) then
1224         call do_gb_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1225 <            pot, A, f, t, do_pot)
1225 >            pot(VDW_POT), A, f, t, do_pot)
1226      endif
1227      
1228      if ( iand(iHash, GAYBERNE_LJ).ne.0 ) then
1229 < !      call do_gblj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1230 < !           pot, A, f, t, do_pot)
1229 >       call do_gb_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1230 >            pot(VDW_POT), A, f, t, do_pot)
1231      endif
1232 <
1232 >    
1233      if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1234 <       call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, &
1235 <            do_pot)
1234 >       call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1235 >            pot(METALLIC_POT), f, do_pot)
1236      endif
1237 <
1237 >    
1238      if ( iand(iHash, SHAPE_PAIR).ne.0 ) then      
1239         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1240 <            pot, A, f, t, do_pot)
1240 >            pot(VDW_POT), A, f, t, do_pot)
1241      endif
1242 <
1242 >    
1243      if ( iand(iHash, SHAPE_LJ).ne.0 ) then      
1244         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1245 <            pot, A, f, t, do_pot)
1245 >            pot(VDW_POT), A, f, t, do_pot)
1246      endif
1247 <    
1247 >    
1248    end subroutine do_pair
1249  
1250    subroutine do_prepair(i, j, rijsq, d, sw, rcijsq, dc, &
1251         do_pot, do_stress, eFrame, A, f, t, pot)
1252  
1253 <    real( kind = dp ) :: pot, sw
1253 >    real( kind = dp ) :: sw
1254 >    real( kind = dp ), dimension(LR_POT_TYPES) :: pot
1255      real( kind = dp ), dimension(9,nLocal) :: eFrame
1256      real (kind=dp), dimension(9,nLocal) :: A
1257      real (kind=dp), dimension(3,nLocal) :: f
# Line 1180 | Line 1286 | contains
1286  
1287    subroutine do_preforce(nlocal,pot)
1288      integer :: nlocal
1289 <    real( kind = dp ) :: pot
1289 >    real( kind = dp ),dimension(LR_POT_TYPES) :: pot
1290  
1291      if (FF_uses_EAM .and. SIM_uses_EAM) then
1292 <       call calc_EAM_preforce_Frho(nlocal,pot)
1292 >       call calc_EAM_preforce_Frho(nlocal,pot(METALLIC_POT))
1293      endif
1294  
1295  
# Line 1269 | Line 1375 | contains
1375      pot_Col = 0.0_dp
1376      pot_Temp = 0.0_dp
1377  
1272    rf_Row = 0.0_dp
1273    rf_Col = 0.0_dp
1274    rf_Temp = 0.0_dp
1275
1378   #endif
1379  
1380      if (FF_uses_EAM .and. SIM_uses_EAM) then
1381         call clean_EAM()
1382      endif
1383  
1282    rf = 0.0_dp
1384      tau_Temp = 0.0_dp
1385      virial_Temp = 0.0_dp
1386    end subroutine zero_work_arrays
# Line 1376 | Line 1477 | contains
1477      doesit = FF_uses_EAM
1478    end function FF_RequiresPrepairCalc
1479  
1379  function FF_RequiresPostpairCalc() result(doesit)
1380    logical :: doesit
1381    if (electrostaticSummationMethod == REACTION_FIELD) doesit = .true.
1382  end function FF_RequiresPostpairCalc
1383
1480   #ifdef PROFILE
1481    function getforcetime() result(totalforcetime)
1482      real(kind=dp) :: totalforcetime

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines