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 1183 by gezelter, Fri May 21 15:58:48 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.60 2004-05-21 15:58:40 gezelter Exp $, $Date: 2004-05-21 15:58:40 $, $Name: not supported by cvs2svn $, $Revision: 1.60 $
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_inner1: do jb = groupStart(j), groupStart(j+1)-1
517 <                         atom2 = groupList(jb)
518 <                        
519 <                         if (skipThisPair(atom1, atom2)) cycle prepair_inner1
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_inner1
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 <                      prepair_inner2: do jb = groupStart(j), groupStart(j+1)-1
551 <                         atom2 = groupList(jb)                        
552 <                        
553 <                         if (skipThisPair(atom1, atom2)) cycle prepair_inner2
554 <
555 <                         call get_interatomic_vector(q_Row(:,atom1), &
556 <                              q_Col(:,atom2), d_atm, ratmsq)
557 <                        
558 <                         call do_prepair(atom1, atom2, ratmsq, d_atm, &
559 <                              rgrpsq, d_grp, do_pot, do_stress, &
560 <                              u_l, A, f, t, pot_local)
561 <                        
562 <                      enddo prepair_inner2
563 <                   enddo
564 <                enddo
565 <             endif
566 <          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,
574 <          !! 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 600 | Line 546 | contains
546                     endif
547                    
548                     list(nlist) = j
603                  
604                   do ia = groupStart(i), groupStart(i+1)-1
605                      atom1 = groupList(ia)
606                      
607                      prepair_inner1: do jb = groupStart(j), groupStart(j+1)-1
608                         atom2 = groupList(jb)
609                        
610                         if (skipThisPair(atom1, atom2)) cycle prepair_inner1
611                        
612                         call get_interatomic_vector(q(:,atom1), &
613                              q(:,atom2), d_atm, ratmsq)
614                        
615                         call do_prepair(atom1, atom2, ratmsq, d_atm, &
616                              rgrpsq, d_grp, do_pot, do_stress, &
617                              u_l, A, f, t, pot)
618                        
619                      enddo prepair_inner1
620                   enddo
621                end if
622             enddo
623          enddo
624          point(nGroup) = nlist + 1          
625                          
626       else  !! (of update_check)
627          
628          ! use the list to find the neighbors
629          do i = 1, nGroup-1
630             JBEG = POINT(i)
631             JEND = POINT(i+1) - 1
632             ! check that group i has neighbors
633             if (jbeg .le. jend) then
634                
635                do jnab = jbeg, jend
636                   j = list(jnab)
637                  
638                   do ia = groupStart(i), groupStart(i+1)-1
639                      atom1 = groupList(ia)
640
641                      prepair_inner2: do jb = groupStart(j), groupStart(j+1)-1
642                         atom2 = groupList(jb)                        
643                        
644                         if (skipThisPair(atom1, atom2)) cycle prepair_inner2
645
646                         call get_interatomic_vector(q(:,atom1), &
647                              q(:,atom2), d_atm, ratmsq)
648                        
649                         call do_prepair(atom1, atom2, ratmsq, d_atm, &
650                              rgrpsq, d_grp, do_pot, do_stress, &
651                              u_l, A, f, t, pot)
652                        
653                      enddo prepair_inner2
654                   enddo
655                enddo
656             endif
657          enddo
658       endif
659      
660 #endif
661      
662       !! Do rest of preforce calculations
663       !! do necessary preforce calculations  
664       call do_preforce(nlocal,pot)
665       ! we have already updated the neighbor list set it to false...
666       update_nlist = .false.
667    else
668       !! See if we need to update neighbor lists for non pre-pair
669       call checkNeighborList(nGroup, q_group, listSkin, update_nlist)  
670    endif
671    
672    !---------------------------------MAIN Pair LOOP->>>>>>>>>>>>>
673    
674 #ifdef IS_MPI
675    
676    if (update_nlist) then
677      
678       !! save current configuration, construct neighbor list,
679       !! and calculate forces
680      
681       call saveNeighborList(nGroup, q_group)
682      
683       neighborListSize = size(list)
684       nlist = 0      
685      
686       do i = 1, nrow_group
687
688          point(i) = nlist + 1
689
690          n_in_i = groupStart(i+1) - groupStart(i)
691          
692          do j = 1, ncol_group
693            
694             call get_interatomic_vector(q_group_Row(:,i), &
695                  q_group_Col(:,j), d_grp, rgrpsq)
696            
697             if (rgrpsq < rlistsq) then
698                nlist = nlist + 1
699                
700                if (nlist > neighborListSize) then
701                   call expandNeighborList(nGroup, listerror)
702                   if (listerror /= 0) then
703                      error = -1
704                      write(DEFAULT_ERROR,*) "ERROR: nlist > list size and max allocations exceeded."
705                      return
706                   end if
707                   neighborListSize = size(list)
549                  endif
550                  
551 <                list(nlist) = j
552 <                
553 <                vij = 0.0d0
713 <
714 <                call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
715 <                     in_switching_region)
716 <
717 <                n_in_j = groupStart(j+1) - groupStart(j)
718 <                
719 <                do ia = groupStart(i), groupStart(i+1)-1
720 <                   atom1 = groupList(ia)
721 <                  
722 <                   inner1: do jb = groupStart(j), groupStart(j+1)-1
723 <                      atom2 = groupList(jb)                    
724 <
725 <                      if (skipThisPair(atom1, atom2)) cycle inner1
726 <                      
727 <                      if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
728 <                         d_atm(1:3) = d_grp(1:3)
729 <                         ratmsq = rgrpsq
730 <                      else
731 <                         call get_interatomic_vector(q_Row(:,atom1), &
732 <                              q_Col(:,atom2), d_atm, ratmsq)
733 <                      endif
734 <                      
735 <                      call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
736 <                           do_pot, do_stress, &
737 <                           u_l, A, f, t, pot_local, vpair)
738 <                      
739 <                      vij = vij + vpair
740 <                   enddo inner1
741 <                enddo
742 <
743 <                if (in_switching_region) then
744 <                   swderiv = vij*dswdr/rgrp
745 <                  
746 <                   do ia=groupStart(i), groupStart(i+1)-1
747 <                      atom1=groupList(ia)
748 <                      mf = mfact(atom1)                  
749 <                      f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf
750 <                      f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf
751 <                      f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf
752 <                   enddo
753 <                  
754 <                   do jb=groupStart(j), groupStart(j+1)-1
755 <                      atom2=groupList(jb)
756 <                      mf = mfact(atom2)
757 <                      f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf
758 <                      f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf
759 <                      f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf
760 <                   enddo                        
551 >                if (loop .eq. PAIR_LOOP) then
552 >                   vij = 0.0d0
553 >                   fij(1:3) = 0.0d0
554                  endif
762
763             end if
764          enddo
765       enddo
766
767       point(nrow_group + 1) = nlist + 1          
768      
769    else  !! (of update_check)
770      
771       ! use the list to find the neighbors
772       do i = 1, nrow_group
773
774          n_in_i = groupStart(i+1) - groupStart(i)
775          
776          JBEG = POINT(i)
777          JEND = POINT(i+1) - 1
778          ! check that group i has neighbors
779          if (jbeg .le. jend) then
780            
781             do jnab = jbeg, jend
782                j = list(jnab)
783                              
784                call get_interatomic_vector(q_group_Row(:,i), &
785                     q_group_Col(:,j), d_grp, rgrpsq)
555                  
787                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
794                   atom1 = groupList(ia)
562                    
796                   inner2: do jb = groupStart(j), groupStart(j+1)-1
797                      atom2 = groupList(jb)                        
798                      
799                      if (skipThisPair(atom1, atom2)) cycle inner2
800
801                      if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
802                         d_atm(1:3) = d_grp(1:3)
803                         ratmsq = rgrpsq
804                      else
805                         call get_interatomic_vector(q_Row(:,atom1), &
806                              q_Col(:,atom2), d_atm, ratmsq)
807                      endif
808                                            
809                      call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
810                           do_pot, do_stress, &
811                           u_l, A, f, t, pot_local, vpair)
812                      
813                      vij = vij + vpair
814                                            
815                   enddo inner2
816                enddo
817                
818                if (in_switching_region) then
819                   swderiv = vij*dswdr/rgrp
820  
821                   do ia=groupStart(i), groupStart(i+1)-1
822                      atom1=groupList(ia)
823                      mf = mfact(atom1)                  
824                      f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf
825                      f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf
826                      f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf
827                   enddo
828                  
829                   do jb=groupStart(j), groupStart(j+1)-1
830                      atom2=groupList(jb)
831                      mf = mfact(atom2)
832                      f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf
833                      f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf
834                      f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf
835                   enddo
836                endif
837
838             enddo
839          endif
840       enddo
841    endif
842    
843 #else
844
845    if (update_nlist) then
846      
847       !! save current configuration, construct neighbor list,
848       !! and calculate forces
849      
850       call saveNeighborList(nGroup, q_group)
851      
852       neighborListSize = size(list)
853       nlist = 0      
854      
855       do i = 1, nGroup-1
856
857          point(i) = nlist + 1
858          n_in_i = groupStart(i+1) - groupStart(i)
859          
860          do j = i+1, nGroup
861            
862             call get_interatomic_vector(q_group(:,i), &
863                  q_group(:,j), d_grp, rgrpsq)
864            
865             if (rgrpsq < rlistsq) then
866                nlist = nlist + 1
867                
868                if (nlist > neighborListSize) then
869                   call expandNeighborList(nGroup, listerror)
870                   if (listerror /= 0) then
871                      error = -1
872                      write(DEFAULT_ERROR,*) "ERROR: nlist > list size and max allocations exceeded."
873                      return
874                   end if
875                   neighborListSize = size(list)
876                endif
877                
878                list(nlist) = j
879
880                vij = 0.0d0
881
882                call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
883                     in_switching_region)
884                
885                n_in_j = groupStart(j+1) - groupStart(j)
886
887                do ia = groupStart(i), groupStart(i+1)-1
563                     atom1 = groupList(ia)
564                    
565 <                   inner1: do jb = groupStart(j), groupStart(j+1)-1
565 >                   inner: do jb = groupStart(j), groupStart(j+1)-1
566 >                      
567                        atom2 = groupList(jb)
568                        
569 <                      if (skipThisPair(atom1, atom2)) cycle inner1
569 >                      if (skipThisPair(atom1, atom2)) cycle inner
570                        
571                        if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
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)
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 (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 <                      vij = vij + vpair
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 <                   enddo inner1
631 <                enddo
632 <
633 <                if (in_switching_region) then
634 <                   swderiv = vij*dswdr/rgrp
635 <                   do ia=groupStart(i), groupStart(i+1)-1
636 <                      atom1=groupList(ia)
637 <                      mf = mfact(atom1)                  
638 <                      f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf
639 <                      f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf
640 <                      f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
641 <                   enddo
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
923 <                      atom2=groupList(jb)
924 <                      mf = mfact(atom2)
925 <                      f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf
926 <                      f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf
927 <                      f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf
928 <                   enddo
645 >                   if (do_stress) call add_stress_tensor(d_grp, fij)
646                  endif
930
647               end if
648            enddo
649 <       enddo
934 <       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
947 <            
948 <             do jnab = jbeg, jend
949 <                j = list(jnab)
950 <                
951 <                call get_interatomic_vector(q_group(:,i), &
952 <                     q_group(:,j), d_grp, rgrpsq)
953 <
954 <                vij = 0.0d0    
955 <                
956 <                call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
957 <                     in_switching_region)
958 <                
959 <                n_in_j = groupStart(j+1) - groupStart(j)
960 <                
961 <                do ia = groupStart(i), groupStart(i+1)-1
962 <                   atom1 = groupList(ia)
963 <                  
964 <                   inner2: do jb = groupStart(j), groupStart(j+1)-1
965 <                      atom2 = groupList(jb)                      
966 <
967 <                      if (skipThisPair(atom1, atom2)) cycle inner2
968 <                      
969 <                      if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
970 <                         d_atm(1:3) = d_grp(1:3)
971 <                         ratmsq = rgrpsq
972 <                      else
973 <                         call get_interatomic_vector(q(:,atom1), &
974 <                              q(:,atom2), d_atm, ratmsq)
975 <                      endif
976 <                      
977 <                      call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
978 <                           do_pot, do_stress, &
979 <                           u_l, A, f, t, pot, vpair)
980 <                      
981 <                      vij = vij + vpair
982 <                      
983 <                   enddo inner2
984 <                enddo
985 <                
986 <                if (in_switching_region) then
987 <                   swderiv = vij*dswdr/rgrp
988 <                  
989 <                   do ia=groupStart(i), groupStart(i+1)-1
990 <                      atom1=groupList(ia)
991 <                      mf = mfact(atom1)                  
992 <                      f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf
993 <                      f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf
994 <                      f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
995 <                   enddo
996 <                  
997 <                   do jb=groupStart(j), groupStart(j+1)-1
998 <                      atom2=groupList(jb)
999 <                      mf = mfact(atom2)
1000 <                      f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf
1001 <                      f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf
1002 <                      f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf
1003 <                   enddo
1004 <                endif
1005 <             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
665 <    
666 < #endif
667 <    
668 <    ! phew, done with main loop.
663 >       endif
664 >            
665 >       if (loop .eq. PREPAIR_LOOP) then
666 >          call do_preforce(nlocal, pot)
667 >       endif
668 >      
669 >    enddo
670      
671      !! Do timing
672   #ifdef PROFILE
# Line 1132 | Line 789 | contains
789      endif
790      
791   #endif
792 <    
1136 <    
792 >      
793    end subroutine do_force_loop
1138
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 1156 | 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 1177 | 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, &
1181 <               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 1186 | 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, &
1190 <               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 1195 | 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 1208 | 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 1218 | 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 1227 | 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 1264 | 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 1276 | 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 <
1290 <
1291 <
944 >
945 >
946   subroutine do_preforce(nlocal,pot)
947     integer :: nlocal
948     real( kind = dp ) :: pot
# Line 1501 | 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