bugfix in shield FGPROC>1
[unres.git] / source / unres / src_MD-M / energy_split-sep.F
index 24ab8dd..f79deea 100644 (file)
@@ -25,6 +25,8 @@ cMS$ATTRIBUTES C ::  proc_proc
       include 'COMMON.VAR'
       include 'COMMON.LOCAL'
       include 'COMMON.MD'
+      include 'COMMON.CONTROL'
+      include 'COMMON.SHIELD'
 c      write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
       if (modecalc.eq.12.or.modecalc.eq.14) then
 #ifdef MPI
@@ -132,6 +134,60 @@ C Calculate electrostatic (H-bonding) energy of the main chain.
 C
   107 continue
       call vec_and_deriv
+      if (shield_mode.eq.1) then
+       call set_shield_fac
+      else if  (shield_mode.eq.2) then
+       call set_shield_fac2
+      if (nfgtasks.gt.1) then
+C#define DEBUG
+#ifdef DEBUG
+       write(iout,*) "befor reduce fac_shield reduce"
+       do i=1,nres
+        write(2,*) "fac",itype(i),fac_shield(i),grad_shield(1,i)
+        write(2,*) "list", shield_list(1,i),ishield_list(i),
+     &  grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
+       enddo
+#endif
+       call MPI_Allgatherv(fac_shield(ivec_start),ivec_count(fg_rank1),
+     &  MPI_DOUBLE_PRECISION,fac_shield(1),ivec_count(0),ivec_displ(0),
+     &  MPI_DOUBLE_PRECISION,FG_COMM,IERR)
+       call MPI_Allgatherv(shield_list(1,ivec_start),
+     &  ivec_count(fg_rank1),
+     &  MPI_I50,shield_list(1,1),ivec_count(0),
+     &  ivec_displ(0),
+     &  MPI_I50,FG_COMM,IERR)
+       call MPI_Allgatherv(ishield_list(ivec_start),
+     &  ivec_count(fg_rank1),
+     &  MPI_INTEGER,ishield_list(1),ivec_count(0),
+     &  ivec_displ(0),
+     &  MPI_INTEGER,FG_COMM,IERR)
+       call MPI_Allgatherv(grad_shield(1,ivec_start),
+     &  ivec_count(fg_rank1),
+     &  MPI_UYZ,grad_shield(1,1),ivec_count(0),
+     &  ivec_displ(0),
+     &  MPI_UYZ,FG_COMM,IERR)
+       call MPI_Allgatherv(grad_shield_side(1,1,ivec_start),
+     &  ivec_count(fg_rank1),
+     &  MPI_SHI,grad_shield_side(1,1,1),ivec_count(0),
+     &  ivec_displ(0),
+     &  MPI_SHI,FG_COMM,IERR)
+       call MPI_Allgatherv(grad_shield_loc(1,1,ivec_start),
+     &  ivec_count(fg_rank1),
+     &  MPI_SHI,grad_shield_loc(1,1,1),ivec_count(0),
+     &  ivec_displ(0),
+     &  MPI_SHI,FG_COMM,IERR)
+#ifdef DEBUG
+       write(iout,*) "after reduce fac_shield reduce"
+       do i=1,nres
+        write(2,*) "fac",itype(i),fac_shield(i),grad_shield(1,i)
+        write(2,*) "list", shield_list(1,i),ishield_list(i),
+     &  grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
+       enddo
+#endif
+C#undef DEBUG
+      endif
+
+      endif
       if (ipot.lt.6) then
 #ifdef SPLITELE
          if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
@@ -190,7 +246,12 @@ c     &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
       if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
          call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
       endif
-C 
+C
+C      if (wliptran.gt.0) then
+C        call Eliptransfer(eliptran)
+C      else
+C       eliptran=0.0d0
+C      endif 
 C If performing constraint dynamics, call the constraint energy
 C  after the equilibration time
       if(usampl.and.totT.gt.eq_time) then
@@ -230,8 +291,9 @@ C
       energia(10)=eturn6
       energia(20)=Uconst+Uconst_back
       call sum_energy(energia,.true.)
-c      write (iout,*) "Exit ETOTAL_LONG"
-      call flush(iout)
+C      call enerprint
+C      write (iout,*) "Exit ETOTAL_LONG"
+C      call flush(iout)
       return
       end
 c------------------------------------------------------------------------------
@@ -261,7 +323,8 @@ cMS$ATTRIBUTES C ::  proc_proc
       include 'COMMON.CHAIN'
       include 'COMMON.VAR'
       include 'COMMON.LOCAL'
-
+      include 'COMMON.CONTROL'
+      include 'COMMON.SHIELD'
 c      write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
 c      call flush(iout)
       if (modecalc.eq.12.or.modecalc.eq.14) then
@@ -393,6 +456,87 @@ C
 C Calculate electrostatic (H-bonding) energy of the main chain.
 C
   107 continue
+C     call vec_and_deriv
+C     if (shield_mode.eq.1) then
+C       call set_shield_fac
+C      else if  (shield_mode.eq.2) then
+C       call set_shield_fac2
+C      if (nfgtasks.gt.1) then
+C#define DEBUG
+C#ifdef DEBUG
+C       write(iout,*) "befor reduce fac_shield reduce"
+C       do i=1,nres
+C        write(2,*) "fac",itype(i),fac_shield(i),grad_shield(1,i)
+C        write(2,*) "list", shield_list(1,i),ishield_list(i),
+C     &  grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
+C       enddo
+C#endif
+C       call MPI_Allgatherv(fac_shield(ivec_start),ivec_count(fg_rank1),
+C     &  MPI_DOUBLE_PRECISION,fac_shield(1),ivec_count(0),ivec_displ(0),
+C     &  MPI_DOUBLE_PRECISION,FG_COMM,IERR)
+C       call MPI_Allgatherv(shield_list(1,ivec_start),
+C     &  ivec_count(fg_rank1),
+C     &  MPI_I50,shield_list(1,1),ivec_count(0),
+C     &  ivec_displ(0),
+C     &  MPI_I50,FG_COMM,IERR)
+C       call MPI_Allgatherv(ishield_list(ivec_start),
+C     &  ivec_count(fg_rank1),
+C     &  MPI_INTEGER,ishield_list(1),ivec_count(0),
+C     &  ivec_displ(0),
+C     &  MPI_INTEGER,FG_COMM,IERR)
+C       call MPI_Allgatherv(grad_shield(1,ivec_start),
+C     &  ivec_count(fg_rank1),
+C     &  MPI_UYZ,grad_shield(1,1),ivec_count(0),
+C     &  ivec_displ(0),
+C     &  MPI_UYZ,FG_COMM,IERR)
+C       call MPI_Allgatherv(grad_shield_side(1,1,ivec_start),
+C     &  ivec_count(fg_rank1),
+C     &  MPI_SHI,grad_shield_side(1,1,1),ivec_count(0),
+C     &  ivec_displ(0),
+C     &  MPI_SHI,FG_COMM,IERR)
+C       call MPI_Allgatherv(grad_shield_loc(1,1,ivec_start),
+C     &  ivec_count(fg_rank1),
+C     &  MPI_SHI,grad_shield_loc(1,1,1),ivec_count(0),
+C     &  ivec_displ(0),
+C     &  MPI_SHI,FG_COMM,IERR)
+C#ifdef DEBUG
+C       write(iout,*) "after reduce fac_shield reduce"
+C       do i=1,nres
+C        write(2,*) "fac",itype(i),fac_shield(i),grad_shield(1,i)
+C        write(2,*) "list", shield_list(1,i),ishield_list(i),
+C     &  grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
+C       enddo
+C#endif
+C#undef DEBUG
+C      endif
+C
+C      endif
+C      if (ipot.lt.6) then
+C#ifdef SPLITELE
+C         if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
+C     &       wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
+C     &       .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
+C     &       .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
+C#else
+C         if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
+C     &       wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
+C     &       .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
+C     &       .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
+C#endif
+C           call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
+C         else
+C            ees=0
+C            evdw1=0
+C            eel_loc=0
+C            eello_turn3=0
+C            eello_turn4=0
+C         endif
+C      else
+c        write (iout,*) "Soft-spheer ELEC potential"
+C        call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
+C     &   eello_turn4)
+C      endif
+
 c
 c Calculate the short-range part of Evdwpp
 c
@@ -414,7 +558,7 @@ C from other distance constraints.
 C
 C Calculate the virtual-bond-angle energy.
 C
-      call ebend(ebe)
+      call ebend(ebe,ethetcnstr)
 C
 C Calculate the SC local energy.
 C
@@ -436,6 +580,12 @@ C
       else
         esccor=0.0d0
       endif
+      if (wliptran.gt.0) then
+        call Eliptransfer(eliptran)
+      else
+       eliptran=0.0d0
+      endif
+C       print *,eliptran,wliptran
 C
 C Put energy components into an array
 C
@@ -451,10 +601,19 @@ C
       energia(18)=0.0d0
 #endif
 #ifdef SPLITELE
+      energia(3)=ees
       energia(16)=evdw1
 #else
-      energia(3)=evdw1
+      energia(3)=ees+evdw1
+      energia(16)=0.0d0
 #endif
+      energia(4)=ecorr
+      energia(5)=ecorr5
+      energia(6)=ecorr6
+      energia(7)=eel_loc
+      energia(8)=eello_turn3
+      energia(9)=eello_turn4
+
       energia(11)=ebe
       energia(12)=escloc
       energia(13)=etors
@@ -463,10 +622,11 @@ C
       energia(17)=estr
       energia(19)=edihcnstr
       energia(21)=esccor
-c      write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
+      energia(22)=eliptran
+C      write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
       call flush(iout)
       call sum_energy(energia,.true.)
-c      write (iout,*) "Exit ETOTAL_SHORT"
-      call flush(iout)
+C      write (iout,*) "Exit ETOTAL_SHORT"
+C      call flush(iout)
       return
       end