ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE/libmdtools/do_Forces.F90
(Generate patch)

Comparing trunk/OOPSE/libmdtools/do_Forces.F90 (file contents):
Revision 1169 by gezelter, Wed May 12 19:44:54 2004 UTC vs.
Revision 1197 by gezelter, Wed May 26 16:41:23 2004 UTC

# Line 4 | Line 4
4  
5   !! @author Charles F. Vardeman II
6   !! @author Matthew Meineke
7 < !! @version $Id: do_Forces.F90,v 1.58 2004-05-12 19:44:49 gezelter Exp $, $Date: 2004-05-12 19:44:49 $, $Name: not supported by cvs2svn $, $Revision: 1.58 $
7 > !! @version $Id: do_Forces.F90,v 1.62 2004-05-26 16:41:23 gezelter Exp $, $Date: 2004-05-26 16:41:23 $, $Name: not supported by cvs2svn $, $Revision: 1.62 $
8  
9   module do_Forces
10    use force_globals
# Line 32 | Line 32 | module do_Forces
32   #define __FORTRAN90
33   #include "fForceField.h"
34   #include "fSwitchingFunction.h"
35 +
36 +  INTEGER, PARAMETER:: PREPAIR_LOOP = 1
37 +  INTEGER, PARAMETER:: PAIR_LOOP    = 2
38  
39    logical, save :: haveRlist = .false.
40    logical, save :: haveNeighborList = .false.
# Line 399 | Line 402 | contains
402   #endif
403      integer :: natoms    
404      logical :: update_nlist  
405 <    integer :: i, j, jbeg, jend, jnab
405 >    integer :: i, j, jstart, jend, jnab
406 >    integer :: istart, iend
407      integer :: ia, jb, atom1, atom2
408      integer :: nlist
409      real( kind = DP ) :: ratmsq, rgrpsq, rgrp, vpair, vij
410      real( kind = DP ) :: sw, dswdr, swderiv, mf
411 <    real(kind=dp),dimension(3) :: d_atm, d_grp
411 >    real(kind=dp),dimension(3) :: d_atm, d_grp, fpair, fij
412      real(kind=dp) :: rfpot, mu_i, virial
413      integer :: me_i, me_j, n_in_i, n_in_j
414      logical :: is_dp_i
# Line 412 | Line 416 | contains
416      integer :: listerror, error
417      integer :: localError
418      integer :: propPack_i, propPack_j
419 +    integer :: loopStart, loopEnd, loop
420  
421      real(kind=dp) :: listSkin = 1.0  
422      
# Line 464 | Line 469 | contains
469      nloops = nloops + 1
470   #endif
471      
472 <    if (FF_RequiresPrepairCalc() .and. SIM_requires_prepair_calc) then
473 <       !! See if we need to update neighbor lists
472 >    loopEnd = PAIR_LOOP
473 >    if (FF_RequiresPrepairCalc() .and. SIM_requires_prepair_calc) then
474 >       loopStart = PREPAIR_LOOP
475 >    else
476 >       loopStart = PAIR_LOOP
477 >    endif
478  
479 <       call checkNeighborList(nGroup, q_group, listSkin, update_nlist)
479 >    do loop = loopStart, loopEnd
480  
481 <       !! if_mpi_gather_stuff_for_prepair
482 <       !! do_prepair_loop_if_needed
483 <       !! if_mpi_scatter_stuff_from_prepair
484 <       !! if_mpi_gather_stuff_from_prepair_to_main_loop
485 <      
477 <       !--------------------PREFORCE LOOP----------->>>>>>>>>>>>>>>>>>>>>>>>>>>
478 < #ifdef IS_MPI
481 >       ! See if we need to update neighbor lists
482 >       ! (but only on the first time through):
483 >       if (loop .eq. loopStart) then
484 >          call checkNeighborList(nGroup, q_group, listSkin, update_nlist)
485 >       endif
486        
487         if (update_nlist) then
488 <          
489 <          !! save current configuration, construct neighbor list,
483 <          !! and calculate forces
484 <
485 <          call saveNeighborList(nGroup, q_group)
486 <          
488 >          !! save current configuration and construct neighbor list
489 >          call saveNeighborList(nGroup, q_group)          
490            neighborListSize = size(list)
491 <          nlist = 0      
489 <          
490 <          do i = 1, nrow_group
491 <             point(i) = nlist + 1
492 <            
493 <             do j = 1, ncol_group
494 <                
495 <                call get_interatomic_vector(q_group_Row(:,i), &
496 <                     q_group_Col(:,j), d_grp, rgrpsq)
497 <                
498 <                if (rgrpsq < rlistsq) then
499 <                   nlist = nlist + 1
500 <                  
501 <                   if (nlist > neighborListSize) then
502 <                      call expandNeighborList(nGroup, listerror)
503 <                      if (listerror /= 0) then
504 <                         error = -1
505 <                         write(DEFAULT_ERROR,*) "ERROR: nlist > list size and max allocations exceeded."
506 <                         return
507 <                      end if
508 <                      neighborListSize = size(list)
509 <                   endif
510 <                  
511 <                   list(nlist) = j
512 <                  
513 <                   do ia = groupStart(i), groupStart(i+1)-1
514 <                      atom1 = groupList(ia)
515 <
516 <                      prepair_inner: do jb = groupStart(j), groupStart(j+1)-1
517 <                         atom2 = groupList(jb)
518 <                        
519 <                         if (skipThisPair(atom1, atom2)) cycle prepair_inner
520 <                        
521 <                         call get_interatomic_vector(q_Row(:,atom1), &
522 <                              q_Col(:,atom2), d_atm, ratmsq)
523 <                        
524 <                         call do_prepair(atom1, atom2, ratmsq, d_atm, &
525 <                              rgrpsq, d_grp, do_pot, do_stress, &
526 <                              u_l, A, f, t, pot_local)
527 <
528 <                      enddo prepair_inner
529 <                   enddo
530 <                end if
531 <             enddo
532 <          enddo
533 <          point(nrow_group + 1) = nlist + 1          
534 <                          
535 <       else  !! (of update_check)
536 <          
537 <          ! use the list to find the neighbors
538 <          do i = 1, nrow_group
539 <             JBEG = POINT(i)
540 <             JEND = POINT(i+1) - 1
541 <             ! check that group i has neighbors
542 <             if (jbeg .le. jend) then
543 <                
544 <                do jnab = jbeg, jend
545 <                   j = list(jnab)
546 <                  
547 <                   do ia = groupStart(i), groupStart(i+1)-1
548 <                      atom1 = groupList(ia)
549 <
550 <                      do jb = groupStart(j), groupStart(j+1)-1
551 <                         atom2 = groupList(jb)                        
552 <                        
553 <                         call get_interatomic_vector(q_Row(:,atom1), &
554 <                              q_Col(:,atom2), d_atm, ratmsq)
555 <                        
556 <                         call do_prepair(atom1, atom2, ratmsq, d_atm, &
557 <                              rgrpsq, d_grp, do_pot, do_stress, &
558 <                              u_l, A, f, t, pot_local)
559 <                        
560 <                      enddo
561 <                   enddo
562 <                enddo
563 <             endif
564 <          enddo
491 >          nlist = 0
492         endif
493        
494 +       istart = 1
495 + #ifdef IS_MPI
496 +       iend = nrow_group
497   #else
498 <
499 <       if (update_nlist) then
498 >       iend = nGroup - 1
499 > #endif
500 >       outer: do i = istart, iend
501            
502 <          !! save current configuration, construct neighbor list,
572 <          !! and calculate forces
502 >          if (update_nlist) point(i) = nlist + 1
503            
504 <          call saveNeighborList(nGroup, q_group)
504 >          n_in_i = groupStart(i+1) - groupStart(i)
505            
506 <          neighborListSize = size(list)
507 <          nlist = 0      
506 >          if (update_nlist) then
507 > #ifdef IS_MPI
508 >             jstart = 1
509 >             jend = ncol_group
510 > #else
511 >             jstart = i+1
512 >             jend = nGroup
513 > #endif
514 >          else            
515 >             jstart = point(i)
516 >             jend = point(i+1) - 1
517 >             ! make sure group i has neighbors
518 >             if (jstart .gt. jend) cycle outer
519 >          endif
520            
521 <          do i = 1, nGroup-1
522 <             point(i) = nlist + 1
523 <            
524 <             do j = i+1, nGroup
525 <                
526 <                call get_interatomic_vector(q_group(:,i), &
527 <                     q_group(:,j), d_grp, rgrpsq)
528 <                
529 <                if (rgrpsq < rlistsq) then
521 >          do jnab = jstart, jend
522 >             if (update_nlist) then
523 >                j = jnab
524 >             else
525 >                j = list(jnab)
526 >             endif
527 > #ifdef IS_MPI
528 >             call get_interatomic_vector(q_group_Row(:,i), &
529 >                  q_group_Col(:,j), d_grp, rgrpsq)
530 > #else
531 >             call get_interatomic_vector(q_group(:,i), &
532 >                  q_group(:,j), d_grp, rgrpsq)
533 > #endif
534 >             if (rgrpsq < rlistsq) then
535 >                if (update_nlist) then
536                     nlist = nlist + 1
537                    
538                     if (nlist > neighborListSize) then
# Line 598 | Line 546 | contains
546                     endif
547                    
548                     list(nlist) = j
601                  
602                   do ia = groupStart(i), groupStart(i+1)-1
603                      atom1 = groupList(ia)
604                      
605                      prepair_inner: do jb = groupStart(j), groupStart(j+1)-1
606                         atom2 = groupList(jb)
607                        
608                         if (skipThisPair(atom1, atom2)) cycle prepair_inner
609                        
610                         call get_interatomic_vector(q(:,atom1), &
611                              q(:,atom2), d_atm, ratmsq)
612                        
613                         call do_prepair(atom1, atom2, ratmsq, d_atm, &
614                              rgrpsq, d_grp, do_pot, do_stress, &
615                              u_l, A, f, t, pot)
616                        
617                      enddo prepair_inner
618                   enddo
619                end if
620             enddo
621          enddo
622          point(nGroup) = nlist + 1          
623                          
624       else  !! (of update_check)
625          
626          ! use the list to find the neighbors
627          do i = 1, nGroup-1
628             JBEG = POINT(i)
629             JEND = POINT(i+1) - 1
630             ! check that group i has neighbors
631             if (jbeg .le. jend) then
632                
633                do jnab = jbeg, jend
634                   j = list(jnab)
635                  
636                   do ia = groupStart(i), groupStart(i+1)-1
637                      atom1 = groupList(ia)
638
639                      do jb = groupStart(j), groupStart(j+1)-1
640                         atom2 = groupList(jb)                        
641                        
642                         call get_interatomic_vector(q(:,atom1), &
643                              q(:,atom2), d_atm, ratmsq)
644                        
645                         call do_prepair(atom1, atom2, ratmsq, d_atm, &
646                              rgrpsq, d_grp, do_pot, do_stress, &
647                              u_l, A, f, t, pot)
648                        
649                      enddo
650                   enddo
651                enddo
652             endif
653          enddo
654       endif
655      
656 #endif
657      
658       !! Do rest of preforce calculations
659       !! do necessary preforce calculations  
660       call do_preforce(nlocal,pot)
661       ! we have already updated the neighbor list set it to false...
662       update_nlist = .false.
663    else
664       !! See if we need to update neighbor lists for non pre-pair
665       call checkNeighborList(nGroup, q_group, listSkin, update_nlist)  
666    endif
667    
668    !---------------------------------MAIN Pair LOOP->>>>>>>>>>>>>
669    
670 #ifdef IS_MPI
671    
672    if (update_nlist) then
673      
674       !! save current configuration, construct neighbor list,
675       !! and calculate forces
676      
677       call saveNeighborList(nGroup, q_group)
678      
679       neighborListSize = size(list)
680       nlist = 0      
681      
682       do i = 1, nrow_group
683
684          point(i) = nlist + 1
685
686          n_in_i = groupStart(i+1) - groupStart(i)
687          
688          do j = 1, ncol_group
689            
690             call get_interatomic_vector(q_group_Row(:,i), &
691                  q_group_Col(:,j), d_grp, rgrpsq)
692            
693             if (rgrpsq < rlistsq) then
694                nlist = nlist + 1
695                
696                if (nlist > neighborListSize) then
697                   call expandNeighborList(nGroup, listerror)
698                   if (listerror /= 0) then
699                      error = -1
700                      write(DEFAULT_ERROR,*) "ERROR: nlist > list size and max allocations exceeded."
701                      return
702                   end if
703                   neighborListSize = size(list)
549                  endif
550                  
551 <                list(nlist) = j
552 <                
553 <                vij = 0.0d0
709 <
710 <                call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
711 <                     in_switching_region)
712 <
713 <                n_in_j = groupStart(j+1) - groupStart(j)
714 <                
715 <                do ia = groupStart(i), groupStart(i+1)-1
716 <                   atom1 = groupList(ia)
717 <                  
718 <                   inner: do jb = groupStart(j), groupStart(j+1)-1
719 <                      atom2 = groupList(jb)                    
720 <
721 <                      if (skipThisPair(atom1, atom2)) cycle inner
722 <                      
723 <                      if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
724 <                         d_atm(1:3) = d_grp(1:3)
725 <                         ratmsq = rgrpsq
726 <                      else
727 <                         call get_interatomic_vector(q_Row(:,atom1), &
728 <                              q_Col(:,atom2), d_atm, ratmsq)
729 <                      endif
730 <                      
731 <                      call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
732 <                           do_pot, do_stress, &
733 <                           u_l, A, f, t, pot_local, vpair)
734 <                      
735 <                      vij = vij + vpair
736 <                   enddo inner
737 <                enddo
738 <
739 <                if (in_switching_region) then
740 <                   swderiv = vij*dswdr/rgrp
741 <                  
742 <                   do ia=groupStart(i), groupStart(i+1)-1
743 <                      atom1=groupList(ia)
744 <                      mf = mfact(atom1)                  
745 <                      f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf
746 <                      f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf
747 <                      f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf
748 <                   enddo
749 <                  
750 <                   do jb=groupStart(j), groupStart(j+1)-1
751 <                      atom2=groupList(jb)
752 <                      mf = mfact(atom2)
753 <                      f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf
754 <                      f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf
755 <                      f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf
756 <                   enddo                        
551 >                if (loop .eq. PAIR_LOOP) then
552 >                   vij = 0.0d0
553 >                   fij(1:3) = 0.0d0
554                  endif
758
759             end if
760          enddo
761       enddo
762
763       point(nrow_group + 1) = nlist + 1          
764      
765    else  !! (of update_check)
766      
767       ! use the list to find the neighbors
768       do i = 1, nrow_group
769
770          n_in_i = groupStart(i+1) - groupStart(i)
771          
772          JBEG = POINT(i)
773          JEND = POINT(i+1) - 1
774          ! check that group i has neighbors
775          if (jbeg .le. jend) then
776            
777             do jnab = jbeg, jend
778                j = list(jnab)
779                              
780                call get_interatomic_vector(q_group_Row(:,i), &
781                     q_group_Col(:,j), d_grp, rgrpsq)
555                  
783                vij = 0.0d0
556                  call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
557                       in_switching_region)
558                  
559                  n_in_j = groupStart(j+1) - groupStart(j)
560                  
561                  do ia = groupStart(i), groupStart(i+1)-1
790                   atom1 = groupList(ia)
791                  
792                   do jb = groupStart(j), groupStart(j+1)-1
793                      atom2 = groupList(jb)                        
794                      
795                      if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
796                         d_atm(1:3) = d_grp(1:3)
797                         ratmsq = rgrpsq
798                      else
799                         call get_interatomic_vector(q_Row(:,atom1), &
800                              q_Col(:,atom2), d_atm, ratmsq)
801                      endif
802                                            
803                      call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
804                           do_pot, do_stress, &
805                           u_l, A, f, t, pot_local, vpair)
806                      
807                      vij = vij + vpair
808                                            
809                   enddo
810                enddo
811                
812                if (in_switching_region) then
813                   swderiv = vij*dswdr/rgrp
814  
815                   do ia=groupStart(i), groupStart(i+1)-1
816                      atom1=groupList(ia)
817                      mf = mfact(atom1)                  
818                      f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf
819                      f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf
820                      f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf
821                   enddo
562                    
823                   do jb=groupStart(j), groupStart(j+1)-1
824                      atom2=groupList(jb)
825                      mf = mfact(atom2)
826                      f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf
827                      f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf
828                      f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf
829                   enddo
830                endif
831
832             enddo
833          endif
834       enddo
835    endif
836    
837 #else
838
839    if (update_nlist) then
840      
841       !! save current configuration, construct neighbor list,
842       !! and calculate forces
843      
844       call saveNeighborList(nGroup, q_group)
845      
846       neighborListSize = size(list)
847       nlist = 0      
848      
849       do i = 1, nGroup-1
850
851          point(i) = nlist + 1
852          n_in_i = groupStart(i+1) - groupStart(i)
853          
854          do j = i+1, nGroup
855            
856             call get_interatomic_vector(q_group(:,i), &
857                  q_group(:,j), d_grp, rgrpsq)
858            
859             if (rgrpsq < rlistsq) then
860                nlist = nlist + 1
861                
862                if (nlist > neighborListSize) then
863                   call expandNeighborList(nGroup, listerror)
864                   if (listerror /= 0) then
865                      error = -1
866                      write(DEFAULT_ERROR,*) "ERROR: nlist > list size and max allocations exceeded."
867                      return
868                   end if
869                   neighborListSize = size(list)
870                endif
871                
872                list(nlist) = j
873
874                vij = 0.0d0
875
876                call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
877                     in_switching_region)
878                
879                n_in_j = groupStart(j+1) - groupStart(j)
880
881                do ia = groupStart(i), groupStart(i+1)-1
563                     atom1 = groupList(ia)
564                    
565                     inner: do jb = groupStart(j), groupStart(j+1)-1
566 +                      
567                        atom2 = groupList(jb)
568                        
569                        if (skipThisPair(atom1, atom2)) cycle inner
# Line 890 | Line 572 | contains
572                           d_atm(1:3) = d_grp(1:3)
573                           ratmsq = rgrpsq
574                        else
575 + #ifdef IS_MPI
576 +                         call get_interatomic_vector(q_Row(:,atom1), &
577 +                              q_Col(:,atom2), d_atm, ratmsq)
578 + #else
579                           call get_interatomic_vector(q(:,atom1), &
580                                q(:,atom2), d_atm, ratmsq)
581 + #endif
582                        endif
583 <                        
584 <                      call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
585 <                           do_pot, do_stress, &
586 <                           u_l, A, f, t, pot, vpair)
587 <                      
588 <                      vij = vij + vpair
589 <                      
583 >                      if (loop .eq. PREPAIR_LOOP) then
584 > #ifdef IS_MPI                      
585 >                         call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
586 >                              rgrpsq, d_grp, do_pot, do_stress, &
587 >                              u_l, A, f, t, pot_local)
588 > #else
589 >                         call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
590 >                              rgrpsq, d_grp, do_pot, do_stress, &
591 >                              u_l, A, f, t, pot)
592 > #endif                                              
593 >                      else
594 > #ifdef IS_MPI                      
595 >                         call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
596 >                              do_pot, &
597 >                              u_l, A, f, t, pot_local, vpair, fpair)
598 > #else
599 >                         call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
600 >                              do_pot,  &
601 >                              u_l, A, f, t, pot, vpair, fpair)
602 > #endif
603 >                         vij = vij + vpair
604 >                         fij(1:3) = fij(1:3) + fpair(1:3)
605 >                      endif
606                     enddo inner
607                  enddo
608 <
609 <                if (in_switching_region) then
610 <                   swderiv = vij*dswdr/rgrp
611 <                   do ia=groupStart(i), groupStart(i+1)-1
612 <                      atom1=groupList(ia)
613 <                      mf = mfact(atom1)                  
614 <                      f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf
615 <                      f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf
616 <                      f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
617 <                   enddo
608 >                
609 >                if (loop .eq. PAIR_LOOP) then
610 >                   if (in_switching_region) then
611 >                      swderiv = vij*dswdr/rgrp
612 >                      fij(1) = fij(1) + swderiv*d_grp(1)
613 >                      fij(2) = fij(2) + swderiv*d_grp(2)
614 >                      fij(3) = fij(3) + swderiv*d_grp(3)
615 >                      
616 >                      do ia=groupStart(i), groupStart(i+1)-1
617 >                         atom1=groupList(ia)
618 >                         mf = mfact(atom1)
619 > #ifdef IS_MPI
620 >                         f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf
621 >                         f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf
622 >                         f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf
623 > #else
624 >                         f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf
625 >                         f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf
626 >                         f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
627 > #endif
628 >                      enddo
629 >                      
630 >                      do jb=groupStart(j), groupStart(j+1)-1
631 >                         atom2=groupList(jb)
632 >                         mf = mfact(atom2)
633 > #ifdef IS_MPI
634 >                         f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf
635 >                         f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf
636 >                         f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf
637 > #else
638 >                         f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf
639 >                         f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf
640 >                         f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf
641 > #endif
642 >                      enddo
643 >                   endif
644                    
645 <                   do jb=groupStart(j), groupStart(j+1)-1
917 <                      atom2=groupList(jb)
918 <                      mf = mfact(atom2)
919 <                      f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf
920 <                      f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf
921 <                      f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf
922 <                   enddo
645 >                   if (do_stress) call add_stress_tensor(d_grp, fij)
646                  endif
924
647               end if
648            enddo
649 <       enddo
928 <       point(nGroup) = nlist + 1          
649 >       enddo outer
650        
651 <    else  !! (of update_check)
652 <      
653 <       ! use the list to find the neighbors
654 <       do i = 1, nGroup-1
655 <
656 <          n_in_i = groupStart(i+1) - groupStart(i)
657 <          
658 <          JBEG = POINT(i)
659 <          JEND = POINT(i+1) - 1
660 <          ! check that group i has neighbors
661 <          if (jbeg .le. jend) then
941 <            
942 <             do jnab = jbeg, jend
943 <                j = list(jnab)
944 <                
945 <                call get_interatomic_vector(q_group(:,i), &
946 <                     q_group(:,j), d_grp, rgrpsq)
947 <
948 <                vij = 0.0d0    
949 <                
950 <                call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
951 <                     in_switching_region)
952 <                
953 <                n_in_j = groupStart(j+1) - groupStart(j)
954 <                
955 <                do ia = groupStart(i), groupStart(i+1)-1
956 <                   atom1 = groupList(ia)
957 <                  
958 <                   do jb = groupStart(j), groupStart(j+1)-1
959 <                      atom2 = groupList(jb)                        
960 <                      
961 <                      if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
962 <                         d_atm(1:3) = d_grp(1:3)
963 <                         ratmsq = rgrpsq
964 <                      else
965 <                         call get_interatomic_vector(q(:,atom1), &
966 <                              q(:,atom2), d_atm, ratmsq)
967 <                      endif
968 <                      
969 <                      call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
970 <                           do_pot, do_stress, &
971 <                           u_l, A, f, t, pot, vpair)
972 <                      
973 <                      vij = vij + vpair
974 <                      
975 <                   enddo
976 <                enddo
977 <                
978 <                if (in_switching_region) then
979 <                   swderiv = vij*dswdr/rgrp
980 <                  
981 <                   do ia=groupStart(i), groupStart(i+1)-1
982 <                      atom1=groupList(ia)
983 <                      mf = mfact(atom1)                  
984 <                      f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf
985 <                      f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf
986 <                      f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
987 <                   enddo
988 <                  
989 <                   do jb=groupStart(j), groupStart(j+1)-1
990 <                      atom2=groupList(jb)
991 <                      mf = mfact(atom2)
992 <                      f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf
993 <                      f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf
994 <                      f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf
995 <                   enddo
996 <                endif
997 <             enddo
651 >       if (update_nlist) then
652 > #ifdef IS_MPI
653 >          point(nrow_group + 1) = nlist + 1
654 > #else
655 >          point(nGroup) = nlist + 1
656 > #endif
657 >          if (loop .eq. PREPAIR_LOOP) then
658 >             ! we just did the neighbor list update on the first
659 >             ! pass, so we don't need to do it
660 >             ! again on the second pass
661 >             update_nlist = .false.                              
662            endif
663 <       enddo
664 <    endif
663 >       endif
664 >            
665 >       if (loop .eq. PREPAIR_LOOP) then
666 >          call do_preforce(nlocal, pot)
667 >       endif
668 >      
669 >    enddo
670      
1002 #endif
1003    
1004    ! phew, done with main loop.
1005    
671      !! Do timing
672   #ifdef PROFILE
673      call cpu_time(forceTimeFinal)
# Line 1124 | Line 789 | contains
789      endif
790      
791   #endif
792 <    
1128 <    
792 >      
793    end subroutine do_force_loop
1130
794    
795 <  subroutine do_pair(i, j, rijsq, d, sw, do_pot, do_stress, &
796 <       u_l, A, f, t, pot, vpair)
795 >  subroutine do_pair(i, j, rijsq, d, sw, do_pot, &
796 >       u_l, A, f, t, pot, vpair, fpair)
797  
798      real( kind = dp ) :: pot, vpair, sw
799 +    real( kind = dp ), dimension(3) :: fpair
800      real( kind = dp ), dimension(nLocal)   :: mfact
801      real( kind = dp ), dimension(3,nLocal) :: u_l
802      real( kind = dp ), dimension(9,nLocal) :: A
803      real( kind = dp ), dimension(3,nLocal) :: f
804      real( kind = dp ), dimension(3,nLocal) :: t
805  
806 <    logical, intent(inout) :: do_pot, do_stress
806 >    logical, intent(inout) :: do_pot
807      integer, intent(in) :: i, j
808      real ( kind = dp ), intent(inout) :: rijsq
809      real ( kind = dp )                :: r
# Line 1148 | Line 812 | contains
812  
813      r = sqrt(rijsq)
814      vpair = 0.0d0
815 +    fpair(1:3) = 0.0d0
816  
817   #ifdef IS_MPI
818      if (tagRow(i) .eq. tagColumn(j)) then
# Line 1169 | Line 834 | contains
834            !write(*,'(3es12.3)') sw, vpair, pot
835            !write(*,*)
836  
837 <          call do_lj_pair(i, j, d, r, rijsq, sw, vpair, pot, f, do_pot, &
1173 <               do_stress)
837 >          call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, do_pot)
838         endif
839        
840      endif
# Line 1178 | Line 842 | contains
842      if (FF_uses_charges .and. SIM_uses_charges) then
843        
844         if (PropertyMap(me_i)%is_Charge .and. PropertyMap(me_j)%is_Charge) then
845 <          call do_charge_pair(i, j, d, r, rijsq, sw, vpair, pot, f, do_pot, &
1182 <               do_stress)
845 >          call do_charge_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, do_pot)
846         endif
847        
848      endif
# Line 1187 | Line 850 | contains
850      if (FF_uses_dipoles .and. SIM_uses_dipoles) then
851        
852         if ( PropertyMap(me_i)%is_DP .and. PropertyMap(me_j)%is_DP) then
853 <          call do_dipole_pair(i, j, d, r, rijsq, sw, vpair, pot, u_l, f, t, &
854 <               do_pot, do_stress)
853 >          call do_dipole_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, u_l, f, t, &
854 >               do_pot)
855            if (FF_uses_RF .and. SIM_uses_RF) then
856               call accumulate_rf(i, j, r, u_l, sw)
857 <             call rf_correct_forces(i, j, d, r, u_l, sw, f, do_stress)
857 >             call rf_correct_forces(i, j, d, r, u_l, sw, f, fpair)
858            endif          
859         endif
860  
# Line 1200 | Line 863 | contains
863      if (FF_uses_Sticky .and. SIM_uses_sticky) then
864  
865         if ( PropertyMap(me_i)%is_Sticky .and. PropertyMap(me_j)%is_Sticky) then
866 <          call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, pot, A, f, t, &
867 <               do_pot, do_stress)
866 >          call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, A, f, t, &
867 >               do_pot)
868         endif
869  
870      endif
# Line 1210 | Line 873 | contains
873      if (FF_uses_GB .and. SIM_uses_GB) then
874        
875         if ( PropertyMap(me_i)%is_GB .and. PropertyMap(me_j)%is_GB) then
876 <          call do_gb_pair(i, j, d, r, rijsq, sw, vpair, pot, u_l, f, t, &
877 <               do_pot, do_stress)          
876 >          call do_gb_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, u_l, f, t, &
877 >               do_pot)
878         endif
879  
880      endif
# Line 1219 | Line 882 | contains
882      if (FF_uses_EAM .and. SIM_uses_EAM) then
883        
884         if ( PropertyMap(me_i)%is_EAM .and. PropertyMap(me_j)%is_EAM) then
885 <          call do_eam_pair(i, j, d, r, rijsq, sw, vpair, pot, f, &
886 <               do_pot, do_stress)
885 >          call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, &
886 >               do_pot)
887         endif
888        
889      endif
890      
891    end subroutine do_pair
892  
893 <  subroutine do_prepair(i, j, rijsq, d, rcijsq, dc, &
893 >  subroutine do_prepair(i, j, rijsq, d, sw, rcijsq, dc, &
894         do_pot, do_stress, u_l, A, f, t, pot)
895 <   real( kind = dp ) :: pot
895 >
896 >   real( kind = dp ) :: pot, sw
897     real( kind = dp ), dimension(3,nLocal) :: u_l
898     real (kind=dp), dimension(9,nLocal) :: A
899     real (kind=dp), dimension(3,nLocal) :: f
# Line 1256 | Line 920 | contains
920  
921   #ifdef IS_MPI
922     if (tagRow(i) .eq. tagColumn(j)) then
923 <      write(0,*) 'do_pair is doing', i , j, tagRow(i), tagColumn(j)
923 >      write(0,*) 'do_prepair is doing', i , j, tagRow(i), tagColumn(j)
924     endif
925    
926     me_i = atid_row(i)
# Line 1268 | Line 932 | contains
932     me_j = atid(j)
933    
934   #endif
935 <    
935 >  
936     if (FF_uses_EAM .and. SIM_uses_EAM) then
937 <
937 >      
938        if (PropertyMap(me_i)%is_EAM .and. PropertyMap(me_j)%is_EAM) &
939             call calc_EAM_prepair_rho(i, j, d, r, rijsq )
940 <
940 >      
941     endif
942    
943   end subroutine do_prepair
944 <
945 <
1282 <
1283 <
944 >
945 >
946   subroutine do_preforce(nlocal,pot)
947     integer :: nlocal
948     real( kind = dp ) :: pot
# Line 1459 | Line 1121 | contains
1121        endif
1122     enddo
1123    
1124 <   do i = 1, nExcludes_local
1125 <      if (excludesLocal(1,i) == unique_id_1) then
1126 <         if (excludesLocal(2,i) == unique_id_2) then
1127 <            skip_it = .true.
1466 <            return
1467 <         endif
1468 <      else
1469 <         if (excludesLocal(1,i) == unique_id_2) then
1470 <            if (excludesLocal(2,i) == unique_id_1) then
1471 <               skip_it = .true.
1472 <               return
1473 <            endif
1474 <         endif
1124 >   do i = 1, nSkipsForAtom(unique_id_1)
1125 >      if (skipsForAtom(unique_id_1, i) .eq. unique_id_2) then
1126 >         skip_it = .true.
1127 >         return
1128        endif
1129     end do
1130    
# Line 1502 | Line 1155 | contains
1155   #endif
1156  
1157   !! This cleans componets of force arrays belonging only to fortran
1158 +
1159 + subroutine add_stress_tensor(dpair, fpair)
1160 +  
1161 +   real( kind = dp ), dimension(3), intent(in) :: dpair, fpair
1162 +  
1163 +   ! because the d vector is the rj - ri vector, and
1164 +   ! because fx, fy, fz are the force on atom i, we need a
1165 +   ! negative sign here:  
1166 +  
1167 +   tau_Temp(1) = tau_Temp(1) - dpair(1) * fpair(1)
1168 +   tau_Temp(2) = tau_Temp(2) - dpair(1) * fpair(2)
1169 +   tau_Temp(3) = tau_Temp(3) - dpair(1) * fpair(3)
1170 +   tau_Temp(4) = tau_Temp(4) - dpair(2) * fpair(1)
1171 +   tau_Temp(5) = tau_Temp(5) - dpair(2) * fpair(2)
1172 +   tau_Temp(6) = tau_Temp(6) - dpair(2) * fpair(3)
1173 +   tau_Temp(7) = tau_Temp(7) - dpair(3) * fpair(1)
1174 +   tau_Temp(8) = tau_Temp(8) - dpair(3) * fpair(2)
1175 +   tau_Temp(9) = tau_Temp(9) - dpair(3) * fpair(3)
1176 +  
1177 +   !write(*,'(6es12.3)')  fpair(1:3), tau_Temp(1), tau_Temp(5), tau_temp(9)
1178 +   virial_Temp = virial_Temp + &
1179 +        (tau_Temp(1) + tau_Temp(5) + tau_Temp(9))
1180 +  
1181 + end subroutine add_stress_tensor
1182  
1183   end module do_Forces
1184 +

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines