adding contact map
authorAdam Sieradzan <adasko@piasek4.chem.univ.gda.pl>
Tue, 3 Mar 2020 07:51:56 +0000 (08:51 +0100)
committerAdam Sieradzan <adasko@piasek4.chem.univ.gda.pl>
Tue, 3 Mar 2020 07:51:56 +0000 (08:51 +0100)
source/unres/MD.F90
source/unres/MREMD.F90
source/unres/data/MD_data.F90
source/unres/energy.F90
source/unres/geometry.F90
source/unres/io_config.F90

index 3d540f5..e3aea93 100644 (file)
 !el      external ilen
       character(len=50) :: tytul
 !el      common /gucio/ cm
-      integer :: itime,i,j,nharp
+      integer :: i,j,nharp
       integer,dimension(4,nres/3) :: iharp     !(4,nres/3)(4,maxres/3)
 !      logical :: ovrtim
       real(kind=8) :: tt0,scalfac
-      integer :: nres2
+      integer :: nres2,itime
       nres2=2*nres
       print *, "ENTER MD"
 !
           stop
 #endif
         endif
+        itime_mat=itime
         if (ntwe.ne.0) then
          if (mod(itime,ntwe).eq.0) then
             call statout(itime)
 !el      common /gucio/ cm
 !el      real(kind=8),dimension(6*nres) :: stochforcvec        !(MAXRES6) maxres6=6*maxres
 !el      common /stochcalc/ stochforcvec
-      integer :: itime,icount_scale,itime_scal,i,j,ifac_time,iretcode
+      integer :: icount_scale,itime_scal,i,j,ifac_time,iretcode,itime
       logical :: scalel
       real(kind=8) :: epdrift,tt0,fac_time
 !
         call etotal(potEcomp)
 ! AL 4/17/17: Reduce the steps if NaNs occurred.
         if (potEcomp(0).gt.0.99e18 .or. isnan(potEcomp(0)).gt.0) then
+          call enerprint(potEcomp)
           d_time=d_time/10.0
           if (icount_scale.gt.15) then
           write (iout,*) "Tu jest problem",potEcomp(0),d_time
 !el      common /gucio/ cm
 !el      real(kind=8),dimension(6*nres) :: stochforcvec        !(MAXRES6) maxres6=6*maxres
 !el      common /stochcalc/ stochforcvec
-      integer :: itime,itt,i,j,itsplit
+      integer :: itt,i,j,itsplit,itime
       logical :: scale
 !el      common /cipiszcze/ itt
 
       character(len=50) :: tytul
       logical :: file_exist
 !el      common /gucio/ cm
-      integer :: i,j,ipos,iq,iw,nft_sc,iretcode,nfun,itime,ierr,mnum
+      integer :: i,j,ipos,iq,iw,nft_sc,iretcode,nfun,ierr,mnum,itime
       real(kind=8) :: etot,tt0
       logical :: fail
 
       potE=potEcomp(0)-potEcomp(20)
       totE=EK+potE
       itime=0
+      itime_mat=itime
       if (ntwe.ne.0) call statout(itime)
       if(me.eq.king.or..not.out1file) &
         write (iout,'(/a/3(a25,1pe14.5/))') "Initial:", &
index e662e63..75062ed 100644 (file)
@@ -85,7 +85,7 @@
 
       real(kind=8) :: remd_t_bath(Nprocs) !(maxprocs)
       integer :: iremd_iset(Nprocs) !(maxprocs)
-      integer(kind=2) :: i_index(Nprocs,Nprocs,Nprocs,Nprocs)
+      integer(kind=2) :: i_index(Nprocs/2,Nprocs/2,Nprocs/10,Nprocs/10)
 ! (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200)
       real(kind=8) :: remd_ene(0:n_ene+4,Nprocs) !(0:n_ene+4,maxprocs)
       integer :: iremd_acc(Nprocs),iremd_tot(Nprocs) !(maxprocs)
@@ -94,7 +94,7 @@
 !el      external ilen
       character(len=50) :: tytul
 !el      common /gucio/ cm
-      integer :: itime
+!      integer :: itime
 !old      integer nup(0:maxprocs),ndown(0:maxprocs)
       integer :: rep2i(0:Nprocs),ireqi(Nprocs) !(maxprocs)
       integer :: icache_all(Nprocs) !(maxprocs)
                  econstr_temp_iex
       integer :: k,il,il1,i,j,nharp,ii,ierr,itime_master,irr,iex,&
             i_set_temp,itmp,i_temp,i_mult,i_iset,i_mset,i_dir,i_temp1,&
-            i_mult1,i_iset1,i_mset1,ierror
+            i_mult1,i_iset1,i_mset1,ierror,itime
       integer,dimension(4,nres/3) :: iharp     !(4,nres/3)(4,maxres/3)
 !deb      imin_itime_old=0
       integer :: nres2 !el
       tt0=tcpu()
 #endif
       itime=0
+      itime_mat=itime
       end_of_run=.false.
 
       do while(.not.end_of_run)
         itime=itime+1
+        itime_mat=itime
         if(itime.eq.n_timestep.and.me.eq.king) end_of_run=.true.
         if(mremdsync.and.itime.eq.n_timestep) end_of_run=.true.
         rstcount=rstcount+1
           stop
 #endif
         endif
+        itime_mat=itime
         if(ntwe.ne.0) then
           if (mod(itime,ntwe).eq.0) then
               call statout(itime)
index 3273cfc..155b1eb 100644 (file)
@@ -39,7 +39,7 @@
 !      common /back_constr/ in module.energy
 !      common /qmeas/ others in module.geometry
       real(kind=8) :: eq_time
-      integer :: iset,nset
+      integer :: iset,nset,itime_mat
       integer,dimension(:),allocatable :: mset !(maxprocs/20)
       logical :: usampl
 !      common /mdpar/
index 1e0ed70..4ae8d1b 100644 (file)
 !      include 'COMMON.TIME1'
       real(kind=8) :: time00
 !el local variables
-      integer :: n_corr,n_corr1,ierror
+      integer :: n_corr,n_corr1,ierror,imatupdate
       real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
       real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
       real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, &
 
        integer ishield_listbuf(-1:nres), &
        shield_listbuf(maxcontsshi,-1:nres),k,j,i,iii,impishi,mojint,jjj
-
-
+!       print *,"I START ENERGY"
+       imatupdate=1
+!       if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list
 !      real(kind=8),  dimension(:),allocatable::  fac_shieldbuf 
 !      real(kind=8), dimension(:,:,:),allocatable:: &
 !       grad_shield_locbuf,grad_shield_sidebuf
         time_Bcastw=time_Bcastw+MPI_Wtime()-time00
 !        call chainbuild_cart
       endif
+!       if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list
+
 !      print *,'Processor',myrank,' calling etotal ipot=',ipot
 !      print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
 #else
        eespp=0.0d0
       endif
 !      write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
-!      print *,"before ecatcat",wcatcat
+      print *,"before ecatcat",wcatcat
       if (nfgtasks.gt.1) then
       if (fg_rank.eq.0) then
       call ecatcat(ecationcation)
       enddo
 #endif
 !#undef DEBUG
-        do i=1,nres
+        do i=0,nres
          do j=1,3
           gloc_scbuf(j,i)=gloc_sc(j,i,icg)
          enddo
         call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
           MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
         time_reduce=time_reduce+MPI_Wtime()-time00
-        call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
+        call MPI_Reduce(gloc_scbuf(1,0),gloc_sc(1,0,icg),3*nres+3,&
           MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
         time_reduce=time_reduce+MPI_Wtime()-time00
 !#define DEBUG
 !          print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
 #ifdef DEBUG
       write (iout,*) "gloc_sc after reduce"
-      do i=1,nres
+      do i=0,nres
        do j=1,1
         write (iout,*) i,j,gloc_sc(j,i,icg)
        enddo
 !#define DEBUG
 !el      write (iout,*) "After sum_gradient"
 #ifdef DEBUG
-!el      write (iout,*) "After sum_gradient"
+      write (iout,*) "After sum_gradient"
       do i=1,nres-1
         write (iout,*) i," gradc  ",(gradc(j,i,icg),j=1,3)
         write (iout,*) i," gradx  ",(gradx(j,i,icg),j=1,3)
               dphi(j,1,i)=0.0d0
               dphi(j,2,i)=0.0d0
               dphi(j,3,i)=0.0d0
+              dcosomicron(j,1,1,i)=0.0d0
+              dcosomicron(j,1,2,i)=0.0d0
+              dcosomicron(j,2,1,i)=0.0d0
+              dcosomicron(j,2,2,i)=0.0d0
             enddo
             enddo
       ! Derivatives of theta's
 #else
             do i=3,nres
 #endif
-            if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
+            if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1).and.molnum(i).ne.5) then
             cost1=dcos(omicron(1,i))
             sint1=sqrt(1-cost1*cost1)
             cost2=dcos(omicron(2,i))
         xi=c(1,i)
         yi=c(2,i)
         zi=c(3,i)
+!        write (iout,*) i,"TUTUT",c(1,i)
           itypi=itype(i,5)
           xi=mod(xi,boxxsize)
           if (xi.lt.0) xi=xi+boxxsize
 
           do j=i+1,itmp+nres_molec(5)
           itypj=itype(j,5)
+!          print *,i,j,itypi,itypj
           k0 = 332.0*(ichargecat(itypi)*ichargecat(itypj))/80.0
 !           print *,i,j,'catcat'
            xj=c(1,j)
         do i=1,4
         itmp=itmp+nres_molec(i)
         enddo
-        go to 17
+!        go to 17
 !        do i=1,nres_molec(1)-1  ! loop over all peptide groups needs parralelization
         do i=ibond_start,ibond_end
 
 ! tail location and distance calculations
 ! dhead1
        d1 = dheadcat(1, 1, itypi, itypj)
+!       print *,"d1",d1
+!       d1=0.0d0
 !       d2 = dhead(2, 1, itypi, itypj)
        DO k = 1,3
 ! location of polar head is computed by taking hydrophobic centre
           - 2.0d0 * chis12 * om1 * om2 * om12
           
           pom = 1.0d0 - chis1 * chis2 * sqom12
-          print *,"TUT2",fac,chis1,sqom1,pom
+!          print *,"TUT2",fac,chis1,sqom1,pom
           Lambf = (1.0d0 - (fac / pom))
           Lambf = dsqrt(Lambf)
           sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
            CALL edq_cat_pep(ecl, elj, epol)
            eheadtail = ECL + elj + epol
 !          print *,"i,",i,eheadtail
-           eheadtail = 0.0d0
+!           eheadtail = 0.0d0
 
         evdw = evdw  + Fcav + eheadtail
 
 !c! ecl
        sparrow  = w1 * Qj * om1
        hawk     = w2 * Qj * Qj * (1.0d0 - sqom2)
+!       print *,"CO2", itypi,itypj
 !       print *,"CO?!.", w1,w2,Qj,om1
        ECL = sparrow / Rhead**2.0d0 &
            - hawk    / Rhead**4.0d0
         erhead(k) = Rhead_distance(k)/Rhead
         erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
        END DO
-       erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
+       erdxi = scalar( erhead(1), dC_norm(1,i) )
        erdxj = scalar( erhead(1), dC_norm(1,j) )
        eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
-       adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
+       adler = scalar( erhead_tail(1,2), dC_norm(1,i) )
        facd1 = d1 * vbld_inv(i+1)/2.0
        facd2 = d2 * vbld_inv(j)
-       facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
+       facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+1)/2.0
        DO k = 1, 3
         condor = (erhead_tail(k,2) &
        + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
 
-        pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+        pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i))
 !        gradpepcatx(k,i) = gradpepcatx(k,i) &
 !                  - dGCLdR * pom &
 !                  - dPOLdR2 * (erhead_tail(k,2) &
       return
       end function gradtschebyshev
 
+      subroutine make_SCSC_inter_list
+      include 'mpif.h'
+      real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+      real*8 :: dist_init, dist_temp,r_buff_list
+      integer:: contlisti(50*nres),contlistj(50*nres)
+      integer :: newcontlisti(50*nres),newcontlistj(50*nres) 
+      integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_sc,g_ilist_sc
+      integer displ(0:nprocs),i_ilist_sc(0:nprocs),ierr
+!            print *,"START make_SC"
+            ilist_sc=0
+            do i=iatsc_s,iatsc_e
+             itypi=iabs(itype(i,1))
+             if (itypi.eq.ntyp1) cycle
+             xi=c(1,nres+i)
+             yi=c(2,nres+i)
+             zi=c(3,nres+i)
+             xi=dmod(xi,boxxsize)
+             if (xi.lt.0) xi=xi+boxxsize
+             yi=dmod(yi,boxysize)
+             if (yi.lt.0) yi=yi+boxysize
+             zi=dmod(zi,boxzsize)
+             if (zi.lt.0) zi=zi+boxzsize
+             do iint=1,nint_gr(i)
+              do j=istart(i,iint),iend(i,iint)
+               itypj=iabs(itype(j,1))
+               if (itypj.eq.ntyp1) cycle
+               xj=c(1,nres+j)
+               yj=c(2,nres+j)
+               zj=c(3,nres+j)
+               xj=dmod(xj,boxxsize)
+               if (xj.lt.0) xj=xj+boxxsize
+               yj=dmod(yj,boxysize)
+               if (yj.lt.0) yj=yj+boxysize
+               zj=dmod(zj,boxzsize)
+               if (zj.lt.0) zj=zj+boxzsize
+               dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+               xj_safe=xj
+               yj_safe=yj
+               zj_safe=zj
+               subchap=0
+               do xshift=-1,1
+               do yshift=-1,1
+               do zshift=-1,1
+               xj=xj_safe+xshift*boxxsize
+               yj=yj_safe+yshift*boxysize
+               zj=zj_safe+zshift*boxzsize
+               dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+               if(dist_temp.lt.dist_init) then
+                dist_init=dist_temp
+                xj_temp=xj
+                yj_temp=yj
+                zj_temp=zj
+                subchap=1
+               endif
+               enddo
+               enddo
+               enddo
+               if (subchap.eq.1) then
+               xj=xj_temp-xi
+               yj=yj_temp-yi
+               zj=zj_temp-zi
+               else
+               xj=xj_safe-xi
+               yj=yj_safe-yi
+               zj=zj_safe-zi
+               endif
+! r_buff_list is a read value for a buffer 
+               if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+                 ilist_sc=ilist_sc+1
+! this can be substituted by cantor and anti-cantor
+                 contlisti(ilist_sc)=i
+                 contlistj(ilist_sc)=j
+
+               endif
+             enddo
+             enddo
+             enddo
+!         call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
+!          MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+!        call MPI_Gather(newnss,1,MPI_INTEGER,&
+!                        i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
+#ifdef DEBUG
+      write (iout,*) "before MPIREDUCE",ilist_sc
+      do i=1,ilist_sc
+      write (iout,*) i,contlisti(i),contlistj(i)
+      enddo
+#endif
+      if (nfgtasks.gt.1)then
+
+        call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
+          MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+!        write(iout,*) "before bcast",g_ilist_sc
+        call MPI_Gather(ilist_sc,1,MPI_INTEGER,&
+                        i_ilist_sc,1,MPI_INTEGER,king,FG_COMM,IERR)
+        displ(0)=0
+        do i=1,nfgtasks-1,1
+          displ(i)=i_ilist_sc(i-1)+displ(i-1)
+        enddo
+!        write(iout,*) "before gather",displ(0),displ(1)        
+        call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER,&
+                         newcontlisti,i_ilist_sc,displ,MPI_INTEGER,&
+                         king,FG_COMM,IERR)
+        call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER,&
+                         newcontlistj,i_ilist_sc,displ,MPI_INTEGER,&
+                         king,FG_COMM,IERR)
+        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR)
+!        write(iout,*) "before bcast",g_ilist_sc
+!        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+        call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM,IERR)
+        call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,IERR)
+
+!        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+
+        else
+        g_ilist_sc=ilist_sc
+
+        do i=1,ilist_sc
+        newcontlisti(i)=contlisti(i)
+        newcontlistj(i)=contlistj(i)
+        enddo
+        endif
+      
+#ifdef DEBUG
+      write (iout,*) "after MPIREDUCE",g_ilist_sc
+      do i=1,g_ilist_sc
+      write (iout,*) i,newcontlisti(i),newcontlistj(i)
+      enddo
+#endif
+
+      return
+      end subroutine make_SCSC_inter_list
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      subroutine make_SCp_inter_list
+      include 'mpif.h'
+      real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+      real*8 :: dist_init, dist_temp,r_buff_list
+      integer:: contlistscpi(50*nres),contlistscpj(50*nres)
+      integer :: newcontlistscpi(50*nres),newcontlistscpj(50*nres)
+      integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_scp,g_ilist_scp
+      integer displ(0:nprocs),i_ilist_scp(0:nprocs),ierr
+            print *,"START make_SC"
+            ilist_scp=0
+      do i=iatscp_s,iatscp_e
+        if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
+        xi=0.5D0*(c(1,i)+c(1,i+1))
+        yi=0.5D0*(c(2,i)+c(2,i+1))
+        zi=0.5D0*(c(3,i)+c(3,i+1))
+          xi=mod(xi,boxxsize)
+          if (xi.lt.0) xi=xi+boxxsize
+          yi=mod(yi,boxysize)
+          if (yi.lt.0) yi=yi+boxysize
+          zi=mod(zi,boxzsize)
+          if (zi.lt.0) zi=zi+boxzsize
 
+        do iint=1,nscp_gr(i)
 
+        do j=iscpstart(i,iint),iscpend(i,iint)
+          itypj=iabs(itype(j,1))
+          if (itypj.eq.ntyp1) cycle
+! Uncomment following three lines for SC-p interactions
+!         xj=c(1,nres+j)-xi
+!         yj=c(2,nres+j)-yi
+!         zj=c(3,nres+j)-zi
+! Uncomment following three lines for Ca-p interactions
+!          xj=c(1,j)-xi
+!          yj=c(2,j)-yi
+!          zj=c(3,j)-zi
+          xj=c(1,j)
+          yj=c(2,j)
+          zj=c(3,j)
+          xj=mod(xj,boxxsize)
+          if (xj.lt.0) xj=xj+boxxsize
+          yj=mod(yj,boxysize)
+          if (yj.lt.0) yj=yj+boxysize
+          zj=mod(zj,boxzsize)
+          if (zj.lt.0) zj=zj+boxzsize
+      dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+      xj_safe=xj
+      yj_safe=yj
+      zj_safe=zj
+      subchap=0
+      do xshift=-1,1
+      do yshift=-1,1
+      do zshift=-1,1
+          xj=xj_safe+xshift*boxxsize
+          yj=yj_safe+yshift*boxysize
+          zj=zj_safe+zshift*boxzsize
+          dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+          if(dist_temp.lt.dist_init) then
+            dist_init=dist_temp
+            xj_temp=xj
+            yj_temp=yj
+            zj_temp=zj
+            subchap=1
+          endif
+       enddo
+       enddo
+       enddo
+       if (subchap.eq.1) then
+          xj=xj_temp-xi
+          yj=yj_temp-yi
+          zj=zj_temp-zi
+       else
+          xj=xj_safe-xi
+          yj=yj_safe-yi
+          zj=zj_safe-zi
+       endif
+! r_buff_list is a read value for a buffer 
+               if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+                 ilist_scp=ilist_scp+1
+! this can be substituted by cantor and anti-cantor
+                 contlistscpi(ilist_scp)=i
+                 contlistscpj(ilist_scp)=j
+              endif
+             enddo
+             enddo
+             enddo
+#ifdef DEBUG
+      write (iout,*) "before MPIREDUCE",ilist_scp
+      do i=1,ilist_scp
+      write (iout,*) i,contlistscpi(i),contlistscpj(i)
+      enddo
+#endif
+      if (nfgtasks.gt.1)then
+
+        call MPI_Reduce(ilist_scp,g_ilist_scp,1,&
+          MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+!        write(iout,*) "before bcast",g_ilist_sc
+        call MPI_Gather(ilist_scp,1,MPI_INTEGER,&
+                        i_ilist_scp,1,MPI_INTEGER,king,FG_COMM,IERR)
+        displ(0)=0
+        do i=1,nfgtasks-1,1
+          displ(i)=i_ilist_scp(i-1)+displ(i-1)
+        enddo
+!        write(iout,*) "before gather",displ(0),displ(1)
+        call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER,&
+                         newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER,&
+                         king,FG_COMM,IERR)
+        call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER,&
+                         newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER,&
+                         king,FG_COMM,IERR)
+        call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR)
+!        write(iout,*) "before bcast",g_ilist_sc
+!        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+        call MPI_Bcast(newcontlistscpi,g_ilist_scp,MPI_INT,king,FG_COMM,IERR)
+        call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM,IERR)
+
+!        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+
+        else
+        g_ilist_scp=ilist_scp
+
+        do i=1,ilist_scp
+        newcontlistscpi(i)=contlistscpi(i)
+        newcontlistscpj(i)=contlistscpj(i)
+        enddo
+        endif
+
+#ifdef DEBUG
+      write (iout,*) "after MPIREDUCE",g_ilist_scp
+      do i=1,g_ilist_scp
+      write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i)
+      enddo
+#endif
+      return
+      end subroutine make_SCp_inter_list
+
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
 
 
       end module energy
index eb84c8d..797180b 100644 (file)
        do j=1,3
          gcart(j,1)=gcart(j,1)+gloc(1,icg)*dphi(j,1,4) &
            +gloc(nres-2,icg)*dtheta(j,1,3)      
+!         write(iout,*) "pierwszy gcart", gcart(j,2)
           if ((itype(2,1).ne.10).and.&
-          (itype(2,molnum(2)).ne.ntyp1_molec(molnum(2)))) then
+          (itype(2,molnum(2)).ne.ntyp1_molec(molnum(2)).and.(molnum(2).ne.5))) then
           gcart(j,1)=gcart(j,1)+gloc(ialph(2,1),icg)*dalpha(j,1,2)+ &
           gloc(ialph(2,1)+nside,icg)*domega(j,1,2)             
         endif
        do j=1,3
          gcart(j,2)=gcart(j,2)+gloc(1,icg)*dphi(j,2,4)+ &
         gloc(nres-2,icg)*dtheta(j,2,3)+gloc(nres-1,icg)*dtheta(j,1,4)
-        if(itype(2,1).ne.10) then
+!         write(iout,*) "drugi gcart", gcart(j,2)
+        if((itype(2,1).ne.10).and.(molnum(2).ne.5)) then
           gcart(j,2)=gcart(j,2)+gloc(ialph(2,1),icg)*dalpha(j,2,2)+ &
           gloc(ialph(2,1)+nside,icg)*domega(j,2,2)
         endif
 !   The side-chain vector derivatives
         do i=2,nres-1
          if(itype(i,1).ne.10 .and.  &
-           itype(i,molnum(i)).ne.ntyp1_molec(molnum(i))) then  
+           itype(i,molnum(i)).ne.ntyp1_molec(molnum(i)).and.&
+             (molnum(i).ne.5)) then    
             do j=1,3   
               gxcart(j,i)=gxcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,3,i) &
               +gloc(ialph(i,1)+nside,icg)*domega(j,3,i)
 ! INTERTYP=3 SC...Ca...Ca...SC
 !   calculating dE/ddc1      
   18   continue
+!         write(iout,*) "przed sccor gcart", gcart(1,2)
+
 !       do i=1,nres
 !       gloc(i,icg)=0.0D0
 !          write (iout,*) "poczotkoawy",i,gloc_sc(1,i,icg)
        if (nres.lt.2) return
        if ((nres.lt.3).and.(itype(1,1).eq.10)) return
        if ((itype(1,1).ne.10).and. &
-        (itype(1,molnum(1)).ne.ntyp1_molec(molnum(1)))) then
+        (itype(1,molnum(1)).ne.ntyp1_molec(molnum(1))).and.(molnum(1).ne.5)) then
         do j=1,3
 !c Derviative was calculated for oposite vector of side chain therefore
 ! there is "-" sign before gloc_sc
          gcart(j,1)=gcart(j,1)+gloc_sc(1,0,icg)* &
            dtauangle(j,1,2,3)
           if ((itype(2,1).ne.10).and. &
-        (itype(2,molnum(2)).ne.ntyp1_molec(molnum(2)))) then
+        (itype(2,molnum(2)).ne.ntyp1_molec(molnum(2))).and.(molnum(2).ne.5)) then
          gxcart(j,1)= gxcart(j,1) &
                      -gloc_sc(3,0,icg)*dtauangle(j,3,1,3)
          gcart(j,1)=gcart(j,1)+gloc_sc(3,0,icg)* &
 !   ommited 
 !     &     +gloc_sc(intertyp,nres-2,icg)*dtheta(j,1,3)  
 
+!         write(iout,*) "przed dE/ddc2 gcart", gcart(1,2)
+
 !     Calculating the remainder of dE/ddc2
        do j=1,3
          if((itype(2,1).ne.10).and. &
-           (itype(2,molnum(2)).ne.ntyp1_molec(molnum(2)))) then
+           (itype(2,molnum(2)).ne.ntyp1_molec(molnum(2)).and.(molnum(2).ne.5))) then
            if ((itype(1,1).ne.10).and.&
-              ((itype(1,molnum(1)).ne.ntyp1_molec(molnum(1)))))&
+              ((itype(1,molnum(1)).ne.ntyp1_molec(molnum(1)))).and.(molnum(1).ne.5))&
             gxcart(j,2)=gxcart(j,2)+ &
                                gloc_sc(3,0,icg)*dtauangle(j,3,3,3)
-        if ((itype(3,1).ne.10).and.(nres.ge.3).and.(itype(3,molnum(3)).ne.ntyp1_molec(3))) &
+        if ((itype(3,1).ne.10).and.(nres.ge.3).and.(itype(3,molnum(3)).ne.ntyp1_molec(3)).and.molnum(3).ne.5) &
          then
            gxcart(j,2)=gxcart(j,2)-gloc_sc(3,1,icg)*dtauangle(j,3,1,4)
 !c                  the   - above is due to different vector direction
            gxcart(j,2)=gxcart(j,2)-gloc_sc(1,1,icg)*dtauangle(j,1,1,4)
 !c                  the   - above is due to different vector direction
            gcart(j,2)=gcart(j,2)+gloc_sc(1,1,icg)*dtauangle(j,1,2,4)
-!          write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,2,4),"gcart"
+          write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,2,4),"gcart",gcart(j,2)
 !           write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,1,4),"gx"
           endif
          endif
          if ((itype(1,1).ne.10).and.&
-         (itype(1,molnum(1)).ne.ntyp1_molec(molnum(1)))) then
+         (itype(1,molnum(1)).ne.ntyp1_molec(molnum(1))).and.(molnum(1).ne.5)) then
           gcart(j,2)=gcart(j,2)+gloc_sc(1,0,icg)*dtauangle(j,1,3,3)
 !           write(iout,*)  gloc_sc(1,0,icg),dtauangle(j,1,3,3)
         endif
-         if ((itype(3,1).ne.10).and.(nres.ge.3)) then
+         if ((itype(3,1).ne.10).and.(nres.ge.3).and.(molnum(3).ne.5)) then
           gcart(j,2)=gcart(j,2)+gloc_sc(2,1,icg)*dtauangle(j,2,2,4)
 !           write(iout,*) gloc_sc(2,1,icg),dtauangle(j,2,2,4)
          endif
-         if ((itype(4,1).ne.10).and.(nres.ge.4)) then
+         if ((itype(4,1).ne.10).and.(nres.ge.4).and.(molnum(4).ne.5)) then
           gcart(j,2)=gcart(j,2)+gloc_sc(2,2,icg)*dtauangle(j,2,1,5)
 !           write(iout,*) gloc_sc(2,2,icg),dtauangle(j,2,1,5)
          endif
 
 !      write(iout,*) gcart(j,2),itype(2,1),itype(1,1),itype(3,1), "gcart2"
        enddo
+!         write(iout,*) "po dE/ddc2 gcart", gcart(1,2)
+
 !    If there are more than five residues
       if(nres.ge.5) then                        
         do i=3,nres-2
          do j=1,3
 !          write(iout,*) "before", gcart(j,i)
           if ((itype(i,1).ne.10).and.&
-          (itype(i,molnum(i)).ne.ntyp1_molec(molnum(i)))) then
+          (itype(i,molnum(i)).ne.ntyp1_molec(molnum(i))).and.(molnum(i).ne.5)) then
           gxcart(j,i)=gxcart(j,i)+gloc_sc(2,i-2,icg) &
           *dtauangle(j,2,3,i+1) &
           -gloc_sc(1,i-1,icg)*dtauangle(j,1,1,i+2)
 !     &  gcart(j,i),gloc_sc(1,i-1,icg),dtauangle(j,1,2,i+2)
 !          if (itype(i-1,1).ne.10) then
           if ((itype(i-1,1).ne.10).and.&
-          (itype(i-1,molnum(i-1)).ne.ntyp1_molec(molnum(i-1)))) then
+          (itype(i-1,molnum(i-1)).ne.ntyp1_molec(molnum(i-1))).and.(molnum(i-1).eq.5)) then
 
            gxcart(j,i)=gxcart(j,i)+gloc_sc(3,i-2,icg) &
       *dtauangle(j,3,3,i+1)
           endif
 !          if (itype(i+2,1).ne.10) then
           if ((itype(i+2,1).ne.10).and.&
-          (itype(i+2,molnum(i+2)).ne.ntyp1_molec(molnum(i+2)))) then
+          (itype(i+2,molnum(i+2)).ne.ntyp1_molec(molnum(i+2))).and.(molnum(i+2).ne.5)) then
            gcart(j,i)=gcart(j,i)+gloc_sc(2,i,icg)* &
            dtauangle(j,2,1,i+3)
           endif
       if(nres.ge.4) then
          do j=1,3
          if ((itype(nres-1,1).ne.10).and.&
-       (itype(nres-1,molnum(nres-1)).ne.ntyp1_molec(molnum(nres-1)))) then
+       (itype(nres-1,molnum(nres-1)).ne.ntyp1_molec(molnum(nres-1))).and.(molnum(nres-1).ne.5)) then
          gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(2,nres-3,icg) &
           *dtauangle(j,2,3,nres)
 !          write (iout,*) "gxcart(nres-1)", gloc_sc(2,nres-3,icg),
 !     &     dtauangle(j,2,3,nres), gxcart(j,nres-1)
 !         if (itype(nres-2,1).ne.10) then
          if ((itype(nres-2,1).ne.10).and.&
-       (itype(nres-2,molnum(nres-2)).ne.ntyp1_molec(molnum(nres-2)))) then
+       (itype(nres-2,molnum(nres-2)).ne.ntyp1_molec(molnum(nres-2))).and.(molnum(nres-2).ne.5)) then
        gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(3,nres-3,icg) &
           *dtauangle(j,3,3,nres)
           endif
          if ((itype(nres,1).ne.10).and.&
-         (itype(nres,molnum(nres)).ne.ntyp1_molec(molnum(nres)))) then
+         (itype(nres,molnum(nres)).ne.ntyp1_molec(molnum(nres))).and.(molnum(nres).ne.5)) then
         gxcart(j,nres-1)=gxcart(j,nres-1)-gloc_sc(3,nres-2,icg) &
           *dtauangle(j,3,1,nres+1)
         gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(3,nres-2,icg) &
           endif
          endif
          if ((itype(nres-2,1).ne.10).and.&
-         (itype(nres-2,molnum(nres-2)).ne.ntyp1_molec(molnum(nres-2)))) then
+         (itype(nres-2,molnum(nres-2)).ne.ntyp1_molec(molnum(nres-2))).and.(molnum(nres-2).ne.5)) then
             gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(1,nres-3,icg)* &
          dtauangle(j,1,3,nres)
          endif
-          if ((itype(nres,1).ne.10).and.(itype(nres,molnum(nres)).ne.ntyp1_molec(molnum(nres)))) then
+          if ((itype(nres,1).ne.10).and.(itype(nres,molnum(nres)).ne.ntyp1_molec(molnum(nres))).and.(molnum(nres).ne.5)) then
             gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(2,nres-2,icg)* &
            dtauangle(j,2,2,nres+1)
 !           write (iout,*) "gcart(nres-1)", gloc_sc(2,nres-2,icg),
       endif
 !  Settind dE/ddnres       
        if ((nres.ge.3).and.(itype(nres,1).ne.10).and. &
-          (itype(nres,molnum(nres)).ne.ntyp1_molec(molnum(nres))))then
+          (itype(nres,molnum(nres)).ne.ntyp1_molec(molnum(nres))).and.(molnum(nres).ne.5))then
        do j=1,3
         gxcart(j,nres)=gxcart(j,nres)+gloc_sc(3,nres-2,icg) &
        *dtauangle(j,3,3,nres+1)+gloc_sc(2,nres-2,icg) &
        *dtauangle(j,2,3,nres+1)
         enddo
        endif
+!       write(iout,*) "final gcart",gcart(1,2)
 !   The side-chain vector derivatives
 !       print *,"gcart",gcart(:,:)
       return
index 131c789..847df40 100644 (file)
              print *,msc(i,5),restok(i,5)
             enddo
             ip(5)=0.2
-
+!DIR$ NOUNROLL 
       do j=1,ntyp_molec(5)
        do i=1,ntyp
 !       do j=1,ntyp_molec(5)
 
        do i=1,ntyp
        do j=1,ntyp_molec(5)
-      if (i.eq.1) then
+      if (i.eq.10) then
       write (iout,*) 'i= ', i, ' j= ', j
       write (iout,*) 'epsi0= ', epscat(i,j)
       write (iout,*) 'sigma0= ', sigmacat(i,j)
       write (iout,*) 'epsin= ', epsintabcat(1,j), epsintabcat(j,1)
       write (iout,*) 'alphapol1= ',  alphapolcat(1,j)
       write (iout,*) 'alphapol2= ',  alphapolcat(j,1)
-      write (iout,*) 'w1= ', wqdipcat(1,1,j)
-      write (iout,*) 'w2= ', wqdipcat(2,1,j)
+      write (iout,*) 'w1= ', wqdipcat(1,i,j)
+      write (iout,*) 'w2= ', wqdipcat(2,i,j)
       write (iout,*) 'debaykapcat(i,j)= ',  debaykapcat(1,j)
       endif
 
          istype(i)=istype_temp(i)
         enddo
        enddo
+       if ((itype(1,1).eq.ntyp1).and.itype(2,5).ne.0) then
+! I have only ions now dummy atoms in the system        
+       molnum(1)=5
+       itype(1,5)=itype(2,5)
+       itype(1,1)=0
+       do i=2,nres
+         itype(i,5)=itype(i+1,5)
+       enddo
+       itype(nres,5)=0
+       nres=nres-1
+       nres_molec(1)=nres_molec(1)-1
+      endif
 !      if (itype(1,1).eq.ntyp1) then
 !        nsup=nsup-1
 !        nstart_sup=2