corrections
authorCezary Czaplewski <czarek@chem.univ.gda.pl>
Fri, 29 May 2020 19:42:15 +0000 (21:42 +0200)
committerCezary Czaplewski <czarek@chem.univ.gda.pl>
Fri, 29 May 2020 19:42:15 +0000 (21:42 +0200)
68 files changed:
source/cluster/wham/src-HCD/COMMON.HOMOLOGY
source/cluster/wham/src-HCD/COMMON.HOMRESTR
source/cluster/wham/src-HCD/COMMON.SBRIDGE
source/cluster/wham/src-HCD/DIMENSIONS
source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos
source/cluster/wham/src-HCD/Makefile-tryton [new file with mode: 0644]
source/cluster/wham/src-HCD/boxshift.f [new file with mode: 0644]
source/cluster/wham/src-HCD/energy_p_new.F
source/cluster/wham/src-HCD/include_unres/COMMON.CONTMAT
source/cluster/wham/src-HCD/include_unres/COMMON.CORRMAT
source/cluster/wham/src-HCD/include_unres/COMMON.DERIV
source/cluster/wham/src-HCD/initialize_p.F
source/cluster/wham/src-HCD/probabl.F
source/cluster/wham/src-HCD/readpdb.F
source/cluster/wham/src-HCD/readrtns.F
source/cluster/wham/src-HCD/ssMD.F
source/cluster/wham/src-HCD/wrtclust.f
source/unres/src-HCD-5D/COMMON.CHAIN
source/unres/src-HCD-5D/COMMON.CONTMAT
source/unres/src-HCD-5D/COMMON.CORRMAT
source/unres/src-HCD-5D/COMMON.HOMOLOGY
source/unres/src-HCD-5D/COMMON.INTERACT
source/unres/src-HCD-5D/COMMON.SBRIDGE
source/unres/src-HCD-5D/COMMON.SHIELD
source/unres/src-HCD-5D/DIMENSIONS
source/unres/src-HCD-5D/MD_A-MTS.F
source/unres/src-HCD-5D/MP.F
source/unres/src-HCD-5D/MREMD.F
source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton [new file with mode: 0644]
source/unres/src-HCD-5D/contact_cp2.F [new file with mode: 0644]
source/unres/src-HCD-5D/energy_p_new-sep_barrier.F
source/unres/src-HCD-5D/energy_p_new_barrier.F
source/unres/src-HCD-5D/energy_split-sep.F
source/unres/src-HCD-5D/gen_rand_conf.F
source/unres/src-HCD-5D/initialize_p.F
source/unres/src-HCD-5D/make_xx_list.F
source/unres/src-HCD-5D/minim_jlee.F
source/unres/src-HCD-5D/minimize_p.F
source/unres/src-HCD-5D/parmread.F
source/unres/src-HCD-5D/read_constr_homology.F [new file with mode: 0644]
source/unres/src-HCD-5D/readpdb-mult.F
source/unres/src-HCD-5D/readrtns_CSA.F
source/unres/src-HCD-5D/regularize.F
source/unres/src-HCD-5D/ssMD.F
source/unres/src-HCD-5D/stochfric.F
source/unres/src-HCD-5D/test.F
source/wham/src-HCD/COMMON.HOMOLOGY
source/wham/src-HCD/COMMON.HOMRESTR
source/wham/src-HCD/COMMON.SHIELD
source/wham/src-HCD/DIMENSIONS
source/wham/src-HCD/Makefile-tryton [new file with mode: 0644]
source/wham/src-HCD/Makefile_MPICH_ifort-okeanos
source/wham/src-HCD/boxshift.f [new file with mode: 0644]
source/wham/src-HCD/cxread.F
source/wham/src-HCD/enecalc1.F
source/wham/src-HCD/energy_p_new.F
source/wham/src-HCD/include_unres/COMMON.CALC
source/wham/src-HCD/include_unres/COMMON.CONTMAT
source/wham/src-HCD/include_unres/COMMON.CORRMAT
source/wham/src-HCD/include_unres/COMMON.DERIV
source/wham/src-HCD/include_unres/COMMON.SBRIDGE
source/wham/src-HCD/initialize_p.F
source/wham/src-HCD/molread_zs.F
source/wham/src-HCD/parmread.F
source/wham/src-HCD/readpdb.F
source/wham/src-HCD/readrtns.F
source/wham/src-HCD/ssMD.F
source/wham/src-HCD/wham_calc1.F

index e2a7754..d149f8d 100644 (file)
@@ -5,4 +5,4 @@
      &  dist2_cut
       common /homol/  waga_homology(10),
      & waga_dist,waga_angle,waga_theta,waga_d,dist_cut,dist2_cut,
-     & iset,ihset,l_homo(max_template,maxdim)
+     & iset,ihset,l_homo(max_template,maxdim_cont)
index 95ea932..0e558f1 100644 (file)
@@ -1,6 +1,7 @@
-       real*8 odl(max_template,maxdim),sigma_odl(max_template,maxdim),
+       real*8 odl(max_template,maxdim_cont),
+     &   sigma_odl(max_template,maxdim_cont),
      &    dih(max_template,maxres),sigma_dih(max_template,maxres),
-     &    sigma_odlir(max_template,maxdim)
+     &    sigma_odlir(max_template,maxdim_cont)
 c
 c    Specification of new variables used in  subroutine e_modeller
 c    modified by FP (Nov.,2014)
@@ -10,7 +11,7 @@ c    modified by FP (Nov.,2014)
      &        sigma_d(max_template,maxres)
 c
 
-       integer ires_homo(maxdim),jres_homo(maxdim)
+       integer ires_homo(maxdim_cont),jres_homo(maxdim_cont)
 
        double precision 
      & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst,
index ab78ed3..a313d8f 100644 (file)
@@ -1,20 +1,22 @@
       double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss
-      integer ns,nss,nfree,iss
-      logical restr_on_coord
+      integer ns,nss,nfree,iss,icys
       common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,
-     & ns,nss,nfree,iss(maxss)
+     & ns,nss,nfree,iss(maxss),icys(maxres)
       double precision dhpb,dhpb1,forcon,fordepth,xlscore,wboltzd,
      & dhpb_peak,dhpb1_peak,forcon_peak,fordepth_peak,scal_peak,bfac
       integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb,ibecarb_peak,npeak,
      & ipeak,irestr_type,irestr_type_peak,ihpb_peak,jhpb_peak,nhpb_peak
-      common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim),
-     & fordepth(maxdim),bfac(maxres),xlscore(maxdim),wboltzd,
-     & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),irestr_type(maxdim),
+      logical restr_on_coord
+      common /links/ dhpb(maxdim_cont),dhpb1(maxdim_cont),
+     & forcon(maxdim_cont),fordepth(maxdim_cont),bfac(maxres),
+     & xlscore(maxdim_cont),wboltzd,ihpb(maxdim_cont),jhpb(maxdim_cont),
+     & ibecarb(maxdim_cont),irestr_type(maxdim_cont),
      & nhpb,restr_on_coord
-      common /NMRpeaks/ dhpb_peak(maxdim),dhpb1_peak(maxdim),
-     & forcon_peak(maxdim),fordepth_peak(maxdim),scal_peak,
-     & ihpb_peak(maxdim),jhpb_peak(maxdim),ibecarb_peak(maxdim),
-     & irestr_type_peak(maxdim),ipeak(2,maxdim),npeak,nhpb_peak
+      common /NMRpeaks/ dhpb_peak(maxdim_cont),dhpb1_peak(maxdim_cont),
+     & forcon_peak(maxdim_cont),fordepth_peak(maxdim_cont),scal_peak,
+     & ihpb_peak(maxdim_cont),jhpb_peak(maxdim_cont),
+     & ibecarb_peak(maxdim_cont),irestr_type_peak(maxdim_cont),
+     & ipeak(2,maxdim_cont),npeak,nhpb_peak
       double precision weidis
       common /restraints/ weidis
       integer link_start,link_end,link_start_peak,link_end_peak
@@ -23,7 +25,7 @@
       double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss
       logical dyn_ss,dyn_ss_mask
       common /dyn_ssbond/ dtriss,atriss,btriss,ctriss,Ht,
-     &  dyn_ssbond_ij(maxres,maxres),
-     &  idssb(maxdim),jdssb(maxdim)
+     &  dyn_ssbond_ij(max_cyst,max_cyst),
+     &  idssb(maxss),jdssb(maxss)
       common /dyn_ss_logic/
      &  dyn_ss,dyn_ss_mask(maxres)
index ffd3a80..e6a29b3 100644 (file)
@@ -11,6 +11,9 @@ C Max. number of AA residues
       integer maxres,maxres2
 c      parameter (maxres=1200)
       parameter (maxres=5000)
+C Max. number of cysteines and other bridging residues
+      integer max_cyst
+      parameter (max_cyst=100)
 C Appr. max. number of interaction sites
       parameter (maxres2=2*maxres)
 C Max. number of variables
@@ -34,6 +37,16 @@ C Max. number of SC contacts
 C Max. number of contacts per residue
       integer maxconts
       parameter (maxconts=maxres)
+C Max. number of interactions within cutoff per residue
+      integer maxint_res
+      parameter (maxint_res=200)
+C Max. number od residues within distance cufoff from a given residue to
+C     include in template-based/contact distance restraints.
+      integer maxcont_res
+      parameter (maxcont_res=200)
+C Max. number of distance/contact-distance restraints
+      integer maxdim_cont
+      parameter (maxdim_cont=maxres*maxcont_res)
 C Number of AA types (at present only natural AA's will be handled
       integer ntyp,ntyp1
       parameter (ntyp=24,ntyp1=ntyp+1)
index 4f7f61f..425bed2 100644 (file)
@@ -18,10 +18,10 @@ object = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o
        matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \
        geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o  \
        track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \
-       int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \
-       setup_var.o read_ref_str.o gnmr1.o permut.o seq2chains.o \
-       chain_symmetry.o iperm.o rmscalc.o rmsnat.o TMscore.o ssMD.o refsys.o \
-       read_constr_homology.o
+       int_from_cart1.o energy_p_new.o boxshift.o icant.o proc_proc.o \
+       work_partition.o setup_var.o read_ref_str.o gnmr1.o permut.o \
+       seq2chains.o chain_symmetry.o iperm.o rmscalc.o rmsnat.o TMscore.o \
+       ssMD.o refsys.o read_constr_homology.o
 
 all: no_option
        @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR"
diff --git a/source/cluster/wham/src-HCD/Makefile-tryton b/source/cluster/wham/src-HCD/Makefile-tryton
new file mode 100644 (file)
index 0000000..e887bc9
--- /dev/null
@@ -0,0 +1,125 @@
+###################################################################
+#INSTALL_DIR = /net/software/local/intel/compilers_and_libraries_2016.3.210/linux/mpi/intel64
+
+
+FC = mpif90 -fc=ifort
+
+
+OPT = -O3 -ip -mcmodel=medium 
+#OPT = -CB -g -mcmodel=medium -shared-intel
+FFLAGS =  ${OPT} -c -I. -Iinclude_unres -I$(INSTALL_DIR)/include
+LIBS = -L$(INSTALL_DIR)/lib -lmpi xdrf/libxdrf.a
+
+.c.o:
+       cc -c -DLINUX -DPGI $*.c
+
+.f.o:
+       ${FC} ${FFLAGS} $*.f
+
+.F.o:
+       ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F
+
+object = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \
+       matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \
+       geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o  \
+       track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \
+       int_from_cart1.o energy_p_new.o boxshift.o icant.o proc_proc.o \
+       work_partition.o setup_var.o read_ref_str.o gnmr1.o permut.o \
+       seq2chains.o chain_symmetry.o iperm.o rmscalc.o rmsnat.o TMscore.o \
+       ssMD.o refsys.o read_constr_homology.o
+
+all: no_option
+       @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR"
+
+no_option:
+
+GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI  \
+       -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC \
+       -DFOURBODY
+GAB: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_GAB-HCD.exe
+GAB: ${object} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
+
+4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
+       -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC \
+       -DFOURBODY
+4P: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_4P-HCD.exe
+4P: ${object} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
+
+E0LL2Y: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \
+       -DCLUST -DSPLITELE -DFOURBODY
+E0LL2Y: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_E0LL2Y-HCD.exe
+E0LL2Y: ${object} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
+
+E0LL2Y_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \
+       -DCLUST -DSPLITELE -DFOURBODY -DDFA
+E0LL2Y_DFA: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_E0LL2Y-HCD-DFA.exe
+E0LL2Y_DFA: ${object} dfa.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN}
+
+NEWCORR: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \
+       -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR
+#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR
+NEWCORR: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD.exe
+#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe
+NEWCORR: ${object} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
+
+NEWCORR5D: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \
+       -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DFIVEDIAG
+#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR
+NEWCORR5D: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD5.exe
+#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe
+NEWCORR5D: ${object} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
+
+NEWCORR_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \
+       -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DDFA
+#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR
+NEWCORR_DFA: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD-DFA.exe
+#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe
+NEWCORR_DFA: ${object} dfa.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN}
+
+NEWCORR5D_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \
+       -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DDFA
+#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR
+NEWCORR5D_DFA: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD5-DFA.exe
+#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe
+NEWCORR5D_DFA: ${object} dfa.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN}
+
+xdrf/libxdrf.a:
+       cd xdrf && make
+
+
+clean:
+       /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean
+
+
diff --git a/source/cluster/wham/src-HCD/boxshift.f b/source/cluster/wham/src-HCD/boxshift.f
new file mode 100644 (file)
index 0000000..29d3406
--- /dev/null
@@ -0,0 +1,101 @@
+
+c------------------------------------------------------------------------
+      double precision function boxshift(x,boxsize)
+      implicit none
+      double precision x,boxsize
+      double precision xtemp
+      xtemp=dmod(x,boxsize)
+      if (dabs(xtemp-boxsize).lt.dabs(xtemp)) then
+        boxshift=xtemp-boxsize
+      else if (dabs(xtemp+boxsize).lt.dabs(xtemp)) then
+        boxshift=xtemp+boxsize
+      else
+        boxshift=xtemp
+      endif
+      return
+      end
+c--------------------------------------------------------------------------
+      subroutine closest_img(xi,yi,zi,xj,yj,zj)
+      include 'DIMENSIONS'
+      include 'COMMON.CHAIN'
+      integer xshift,yshift,zshift,subchap
+      double precision dist_init,xj_safe,yj_safe,zj_safe,
+     & xj_temp,yj_temp,zj_temp,dist_temp
+      xj_safe=xj
+      yj_safe=yj
+      zj_safe=zj
+      dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+      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
+      return
+      end
+c--------------------------------------------------------------------------
+      subroutine to_box(xi,yi,zi)
+      implicit none
+      include 'DIMENSIONS'
+      include 'COMMON.CHAIN'
+      double precision xi,yi,zi
+      xi=dmod(xi,boxxsize)
+      if (xi.lt.0.0d0) xi=xi+boxxsize
+      yi=dmod(yi,boxysize)
+      if (yi.lt.0.0d0) yi=yi+boxysize
+      zi=dmod(zi,boxzsize)
+      if (zi.lt.0.0d0) zi=zi+boxzsize
+      return
+      end
+c--------------------------------------------------------------------------
+      subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+      implicit none
+      include 'DIMENSIONS'
+      include 'COMMON.CHAIN'
+      double precision xi,yi,zi,sslipi,ssgradlipi
+      double precision fracinbuf
+      double precision sscalelip,sscagradlip
+
+      if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then
+C the energy transfer exist
+        if (zi.lt.buflipbot) then
+C what fraction I am in
+          fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+          sslipi=sscalelip(fracinbuf)
+          ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+        elseif (zi.gt.bufliptop) then
+          fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+          sslipi=sscalelip(fracinbuf)
+          ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+        else
+          sslipi=1.0d0
+          ssgradlipi=0.0
+        endif
+      else
+        sslipi=0.0d0
+        ssgradlipi=0.0
+      endif
+      return
+      end
index 5d07d5d..119bad6 100644 (file)
@@ -180,14 +180,23 @@ c      write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
 c      write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
 #ifdef DFA
 C     BARTEK for dfa test!
+      edfadis=0.0d0
       if (wdfa_dist.gt.0) call edfad(edfadis)
 c      write(iout,*)'edfad is finished!', wdfa_dist,edfadis
+      edfator=0.0d0
       if (wdfa_tor.gt.0) call edfat(edfator)
 c      write(iout,*)'edfat is finished!', wdfa_tor,edfator
+      edfanei=0.0d0
       if (wdfa_nei.gt.0) call edfan(edfanei)
 c      write(iout,*)'edfan is finished!', wdfa_nei,edfanei
+      edfabet=0.0d0
       if (wdfa_beta.gt.0) call edfab(edfabet)
 c      write(iout,*)'edfab is finished!', wdfa_beta,edfabet
+#else 
+      edfadis=0.0d0
+      edfator=0.0d0
+      edfanei=0.0d0
+      edfabet=0.0d0
 #endif
 
 #ifdef SPLITELE
@@ -511,6 +520,9 @@ C     Bartek
       edfator = energia(29)
       edfanei = energia(30)
       edfabet = energia(31)
+      Eafmforc=0.0d0
+      etube=0.0d0
+      Uconst=0.0d0 
 #ifdef SPLITELE
       write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
      &  estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
@@ -674,6 +686,7 @@ cROZNICA
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
+        call to_box(xi,yi,zi)
 C Change 12/1/95
         num_conti=0
 C
@@ -688,6 +701,10 @@ cd   &                  'iend=',iend(i,iint)
             xj=c(1,nres+j)-xi
             yj=c(2,nres+j)-yi
             zj=c(3,nres+j)-zi
+            call to_box(xj,yj,zj)
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
 C Change 12/1/95 to calculate four-body interactions
             rij=xj*xj+yj*yj+zj*zj
             rrij=1.0D0/rij
@@ -857,6 +874,7 @@ c      enddo
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
+        call to_box(xi,yi,zi)
 C
 C Calculate SC interaction energy.
 C
@@ -867,6 +885,10 @@ C
             xj=c(1,nres+j)-xi
             yj=c(2,nres+j)-yi
             zj=c(3,nres+j)-zi
+            call to_box(xj,yj,zj)
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
             rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
             fac_augm=rrij**expon
             e_augm=augm(itypi,itypj)*fac_augm
@@ -972,6 +994,7 @@ c     endif
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
+        call to_box(xi,yi,zi)
         dxi=dc_norm(1,nres+i)
         dyi=dc_norm(2,nres+i)
         dzi=dc_norm(3,nres+i)
@@ -1004,9 +1027,13 @@ c           chip12=0.0D0
 c           alf1=0.0D0
 c           alf2=0.0D0
 c           alf12=0.0D0
-            xj=c(1,nres+j)-xi
-            yj=c(2,nres+j)-yi
-            zj=c(3,nres+j)-zi
+            xj=c(1,nres+j)
+            yj=c(2,nres+j)
+            zj=c(3,nres+j)
+            call to_box(xj,yj,zj)
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
             dxj=dc_norm(1,nres+j)
             dyj=dc_norm(2,nres+j)
             dzj=dc_norm(3,nres+j)
@@ -1110,35 +1137,8 @@ c      if (icall.gt.0) lprn=.true.
         yi=c(2,nres+i)
         zi=c(3,nres+i)
 C returning the ith atom to box
-          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
-       if ((zi.gt.bordlipbot)
-     &.and.(zi.lt.bordliptop)) then
-C the energy transfer exist
-        if (zi.lt.buflipbot) then
-C what fraction I am in
-         fracinbuf=1.0d0-
-     &        ((zi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-         sslipi=sscalelip(fracinbuf)
-         ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
-        elseif (zi.gt.bufliptop) then
-         fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
-         sslipi=sscalelip(fracinbuf)
-         ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
-        else
-         sslipi=1.0d0
-         ssgradlipi=0.0
-        endif
-       else
-         sslipi=0.0d0
-         ssgradlipi=0.0
-       endif
-
+        call to_box(xi,yi,zi)
+        call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
         dxi=dc_norm(1,nres+i)
         dyi=dc_norm(2,nres+i)
         dzi=dc_norm(3,nres+i)
@@ -1196,80 +1196,15 @@ c           alf12=0.0D0
             yj=c(2,nres+j)
             zj=c(3,nres+j)
 C returning jth atom to box
-          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
-       if ((zj.gt.bordlipbot)
-     &.and.(zj.lt.bordliptop)) then
-C the energy transfer exist
-        if (zj.lt.buflipbot) then
-C what fraction I am in
-         fracinbuf=1.0d0-
-     &        ((zj-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-         sslipj=sscalelip(fracinbuf)
-         ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
-        elseif (zj.gt.bufliptop) then
-         fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
-         sslipj=sscalelip(fracinbuf)
-         ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
-        else
-         sslipj=1.0d0
-         ssgradlipj=0.0
-        endif
-       else
-         sslipj=0.0d0
-         ssgradlipj=0.0
-       endif
-      aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
-     &  +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-      bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
-     &  +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-C       if (aa.ne.aa_aq(itypi,itypj)) then
-       
-C      write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
-C     & bb_aq(itypi,itypj)-bb,
-C     & sslipi,sslipj
-C         endif
-
-C        write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
-C checking the distance
-      dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
-      xj_safe=xj
-      yj_safe=yj
-      zj_safe=zj
-      subchap=0
-C finding the closest
-      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
-
+            call to_box(xj,yj,zj)
+            call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+            aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+     &        +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+            bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+     &        +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
             dxj=dc_norm(1,nres+j)
             dyj=dc_norm(2,nres+j)
             dzj=dc_norm(3,nres+j)
@@ -1391,6 +1326,8 @@ c      if (icall.gt.0) lprn=.true.
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
+        call to_box(xi,yi,zi)
+        call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
         dxi=dc_norm(1,nres+i)
         dyi=dc_norm(2,nres+i)
         dzi=dc_norm(3,nres+i)
@@ -1425,9 +1362,15 @@ c           chip12=0.0D0
 c           alf1=0.0D0
 c           alf2=0.0D0
 c           alf12=0.0D0
-            xj=c(1,nres+j)-xi
-            yj=c(2,nres+j)-yi
-            zj=c(3,nres+j)-zi
+            xj=c(1,nres+j)
+            yj=c(2,nres+j)
+            zj=c(3,nres+j)
+            call to_box(xj,yj,zj)
+            call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+            aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+     &        +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+            bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+     &        +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
             dxj=dc_norm(1,nres+j)
             dyj=dc_norm(2,nres+j)
             dzj=dc_norm(3,nres+j)
@@ -2256,12 +2199,7 @@ c        end if
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
-          xmedi=mod(xmedi,boxxsize)
-          if (xmedi.lt.0) xmedi=xmedi+boxxsize
-          ymedi=mod(ymedi,boxysize)
-          if (ymedi.lt.0) ymedi=ymedi+boxysize
-          zmedi=mod(zmedi,boxzsize)
-          if (zmedi.lt.0) zmedi=zmedi+boxzsize
+        call to_box(xmedi,ymedi,zmedi)
         num_conti=0
         call eelecij(i,i+2,ees,evdw1,eel_loc)
         if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
@@ -2291,38 +2229,7 @@ c     &    .or. itype(i-1).eq.ntyp1
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
-C Return atom into box, boxxsize is size of box in x dimension
-c  194   continue
-c        if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
-c        if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
-C Condition for being inside the proper box
-c        if ((xmedi.gt.((0.5d0)*boxxsize)).or.
-c     &       (xmedi.lt.((-0.5d0)*boxxsize))) then
-c        go to 194
-c        endif
-c  195   continue
-c        if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
-c        if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
-C Condition for being inside the proper box
-c        if ((ymedi.gt.((0.5d0)*boxysize)).or.
-c     &       (ymedi.lt.((-0.5d0)*boxysize))) then
-c        go to 195
-c        endif
-c  196   continue
-c        if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
-c        if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
-C Condition for being inside the proper box
-c        if ((zmedi.gt.((0.5d0)*boxzsize)).or.
-c     &       (zmedi.lt.((-0.5d0)*boxzsize))) then
-c        go to 196
-c        endif
-          xmedi=mod(xmedi,boxxsize)
-          if (xmedi.lt.0) xmedi=xmedi+boxxsize
-          ymedi=mod(ymedi,boxysize)
-          if (ymedi.lt.0) ymedi=ymedi+boxysize
-          zmedi=mod(zmedi,boxzsize)
-          if (zmedi.lt.0) zmedi=zmedi+boxzsize
-
+        call to_box(xmedi,ymedi,zmedi)
 #ifdef FOURBODY
         num_conti=num_cont_hb(i)
 #endif
@@ -2362,43 +2269,7 @@ c     &  .or. itype(i-1).eq.ntyp1
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
-          xmedi=mod(xmedi,boxxsize)
-          if (xmedi.lt.0) xmedi=xmedi+boxxsize
-          ymedi=mod(ymedi,boxysize)
-          if (ymedi.lt.0) ymedi=ymedi+boxysize
-          zmedi=mod(zmedi,boxzsize)
-          if (zmedi.lt.0) zmedi=zmedi+boxzsize
-C          xmedi=xmedi+xshift*boxxsize
-C          ymedi=ymedi+yshift*boxysize
-C          zmedi=zmedi+zshift*boxzsize
-
-C Return tom into box, boxxsize is size of box in x dimension
-c  164   continue
-c        if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
-c        if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
-C Condition for being inside the proper box
-c        if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
-c     &       (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
-c        go to 164
-c        endif
-c  165   continue
-c        if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
-c        if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
-C Condition for being inside the proper box
-c        if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
-c     &       (ymedi.lt.((yshift-0.5d0)*boxysize))) then
-c        go to 165
-c        endif
-c  166   continue
-c        if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
-c        if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
-cC Condition for being inside the proper box
-c        if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
-c     &       (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
-c        go to 166
-c        endif
-
-c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
+        call to_box(xmedi,ymedi,zmedi)
 #ifdef FOURBODY
         num_conti=num_cont_hb(i)
 #endif
@@ -2503,75 +2374,11 @@ C          zj=c(3,j)+0.5D0*dzj-zmedi
           xj=c(1,j)+0.5D0*dxj
           yj=c(2,j)+0.5D0*dyj
           zj=c(3,j)+0.5D0*dzj
-          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
-          if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
-      dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
-      xj_safe=xj
-      yj_safe=yj
-      zj_safe=zj
-      isubchap=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-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
-          if(dist_temp.lt.dist_init) then
-            dist_init=dist_temp
-            xj_temp=xj
-            yj_temp=yj
-            zj_temp=zj
-            isubchap=1
-          endif
-       enddo
-       enddo
-       enddo
-       if (isubchap.eq.1) then
-          xj=xj_temp-xmedi
-          yj=yj_temp-ymedi
-          zj=zj_temp-zmedi
-       else
-          xj=xj_safe-xmedi
-          yj=yj_safe-ymedi
-          zj=zj_safe-zmedi
-       endif
-C        if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
-c  174   continue
-c        if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
-c        if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
-C Condition for being inside the proper box
-c        if ((xj.gt.((0.5d0)*boxxsize)).or.
-c     &       (xj.lt.((-0.5d0)*boxxsize))) then
-c        go to 174
-c        endif
-c  175   continue
-c        if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
-c        if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
-C Condition for being inside the proper box
-c        if ((yj.gt.((0.5d0)*boxysize)).or.
-c     &       (yj.lt.((-0.5d0)*boxysize))) then
-c        go to 175
-c        endif
-c  176   continue
-c        if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
-c        if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
-C Condition for being inside the proper box
-c        if ((zj.gt.((0.5d0)*boxzsize)).or.
-c     &       (zj.lt.((-0.5d0)*boxzsize))) then
-c        go to 176
-c        endif
-C        endif !endPBC condintion
-C        xj=xj-xmedi
-C        yj=yj-ymedi
-C        zj=zj-zmedi
+          call to_box(xj,yj,zj)
+          xj=boxshift(xj-xmedi,boxxsize)
+          yj=boxshift(yj-ymedi,boxysize)
+          zj=boxshift(zj-zmedi,boxzsize)
           rij=xj*xj+yj*yj+zj*zj
-
           sss=sscale(sqrt(rij))
           if (sss.eq.0.0d0) return
           sssgrad=sscagrad(sqrt(rij))
@@ -4055,12 +3862,7 @@ c     &   " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
         yi=0.5D0*(c(2,i)+c(2,i+1))
         zi=0.5D0*(c(3,i)+c(3,i+1))
 C Returning the ith atom to box
-          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
+        call to_box(xi,yi,zi)
         do iint=1,nscp_gr(i)
 
         do j=iscpstart(i,iint),iscpend(i,iint)
@@ -4075,44 +3877,10 @@ C Uncomment following three lines for Ca-p interactions
           yj=c(2,j)
           zj=c(3,j)
 C returning the jth atom to box
-          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
-C Finding the closest jth atom
-      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
+          call to_box(xj,yj,zj)
+          xj=boxshift(xj-xi,boxxsize)
+          yj=boxshift(yj-yi,boxysize)
+          zj=boxshift(zj-zi,boxzsize)
           rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
 C sss is scaling function for smoothing the cutoff gradient otherwise
 C the gradient would not be continuouse
@@ -10217,7 +9985,6 @@ c         min_odl=minval(distancek)
      &              min_odl=distancek(kk)
            enddo
          endif
-
 c        write (iout,* )"min_odl",min_odl
 #ifdef DEBUG
          write (iout,*) "ij dij",i,j,dij
index f0b6122..6e5b5d5 100644 (file)
@@ -17,8 +17,9 @@ C 12/26/95 - H-bonding contacts
      &  facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
      &  ees0m(maxconts,maxres),d_cont(maxconts,maxres),
      &  num_cont_hb(maxres),jcont_hb(maxconts,maxres)
-C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole 
-C         interactions     
+      double precision a_chuj,a_chuj_der
+      common /dipmat/ a_chuj(2,2,maxconts,maxres),
+     &  a_chuj_der(2,2,3,5,maxconts,maxres)
 c 7/25/08 Commented out; not needed when cumulants used
 C Interactions of pseudo-dipoles generated by loc-el interactions.
 c      double precision dip,dipderg,dipderx
index 5f154e0..ae25625 100644 (file)
@@ -30,9 +30,6 @@ C consecutive amino-acid residues.
      &  costab2(maxres),sintab2(maxres)
 C This common block contains dipole-interaction matrices and their 
 C Cartesian derivatives.
-      double precision a_chuj,a_chuj_der
-      common /dipmat/ a_chuj(2,2,maxconts,maxres),
-     &  a_chuj_der(2,2,3,5,maxconts,maxres)
       double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx,
      &  ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx,
      &  AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont,EAEA,EAEAderg,EAEAderx,
index f1f5db5..9b47a73 100644 (file)
@@ -15,7 +15,9 @@
      & gdfad,gdfat,gdfan,gdfab
       integer nfl,icg
       logical calc_grad
-      common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres),
+c      common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres),
+c 3/12/20 Adam:  Arrays dcdv, dxdv, and dxds removed following recoding of gradient.
+      common /derivat/
      & gradx(3,-1:maxres,2),gradc(3,-1:maxres,2),gvdwx(3,-1:maxres),
      & gvdwc(3,-1:maxres),gelc(3,-1:maxres),gelc_long(3,-1:maxres),
      & gvdwpp(3,-1:maxres),gvdwc_scpp(3,-1:maxres),
index 87e4dde..aa675e9 100644 (file)
@@ -174,10 +174,10 @@ C Initialize the bridge arrays
       do i=1,maxss
        iss(i)=0
       enddo
-      do i=1,maxss
+      do i=1,maxdim_cont
        dhpb(i)=0.0D0
       enddo
-      do i=1,maxss
+      do i=1,maxdim_cont
        ihpb(i)=0
        jhpb(i)=0
       enddo
index a3a664b..40791a3 100644 (file)
@@ -152,6 +152,8 @@ c          call pdbout(totfree(i),16,i)
 c          call flush(iout)
 #ifdef DEBUG
         write (iout,*) "conformation", i
+        write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres),
+     &                            ((c(l,k+nres),l=1,3),k=nnt,nct)
         call enerprint(energia(0),fT)
 #endif
         etot=energia(0)
index 58c63e4..f7cfb86 100644 (file)
@@ -77,7 +77,7 @@ c      write (2,*) "UNRES_PDB",unres_pdb
           sccalc=.true.
         endif
 ! Read free energy
-        if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp
+c        if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp
 ! Fish out the ATOM cards.
         if (index(card(1:4),'ATOM').gt.0) then  
           sccalc=.false.
index a3229a6..057f1ac 100644 (file)
@@ -242,8 +242,8 @@ C Read weights of the subsequent energy terms.
       do i=1,maxres
         dyn_ss_mask(i)=.false.
       enddo
-      do i=1,maxres-1
-        do j=i+1,maxres
+      do i=1,max_cyst-1
+        do j=i+1,max_cyst
           dyn_ssbond_ij(i,j)=1.0d300
         enddo
       enddo
@@ -716,6 +716,12 @@ C Read information about disulfide bridges.
 C Read bridging residues.
       read (inp,*) ns,(iss(i),i=1,ns)
 c      print *,'ns=',ns
+c 5/24/2020 Adam: Added a table to translate residue numbers to cysteine
+c     numbers
+      icys=0
+      do i=1,ns
+        icys(iss(i))=i
+      enddo
 C Check whether the specified bridging residues are cystines.
       do i=1,ns
        if (itype(iss(i)).ne.1) then
index 9c23fe0..9b2908f 100644 (file)
@@ -3,7 +3,6 @@ c----------------------------------------------------------------------------
 c      implicit none
 
 c     Includes
-      implicit real*8 (a-h,o-z)
       include 'DIMENSIONS'
       include 'COMMON.CHAIN'
       include 'COMMON.VAR'
@@ -83,12 +82,8 @@ ct           rij=ran_number(rmin,rmax)
       end
 
 C-----------------------------------------------------------------------------
-
       subroutine dyn_ssbond_ene(resi,resj,eij)
-c      implicit none
-
-c     Includes
-      implicit real*8 (a-h,o-z)
+      implicit none
       include 'DIMENSIONS'
       include 'COMMON.SBRIDGE'
       include 'COMMON.CHAIN'
@@ -98,9 +93,10 @@ c     Includes
       include 'COMMON.VAR'
       include 'COMMON.IOUNITS'
       include 'COMMON.CALC'
+      include 'COMMON.NAMES'
 #ifndef CLUST
 #ifndef WHAM
-C      include 'COMMON.MD'
+      include 'COMMON.MD'
 #endif
 #endif
 
@@ -130,7 +126,10 @@ c      integer itypi,itypj,k,l
       double precision omega,delta_inv,deltasq_inv,fac1,fac2
 c-------FIRST METHOD
       double precision xm,d_xm(1:3)
-      integer xshift,yshift,zshift
+      double precision sslipi,sslipj,ssgradlipi,ssgradlipj
+      integer ici,icj,itypi,itypj
+      double precision boxshift,sscale,sscagrad
+      double precision aa,bb
 c-------END FIRST METHOD
 c-------SECOND METHOD
 c$$$      double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
@@ -141,129 +140,50 @@ c-------TESTING CODE
       common /sschecks/ checkstop,transgrad
 
       integer icheck,nicheck,jcheck,njcheck
-      double precision echeck(-1:1),deps,ssx0,ljx0
+      double precision echeck(-1:1),deps,ssx0,ljx0,xi,yi,zi
 c-------END TESTING CODE
 
 
       i=resi
       j=resj
-
+      ici=icys(i)
+      icj=icys(j)
+      if (ici.eq.0 .or. icj.eq.0) then
+        write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') 
+     &  "Attempt to create",
+     &  " a disulfide link between non-cysteine residues ",restyp(i),i,
+     &  restyp(j),j
+        stop
+      endif
       itypi=itype(i)
       dxi=dc_norm(1,nres+i)
       dyi=dc_norm(2,nres+i)
       dzi=dc_norm(3,nres+i)
       dsci_inv=vbld_inv(i+nres)
-        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
+      xi=c(1,nres+i)
+      yi=c(2,nres+i)
+      zi=c(3,nres+i)
+      call to_box(xi,yi,zi)
 C define scaling factor for lipids
 
 C        if (positi.le.0) positi=positi+boxzsize
 C        print *,i
 C first for peptide groups
 c for each residue check if it is in lipid or lipid water border area
-       if ((zi.gt.bordlipbot)
-     &.and.(zi.lt.bordliptop)) then
-C the energy transfer exist
-        if (zi.lt.buflipbot) then
-C what fraction I am in
-         fracinbuf=1.0d0-
-     &        ((positi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-         sslipi=sscalelip(fracinbuf)
-         ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
-        elseif (zi.gt.bufliptop) then
-         fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
-         sslipi=sscalelip(fracinbuf)
-         ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
-        else
-         sslipi=1.0d0
-         ssgradlipi=0.0
-        endif
-       else
-         sslipi=0.0d0
-         ssgradlipi=0.0
-       endif
-
+      call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
       itypj=itype(j)
-            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
-       if ((zj.gt.bordlipbot)
-     &.and.(zj.lt.bordliptop)) then
-C the energy transfer exist
-        if (zj.lt.buflipbot) then
-C what fraction I am in
-         fracinbuf=1.0d0-
-     &        ((positi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-         sslipj=sscalelip(fracinbuf)
-         ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
-        elseif (zi.gt.bufliptop) then
-         fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
-         sslipj=sscalelip(fracinbuf)
-         ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
-        else
-         sslipj=1.0d0
-         ssgradlipj=0.0
-        endif
-       else
-         sslipj=0.0d0
-         ssgradlipj=0.0
-       endif
+      xj=c(1,nres+j)
+      yj=c(2,nres+j)
+      zj=c(3,nres+j)
+      call to_box(xj,yj,zj)
+      call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
       aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
      &  +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
       bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
      &  +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
-
-      dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
-      xj_safe=xj
-      yj_safe=yj
-      zj_safe=zj
-      subchap=0
-      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
-
+      xj=boxshift(xj-xi,boxxsize)
+      yj=boxshift(yj-yi,boxysize)
+      zj=boxshift(zj-zi,boxzsize)
       dxj=dc_norm(1,nres+j)
       dyj=dc_norm(2,nres+j)
       dzj=dc_norm(3,nres+j)
@@ -281,6 +201,8 @@ C lipbufthick is thickenes of lipid buffore
 
       rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
       rij=dsqrt(rrij)  ! sc_angular needs rij to really be the inverse
+            sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
+            sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
 c     The following are set in sc_angular
 c      erij(1)=xj*rij
 c      erij(2)=yj*rij
@@ -360,15 +282,15 @@ c-------END TESTING CODE
         e1=fac*fac*aa
         e2=fac*bb
         eij=eps1*eps2rt*eps3rt*(e1+e2)
-C        write(iout,*) eij,'TU?1'
         eps2der=eij*eps3rt
         eps3der=eij*eps2rt
-        eij=eij*eps2rt*eps3rt
+        eij=eij*eps2rt*eps3rt*sss
 
         sigder=-sig/sigsq
         e1=e1*eps1*eps2rt**2*eps3rt**2
         ed=-expon*(e1+eij)/ljd
         sigder=ed*sigder
+        ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij
         eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
         eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
         eom12=eij*eps1_om12+eps2der*eps2rt_om12
@@ -377,8 +299,9 @@ C        write(iout,*) eij,'TU?1'
         havebond=.true.
         ssd=rij-ssXs
         eij=ssA*ssd*ssd+ssB*ssd+ssC
-C        write(iout,*) 'TU?2',ssc,ssd
+        eij=eij*sss        
         ed=2*akcm*ssd+akct*deltat12
+        ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij
         pom1=akct*ssd
         pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
         eom1=-2*akth*deltat1-pom1-om2*pom2
@@ -413,13 +336,14 @@ c-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
           h1=h_base(f1,hd1)
           h2=h_base(f2,hd2)
           eij=ssm*h1+Ht*h2
-C         write(iout,*) eij,'TU?3'
           delta_inv=1.0d0/(xm-ssxm)
           deltasq_inv=delta_inv*delta_inv
           fac=ssm*hd1-Ht*hd2
           fac1=deltasq_inv*fac*(xm-rij)
           fac2=deltasq_inv*fac*(rij-ssxm)
           ed=delta_inv*(Ht*hd2-ssm*hd1)
+          eij=eij*sss
+          ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij
           eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
           eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
           eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
@@ -436,13 +360,14 @@ C         write(iout,*) eij,'TU?3'
           h1=h_base(f1,hd1)
           h2=h_base(f2,hd2)
           eij=Ht*h1+ljm*h2
-C        write(iout,*) 'TU?4',ssA
           delta_inv=1.0d0/(ljxm-xm)
           deltasq_inv=delta_inv*delta_inv
           fac=Ht*hd1-ljm*hd2
           fac1=deltasq_inv*fac*(ljxm-rij)
           fac2=deltasq_inv*fac*(rij-xm)
           ed=delta_inv*(ljm*hd2-Ht*hd1)
+          eij=eij*sss
+          ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij
           eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
           eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
           eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
@@ -508,7 +433,7 @@ c$$$        if (ed.gt.0.0d0) havebond=.true.
 c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
 
       endif
-C      write(iout,*) 'havebond',havebond
+
       if (havebond) then
 #ifndef CLUST
 #ifndef WHAM
@@ -518,9 +443,10 @@ c     &         "SSBOND_E_FORM",totT,t_bath,i,j
 c        endif
 #endif
 #endif
-        dyn_ssbond_ij(i,j)=eij
-      else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
-        dyn_ssbond_ij(i,j)=1.0d300
+        dyn_ssbond_ij(ici,icj)=eij
+      else if (.not.havebond .and. dyn_ssbond_ij(ici,icj).lt.1.0d300) 
+     &then
+        dyn_ssbond_ij(ici,icj)=1.0d300
 #ifndef CLUST
 #ifndef WHAM
 c        write(iout,'(a15,f12.2,f8.1,2i5)')
@@ -545,6 +471,8 @@ c-------TESTING CODE
         checkstop=.false.
       endif
 c-------END TESTING CODE
+            gg_lipi(3)=ssgradlipi*eij
+            gg_lipj(3)=ssgradlipj*eij
 
       do k=1,3
         dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
@@ -554,10 +482,10 @@ c-------END TESTING CODE
         gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
       enddo
       do k=1,3
-        gvdwx(k,i)=gvdwx(k,i)-gg(k)
+        gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
      &       +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
      &       +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
-        gvdwx(k,j)=gvdwx(k,j)+gg(k)
+        gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
      &       +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
      &       +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
       enddo
@@ -568,13 +496,12 @@ cgrad        enddo
 cgrad      enddo
 
       do l=1,3
-        gvdwc(l,i)=gvdwc(l,i)-gg(l)
-        gvdwc(l,j)=gvdwc(l,j)+gg(l)
+        gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(k)
+        gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(k)
       enddo
 
       return
       end
-
 C-----------------------------------------------------------------------------
 
       double precision function h_base(x,deriv)
@@ -615,15 +542,12 @@ c$$$      deriv=30.0d0*xsq*deriv
 
       return
       end
-
 c----------------------------------------------------------------------------
-
       subroutine dyn_set_nss
 c     Adjust nss and other relevant variables based on dyn_ssbond_ij
 c      implicit none
 
 c     Includes
-      implicit real*8 (a-h,o-z)
       include 'DIMENSIONS'
 #ifdef MPI
       include "mpif.h"
@@ -641,16 +565,16 @@ C      include 'COMMON.MD'
 c     Local variables
       double precision emin
       integer i,j,imin
-      integer diff,allflag(maxdim),allnss,
-     &     allihpb(maxdim),alljhpb(maxdim),
-     &     newnss,newihpb(maxdim),newjhpb(maxdim)
+      integer diff,allflag(maxdim_cont),allnss,
+     &     allihpb(maxdim_cont),alljhpb(maxdim_cont),
+     &     newnss,newihpb(maxdim_cont),newjhpb(maxdim_cont)
       logical found
       integer i_newnss(1024),displ(0:1024)
-      integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss
+      integer g_newihpb(maxdim_cont),g_newjhpb(maxdim_cont),g_newnss
 
       allnss=0
-      do i=1,nres-1
-        do j=i+1,nres
+      do i=1,ns-1
+        do j=i+1,ns
           if (dyn_ssbond_ij(i,j).lt.1.0d300) then
             allnss=allnss+1
             allflag(allnss)=0
@@ -768,1268 +692,34 @@ c     &       "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
       return
       end
 
+c----------------------------------------------------------------------------
 
-c$$$c-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine ss_relax(i_in,j_in)
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.INTERACT'
-c$$$
-c$$$c     Input arguments
-c$$$      integer i_in,j_in
-c$$$
-c$$$c     Local variables
-c$$$      integer i,iretcode,nfun_sc
-c$$$      logical scfail
-c$$$      double precision var(maxvar),e_sc,etot
-c$$$
-c$$$
-c$$$      mask_r=.true.
-c$$$      do i=nnt,nct
-c$$$        mask_side(i)=0
-c$$$      enddo
-c$$$      mask_side(i_in)=1
-c$$$      mask_side(j_in)=1
-c$$$
-c$$$c     Minimize the two selected side-chains
-c$$$      call overlap_sc(scfail)  ! Better not fail!
-c$$$      call minimize_sc(e_sc,var,iretcode,nfun_sc)
-c$$$
-c$$$      mask_r=.false.
-c$$$
-c$$$      return
-c$$$      end
-c$$$
-c$$$c-------------------------------------------------------------
-c$$$
-c$$$      subroutine minimize_sc(etot_sc,iretcode,nfun)
-c$$$c     Minimize side-chains only, starting from geom but without modifying
-c$$$c     bond lengths.
-c$$$c     If mask_r is already set, only the selected side-chains are minimized,
-c$$$c     otherwise all side-chains are minimized keeping the backbone frozen.
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.GEO'
-c$$$      include 'COMMON.MINIM'
-c$$$      integer icall
-c$$$      common /srutu/ icall
-c$$$
-c$$$c     Output arguments
-c$$$      double precision etot_sc
-c$$$      integer iretcode,nfun
-c$$$
-c$$$c     External functions/subroutines
-c$$$      external func_sc,grad_sc,fdum
-c$$$
-c$$$c     Local variables
-c$$$      integer liv,lv
-c$$$      parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) 
-c$$$      integer iv(liv)
-c$$$      double precision rdum(1)
-c$$$      double precision d(maxvar),v(1:lv),x(maxvar),xx(maxvar)
-c$$$      integer idum(1)
-c$$$      integer i,nvar_restr
-c$$$
-c$$$
-c$$$cmc      start_minim=.true.
-c$$$      call deflt(2,iv,liv,lv,v)                                         
-c$$$* 12 means fresh start, dont call deflt                                 
-c$$$      iv(1)=12                                                          
-c$$$* max num of fun calls                                                  
-c$$$      if (maxfun.eq.0) maxfun=500
-c$$$      iv(17)=maxfun
-c$$$* max num of iterations                                                 
-c$$$      if (maxmin.eq.0) maxmin=1000
-c$$$      iv(18)=maxmin
-c$$$* controls output                                                       
-c$$$      iv(19)=1
-c$$$* selects output unit                                                   
-c$$$      iv(21)=0
-c$$$c      iv(21)=iout               ! DEBUG
-c$$$c      iv(21)=8                  ! DEBUG
-c$$$* 1 means to print out result                                           
-c$$$      iv(22)=0
-c$$$c      iv(22)=1                  ! DEBUG
-c$$$* 1 means to print out summary stats                                    
-c$$$      iv(23)=0                                                          
-c$$$c      iv(23)=1                  ! DEBUG
-c$$$* 1 means to print initial x and d                                      
-c$$$      iv(24)=0                                                          
-c$$$c      iv(24)=1                  ! DEBUG
-c$$$* min val for v(radfac) default is 0.1                                  
-c$$$      v(24)=0.1D0                                                       
-c$$$* max val for v(radfac) default is 4.0                                  
-c$$$      v(25)=2.0D0                                                       
-c$$$c     v(25)=4.0D0                                                       
-c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)    
-c$$$* the sumsl default is 0.1                                              
-c$$$      v(26)=0.1D0
-c$$$* false conv if (act fnctn decrease) .lt. v(34)                         
-c$$$* the sumsl default is 100*machep                                       
-c$$$      v(34)=v(34)/100.0D0                                               
-c$$$* absolute convergence                                                  
-c$$$      if (tolf.eq.0.0D0) tolf=1.0D-4
-c$$$      v(31)=tolf
-c$$$* relative convergence                                                  
-c$$$      if (rtolf.eq.0.0D0) rtolf=1.0D-1
-c$$$      v(32)=rtolf
-c$$$* controls initial step size                                            
-c$$$       v(35)=1.0D-1                                                    
-c$$$* large vals of d correspond to small components of step                
-c$$$      do i=1,nphi
-c$$$        d(i)=1.0D-1
-c$$$      enddo
-c$$$      do i=nphi+1,nvar
-c$$$        d(i)=1.0D-1
-c$$$      enddo
-c$$$
-c$$$      call geom_to_var(nvar,x)
-c$$$      IF (mask_r) THEN
-c$$$        do i=1,nres             ! Just in case...
-c$$$          mask_phi(i)=0
-c$$$          mask_theta(i)=0
-c$$$        enddo
-c$$$        call x2xx(x,xx,nvar_restr)
-c$$$        call sumsl(nvar_restr,d,xx,func_sc,grad_sc,
-c$$$     &       iv,liv,lv,v,idum,rdum,fdum)      
-c$$$        call xx2x(x,xx)
-c$$$      ELSE
-c$$$c     When minimizing ALL side-chains, etotal_sc is a little
-c$$$c     faster if we don't set mask_r
-c$$$        do i=1,nres
-c$$$          mask_phi(i)=0
-c$$$          mask_theta(i)=0
-c$$$          mask_side(i)=1
-c$$$        enddo
-c$$$        call x2xx(x,xx,nvar_restr)
-c$$$        call sumsl(nvar_restr,d,xx,func_sc,grad_sc,
-c$$$     &       iv,liv,lv,v,idum,rdum,fdum)      
-c$$$        call xx2x(x,xx)
-c$$$      ENDIF
-c$$$      call var_to_geom(nvar,x)
-c$$$      call chainbuild_sc
-c$$$      etot_sc=v(10)                                                      
-c$$$      iretcode=iv(1)
-c$$$      nfun=iv(6)
-c$$$      return  
-c$$$      end  
-c$$$
-c$$$C--------------------------------------------------------------------------
-c$$$
-c$$$      subroutine chainbuild_sc
-c$$$      implicit none
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.INTERACT'
-c$$$
-c$$$c     Local variables
-c$$$      integer i
-c$$$
-c$$$
-c$$$      do i=nnt,nct
-c$$$        if (.not.mask_r .or. mask_side(i).eq.1) then
-c$$$          call locate_side_chain(i)
-c$$$        endif
-c$$$      enddo
-c$$$
-c$$$      return
-c$$$      end
-c$$$
-c$$$C--------------------------------------------------------------------------
-c$$$
-c$$$      subroutine func_sc(n,x,nf,f,uiparm,urparm,ufparm)  
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.MINIM'
-c$$$      include 'COMMON.IOUNITS'
-c$$$
-c$$$c     Input arguments
-c$$$      integer n
-c$$$      double precision x(maxvar)
-c$$$      double precision ufparm
-c$$$      external ufparm
-c$$$
-c$$$c     Input/Output arguments
-c$$$      integer nf
-c$$$      integer uiparm(1)
-c$$$      double precision urparm(1)
-c$$$
-c$$$c     Output arguments
-c$$$      double precision f
-c$$$
-c$$$c     Local variables
-c$$$      double precision energia(0:n_ene)
-c$$$#ifdef OSF
-c$$$c     Variables used to intercept NaNs
-c$$$      double precision x_sum
-c$$$      integer i_NAN
-c$$$#endif
-c$$$
-c$$$
-c$$$      nfl=nf
-c$$$      icg=mod(nf,2)+1
-c$$$
-c$$$#ifdef OSF
-c$$$c     Intercept NaNs in the coordinates, before calling etotal_sc
-c$$$      x_sum=0.D0
-c$$$      do i_NAN=1,n
-c$$$        x_sum=x_sum+x(i_NAN)
-c$$$      enddo
-c$$$c     Calculate the energy only if the coordinates are ok
-c$$$      if ((.not.(x_sum.lt.0.D0)) .and. (.not.(x_sum.ge.0.D0))) then
-c$$$        write(iout,*)"   *** func_restr_sc : Found NaN in coordinates"
-c$$$        f=1.0D+77
-c$$$        nf=0
-c$$$      else
-c$$$#endif
-c$$$
-c$$$      call var_to_geom_restr(n,x)
-c$$$      call zerograd
-c$$$      call chainbuild_sc
-c$$$      call etotal_sc(energia(0))
-c$$$      f=energia(0)
-c$$$      if (energia(1).eq.1.0D20 .or. energia(0).eq.1.0D99) nf=0
-c$$$
-c$$$#ifdef OSF
-c$$$      endif
-c$$$#endif
-c$$$
-c$$$      return                                                            
-c$$$      end                                                               
-c$$$
-c$$$c-------------------------------------------------------
-c$$$
-c$$$      subroutine grad_sc(n,x,nf,g,uiparm,urparm,ufparm)
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.INTERACT'
-c$$$      include 'COMMON.MINIM'
-c$$$
-c$$$c     Input arguments
-c$$$      integer n
-c$$$      double precision x(maxvar)
-c$$$      double precision ufparm
-c$$$      external ufparm
-c$$$
-c$$$c     Input/Output arguments
-c$$$      integer nf
-c$$$      integer uiparm(1)
-c$$$      double precision urparm(1)
-c$$$
-c$$$c     Output arguments
-c$$$      double precision g(maxvar)
-c$$$
-c$$$c     Local variables
-c$$$      double precision f,gphii,gthetai,galphai,gomegai
-c$$$      integer ig,ind,i,j,k,igall,ij
-c$$$
-c$$$
-c$$$      icg=mod(nf,2)+1
-c$$$      if (nf-nfl+1) 20,30,40
-c$$$   20 call func_sc(n,x,nf,f,uiparm,urparm,ufparm)
-c$$$c     write (iout,*) 'grad 20'
-c$$$      if (nf.eq.0) return
-c$$$      goto 40
-c$$$   30 call var_to_geom_restr(n,x)
-c$$$      call chainbuild_sc
-c$$$C
-c$$$C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
-c$$$C
-c$$$   40 call cartder
-c$$$C
-c$$$C Convert the Cartesian gradient into internal-coordinate gradient.
-c$$$C
-c$$$
-c$$$      ig=0
-c$$$      ind=nres-2
-c$$$      do i=2,nres-2
-c$$$       IF (mask_phi(i+2).eq.1) THEN
-c$$$        gphii=0.0D0
-c$$$        do j=i+1,nres-1
-c$$$          ind=ind+1
-c$$$          do k=1,3
-c$$$            gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
-c$$$            gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
-c$$$          enddo
-c$$$        enddo
-c$$$        ig=ig+1
-c$$$        g(ig)=gphii
-c$$$       ELSE
-c$$$        ind=ind+nres-1-i
-c$$$       ENDIF
-c$$$      enddo                                        
-c$$$
-c$$$
-c$$$      ind=0
-c$$$      do i=1,nres-2
-c$$$       IF (mask_theta(i+2).eq.1) THEN
-c$$$        ig=ig+1
-c$$$   gthetai=0.0D0
-c$$$   do j=i+1,nres-1
-c$$$          ind=ind+1
-c$$$     do k=1,3
-c$$$            gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
-c$$$            gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
-c$$$          enddo
-c$$$        enddo
-c$$$        g(ig)=gthetai
-c$$$       ELSE
-c$$$        ind=ind+nres-1-i
-c$$$       ENDIF
-c$$$      enddo
-c$$$
-c$$$      do i=2,nres-1
-c$$$   if (itype(i).ne.10) then
-c$$$         IF (mask_side(i).eq.1) THEN
-c$$$          ig=ig+1
-c$$$          galphai=0.0D0
-c$$$     do k=1,3
-c$$$       galphai=galphai+dxds(k,i)*gradx(k,i,icg)
-c$$$          enddo
-c$$$          g(ig)=galphai
-c$$$         ENDIF
-c$$$        endif
-c$$$      enddo
-c$$$
-c$$$      
-c$$$      do i=2,nres-1
-c$$$        if (itype(i).ne.10) then
-c$$$         IF (mask_side(i).eq.1) THEN
-c$$$          ig=ig+1
-c$$$     gomegai=0.0D0
-c$$$     do k=1,3
-c$$$       gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
-c$$$          enddo
-c$$$     g(ig)=gomegai
-c$$$         ENDIF
-c$$$        endif
-c$$$      enddo
-c$$$
-c$$$C
-c$$$C Add the components corresponding to local energy terms.
-c$$$C
-c$$$
-c$$$      ig=0
-c$$$      igall=0
-c$$$      do i=4,nres
-c$$$        igall=igall+1
-c$$$        if (mask_phi(i).eq.1) then
-c$$$          ig=ig+1
-c$$$          g(ig)=g(ig)+gloc(igall,icg)
-c$$$        endif
-c$$$      enddo
-c$$$
-c$$$      do i=3,nres
-c$$$        igall=igall+1
-c$$$        if (mask_theta(i).eq.1) then
-c$$$          ig=ig+1
-c$$$          g(ig)=g(ig)+gloc(igall,icg)
-c$$$        endif
-c$$$      enddo
-c$$$     
-c$$$      do ij=1,2
-c$$$      do i=2,nres-1
-c$$$        if (itype(i).ne.10) then
-c$$$          igall=igall+1
-c$$$          if (mask_side(i).eq.1) then
-c$$$            ig=ig+1
-c$$$            g(ig)=g(ig)+gloc(igall,icg)
-c$$$          endif
-c$$$        endif
-c$$$      enddo
-c$$$      enddo
-c$$$
-c$$$cd      do i=1,ig
-c$$$cd        write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i)
-c$$$cd      enddo
-c$$$
-c$$$      return
-c$$$      end
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine etotal_sc(energy_sc)
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.INTERACT'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.FFIELD'
-c$$$
-c$$$c     Output arguments
-c$$$      double precision energy_sc(0:n_ene)
-c$$$
-c$$$c     Local variables
-c$$$      double precision evdw,escloc
-c$$$      integer i,j
-c$$$
-c$$$
-c$$$      do i=1,n_ene
-c$$$        energy_sc(i)=0.0D0
-c$$$      enddo
-c$$$
-c$$$      if (mask_r) then
-c$$$        call egb_sc(evdw)
-c$$$        call esc_sc(escloc)
-c$$$      else
-c$$$        call egb(evdw)
-c$$$        call esc(escloc)
-c$$$      endif
-c$$$
-c$$$      if (evdw.eq.1.0D20) then
-c$$$        energy_sc(0)=evdw
-c$$$      else
-c$$$        energy_sc(0)=wsc*evdw+wscloc*escloc
-c$$$      endif
-c$$$      energy_sc(1)=evdw
-c$$$      energy_sc(12)=escloc
-c$$$
-c$$$C
-c$$$C Sum up the components of the Cartesian gradient.
-c$$$C
-c$$$      do i=1,nct
-c$$$        do j=1,3
-c$$$          gradx(j,i,icg)=wsc*gvdwx(j,i)
-c$$$        enddo
-c$$$      enddo
-c$$$
-c$$$      return
-c$$$      end
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine egb_sc(evdw)
-c$$$C
-c$$$C This subroutine calculates the interaction energy of nonbonded side chains
-c$$$C assuming the Gay-Berne potential of interaction.
-c$$$C
-c$$$      implicit real*8 (a-h,o-z)
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.GEO'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.LOCAL'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.NAMES'
-c$$$      include 'COMMON.INTERACT'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.CALC'
-c$$$      include 'COMMON.CONTROL'
-c$$$      logical lprn
-c$$$      evdw=0.0D0
-c$$$      energy_dec=.false.
-c$$$c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
-c$$$      evdw=0.0D0
-c$$$      lprn=.false.
-c$$$c     if (icall.eq.0) lprn=.false.
-c$$$      ind=0
-c$$$      do i=iatsc_s,iatsc_e
-c$$$        itypi=itype(i)
-c$$$        itypi1=itype(i+1)
-c$$$        xi=c(1,nres+i)
-c$$$        yi=c(2,nres+i)
-c$$$        zi=c(3,nres+i)
-c$$$        dxi=dc_norm(1,nres+i)
-c$$$        dyi=dc_norm(2,nres+i)
-c$$$        dzi=dc_norm(3,nres+i)
-c$$$c        dsci_inv=dsc_inv(itypi)
-c$$$        dsci_inv=vbld_inv(i+nres)
-c$$$c        write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-c$$$c        write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-c$$$C
-c$$$C Calculate SC interaction energy.
-c$$$C
-c$$$        do iint=1,nint_gr(i)
-c$$$          do j=istart(i,iint),iend(i,iint)
-c$$$          IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN
-c$$$            ind=ind+1
-c$$$            itypj=itype(j)
-c$$$c            dscj_inv=dsc_inv(itypj)
-c$$$            dscj_inv=vbld_inv(j+nres)
-c$$$c            write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
-c$$$c     &       1.0d0/vbld(j+nres)
-c$$$c            write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
-c$$$            sig0ij=sigma(itypi,itypj)
-c$$$            chi1=chi(itypi,itypj)
-c$$$            chi2=chi(itypj,itypi)
-c$$$            chi12=chi1*chi2
-c$$$            chip1=chip(itypi)
-c$$$            chip2=chip(itypj)
-c$$$            chip12=chip1*chip2
-c$$$            alf1=alp(itypi)
-c$$$            alf2=alp(itypj)
-c$$$            alf12=0.5D0*(alf1+alf2)
-c$$$C For diagnostics only!!!
-c$$$c           chi1=0.0D0
-c$$$c           chi2=0.0D0
-c$$$c           chi12=0.0D0
-c$$$c           chip1=0.0D0
-c$$$c           chip2=0.0D0
-c$$$c           chip12=0.0D0
-c$$$c           alf1=0.0D0
-c$$$c           alf2=0.0D0
-c$$$c           alf12=0.0D0
-c$$$            xj=c(1,nres+j)-xi
-c$$$            yj=c(2,nres+j)-yi
-c$$$            zj=c(3,nres+j)-zi
-c$$$            dxj=dc_norm(1,nres+j)
-c$$$            dyj=dc_norm(2,nres+j)
-c$$$            dzj=dc_norm(3,nres+j)
-c$$$c            write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
-c$$$c            write (iout,*) "j",j," dc_norm",
-c$$$c     &       dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
-c$$$            rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-c$$$            rij=dsqrt(rrij)
-c$$$C Calculate angle-dependent terms of energy and contributions to their
-c$$$C derivatives.
-c$$$            call sc_angular
-c$$$            sigsq=1.0D0/sigsq
-c$$$            sig=sig0ij*dsqrt(sigsq)
-c$$$            rij_shift=1.0D0/rij-sig+sig0ij
-c$$$c for diagnostics; uncomment
-c$$$c            rij_shift=1.2*sig0ij
-c$$$C I hate to put IF's in the loops, but here don't have another choice!!!!
-c$$$            if (rij_shift.le.0.0D0) then
-c$$$              evdw=1.0D20
-c$$$cd              write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c$$$cd     &        restyp(itypi),i,restyp(itypj),j,
-c$$$cd     &        rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) 
-c$$$              return
-c$$$            endif
-c$$$            sigder=-sig*sigsq
-c$$$c---------------------------------------------------------------
-c$$$            rij_shift=1.0D0/rij_shift 
-c$$$            fac=rij_shift**expon
-c$$$            e1=fac*fac*aa(itypi,itypj)
-c$$$            e2=fac*bb(itypi,itypj)
-c$$$            evdwij=eps1*eps2rt*eps3rt*(e1+e2)
-c$$$            eps2der=evdwij*eps3rt
-c$$$            eps3der=evdwij*eps2rt
-c$$$c            write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-c$$$c     &        " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
-c$$$            evdwij=evdwij*eps2rt*eps3rt
-c$$$            evdw=evdw+evdwij
-c$$$            if (lprn) then
-c$$$            sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-c$$$            epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-c$$$            write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c$$$     &        restyp(itypi),i,restyp(itypj),j,
-c$$$     &        epsi,sigm,chi1,chi2,chip1,chip2,
-c$$$     &        eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
-c$$$     &        om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
-c$$$     &        evdwij
-c$$$            endif
-c$$$
-c$$$            if (energy_dec) write (iout,'(a6,2i,0pf7.3)') 
-c$$$     &                        'evdw',i,j,evdwij
-c$$$
-c$$$C Calculate gradient components.
-c$$$            e1=e1*eps1*eps2rt**2*eps3rt**2
-c$$$            fac=-expon*(e1+evdwij)*rij_shift
-c$$$            sigder=fac*sigder
-c$$$            fac=rij*fac
-c$$$c            fac=0.0d0
-c$$$C Calculate the radial part of the gradient
-c$$$            gg(1)=xj*fac
-c$$$            gg(2)=yj*fac
-c$$$            gg(3)=zj*fac
-c$$$C Calculate angular part of the gradient.
-c$$$            call sc_grad
-c$$$          ENDIF
-c$$$          enddo      ! j
-c$$$        enddo        ! iint
-c$$$      enddo          ! i
-c$$$      energy_dec=.false.
-c$$$      return
-c$$$      end
-c$$$
-c$$$c-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine esc_sc(escloc)
-c$$$C Calculate the local energy of a side chain and its derivatives in the
-c$$$C corresponding virtual-bond valence angles THETA and the spherical angles 
-c$$$C ALPHA and OMEGA.
-c$$$      implicit real*8 (a-h,o-z)
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.GEO'
-c$$$      include 'COMMON.LOCAL'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.INTERACT'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.NAMES'
-c$$$      include 'COMMON.FFIELD'
-c$$$      include 'COMMON.CONTROL'
-c$$$      double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
-c$$$     &     ddersc0(3),ddummy(3),xtemp(3),temp(3)
-c$$$      common /sccalc/ time11,time12,time112,theti,it,nlobit
-c$$$      delta=0.02d0*pi
-c$$$      escloc=0.0D0
-c$$$c     write (iout,'(a)') 'ESC'
-c$$$      do i=loc_start,loc_end
-c$$$      IF (mask_side(i).eq.1) THEN
-c$$$        it=itype(i)
-c$$$        if (it.eq.10) goto 1
-c$$$        nlobit=nlob(it)
-c$$$c       print *,'i=',i,' it=',it,' nlobit=',nlobit
-c$$$c       write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
-c$$$        theti=theta(i+1)-pipol
-c$$$        x(1)=dtan(theti)
-c$$$        x(2)=alph(i)
-c$$$        x(3)=omeg(i)
-c$$$
-c$$$        if (x(2).gt.pi-delta) then
-c$$$          xtemp(1)=x(1)
-c$$$          xtemp(2)=pi-delta
-c$$$          xtemp(3)=x(3)
-c$$$          call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
-c$$$          xtemp(2)=pi
-c$$$          call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
-c$$$          call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
-c$$$     &        escloci,dersc(2))
-c$$$          call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
-c$$$     &        ddersc0(1),dersc(1))
-c$$$          call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
-c$$$     &        ddersc0(3),dersc(3))
-c$$$          xtemp(2)=pi-delta
-c$$$          call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
-c$$$          xtemp(2)=pi
-c$$$          call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
-c$$$          call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
-c$$$     &            dersc0(2),esclocbi,dersc02)
-c$$$          call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
-c$$$     &            dersc12,dersc01)
-c$$$          call splinthet(x(2),0.5d0*delta,ss,ssd)
-c$$$          dersc0(1)=dersc01
-c$$$          dersc0(2)=dersc02
-c$$$          dersc0(3)=0.0d0
-c$$$          do k=1,3
-c$$$            dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
-c$$$          enddo
-c$$$          dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
-c$$$c         write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c$$$c    &             esclocbi,ss,ssd
-c$$$          escloci=ss*escloci+(1.0d0-ss)*esclocbi
-c$$$c         escloci=esclocbi
-c$$$c         write (iout,*) escloci
-c$$$        else if (x(2).lt.delta) then
-c$$$          xtemp(1)=x(1)
-c$$$          xtemp(2)=delta
-c$$$          xtemp(3)=x(3)
-c$$$          call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
-c$$$          xtemp(2)=0.0d0
-c$$$          call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
-c$$$          call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
-c$$$     &        escloci,dersc(2))
-c$$$          call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
-c$$$     &        ddersc0(1),dersc(1))
-c$$$          call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
-c$$$     &        ddersc0(3),dersc(3))
-c$$$          xtemp(2)=delta
-c$$$          call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
-c$$$          xtemp(2)=0.0d0
-c$$$          call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
-c$$$          call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
-c$$$     &            dersc0(2),esclocbi,dersc02)
-c$$$          call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
-c$$$     &            dersc12,dersc01)
-c$$$          dersc0(1)=dersc01
-c$$$          dersc0(2)=dersc02
-c$$$          dersc0(3)=0.0d0
-c$$$          call splinthet(x(2),0.5d0*delta,ss,ssd)
-c$$$          do k=1,3
-c$$$            dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
-c$$$          enddo
-c$$$          dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
-c$$$c         write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c$$$c    &             esclocbi,ss,ssd
-c$$$          escloci=ss*escloci+(1.0d0-ss)*esclocbi
-c$$$c         write (iout,*) escloci
-c$$$        else
-c$$$          call enesc(x,escloci,dersc,ddummy,.false.)
-c$$$        endif
-c$$$
-c$$$        escloc=escloc+escloci
-c$$$        if (energy_dec) write (iout,'(a6,i,0pf7.3)')
-c$$$     &     'escloc',i,escloci
-c$$$c       write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
-c$$$
-c$$$        gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
-c$$$     &   wscloc*dersc(1)
-c$$$        gloc(ialph(i,1),icg)=wscloc*dersc(2)
-c$$$        gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
-c$$$    1   continue
-c$$$      ENDIF
-c$$$      enddo
-c$$$      return
-c$$$      end
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine egb_ij(i_sc,j_sc,evdw)
-c$$$C
-c$$$C This subroutine calculates the interaction energy of nonbonded side chains
-c$$$C assuming the Gay-Berne potential of interaction.
-c$$$C
-c$$$      implicit real*8 (a-h,o-z)
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.GEO'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.LOCAL'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.NAMES'
-c$$$      include 'COMMON.INTERACT'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.CALC'
-c$$$      include 'COMMON.CONTROL'
-c$$$      logical lprn
-c$$$      evdw=0.0D0
-c$$$      energy_dec=.false.
-c$$$c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
-c$$$      evdw=0.0D0
-c$$$      lprn=.false.
-c$$$      ind=0
-c$$$c$$$      do i=iatsc_s,iatsc_e
-c$$$      i=i_sc
-c$$$        itypi=itype(i)
-c$$$        itypi1=itype(i+1)
-c$$$        xi=c(1,nres+i)
-c$$$        yi=c(2,nres+i)
-c$$$        zi=c(3,nres+i)
-c$$$        dxi=dc_norm(1,nres+i)
-c$$$        dyi=dc_norm(2,nres+i)
-c$$$        dzi=dc_norm(3,nres+i)
-c$$$c        dsci_inv=dsc_inv(itypi)
-c$$$        dsci_inv=vbld_inv(i+nres)
-c$$$c        write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-c$$$c        write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-c$$$C
-c$$$C Calculate SC interaction energy.
-c$$$C
-c$$$c$$$        do iint=1,nint_gr(i)
-c$$$c$$$          do j=istart(i,iint),iend(i,iint)
-c$$$        j=j_sc
-c$$$            ind=ind+1
-c$$$            itypj=itype(j)
-c$$$c            dscj_inv=dsc_inv(itypj)
-c$$$            dscj_inv=vbld_inv(j+nres)
-c$$$c            write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
-c$$$c     &       1.0d0/vbld(j+nres)
-c$$$c            write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
-c$$$            sig0ij=sigma(itypi,itypj)
-c$$$            chi1=chi(itypi,itypj)
-c$$$            chi2=chi(itypj,itypi)
-c$$$            chi12=chi1*chi2
-c$$$            chip1=chip(itypi)
-c$$$            chip2=chip(itypj)
-c$$$            chip12=chip1*chip2
-c$$$            alf1=alp(itypi)
-c$$$            alf2=alp(itypj)
-c$$$            alf12=0.5D0*(alf1+alf2)
-c$$$C For diagnostics only!!!
-c$$$c           chi1=0.0D0
-c$$$c           chi2=0.0D0
-c$$$c           chi12=0.0D0
-c$$$c           chip1=0.0D0
-c$$$c           chip2=0.0D0
-c$$$c           chip12=0.0D0
-c$$$c           alf1=0.0D0
-c$$$c           alf2=0.0D0
-c$$$c           alf12=0.0D0
-c$$$            xj=c(1,nres+j)-xi
-c$$$            yj=c(2,nres+j)-yi
-c$$$            zj=c(3,nres+j)-zi
-c$$$            dxj=dc_norm(1,nres+j)
-c$$$            dyj=dc_norm(2,nres+j)
-c$$$            dzj=dc_norm(3,nres+j)
-c$$$c            write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
-c$$$c            write (iout,*) "j",j," dc_norm",
-c$$$c     &       dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
-c$$$            rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-c$$$            rij=dsqrt(rrij)
-c$$$C Calculate angle-dependent terms of energy and contributions to their
-c$$$C derivatives.
-c$$$            call sc_angular
-c$$$            sigsq=1.0D0/sigsq
-c$$$            sig=sig0ij*dsqrt(sigsq)
-c$$$            rij_shift=1.0D0/rij-sig+sig0ij
-c$$$c for diagnostics; uncomment
-c$$$c            rij_shift=1.2*sig0ij
-c$$$C I hate to put IF's in the loops, but here don't have another choice!!!!
-c$$$            if (rij_shift.le.0.0D0) then
-c$$$              evdw=1.0D20
-c$$$cd              write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c$$$cd     &        restyp(itypi),i,restyp(itypj),j,
-c$$$cd     &        rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) 
-c$$$              return
-c$$$            endif
-c$$$            sigder=-sig*sigsq
-c$$$c---------------------------------------------------------------
-c$$$            rij_shift=1.0D0/rij_shift 
-c$$$            fac=rij_shift**expon
-c$$$            e1=fac*fac*aa(itypi,itypj)
-c$$$            e2=fac*bb(itypi,itypj)
-c$$$            evdwij=eps1*eps2rt*eps3rt*(e1+e2)
-c$$$            eps2der=evdwij*eps3rt
-c$$$            eps3der=evdwij*eps2rt
-c$$$c            write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-c$$$c     &        " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
-c$$$            evdwij=evdwij*eps2rt*eps3rt
-c$$$            evdw=evdw+evdwij
-c$$$            if (lprn) then
-c$$$            sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-c$$$            epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-c$$$            write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c$$$     &        restyp(itypi),i,restyp(itypj),j,
-c$$$     &        epsi,sigm,chi1,chi2,chip1,chip2,
-c$$$     &        eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
-c$$$     &        om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
-c$$$     &        evdwij
-c$$$            endif
-c$$$
-c$$$            if (energy_dec) write (iout,'(a6,2i,0pf7.3)') 
-c$$$     &                        'evdw',i,j,evdwij
-c$$$
-c$$$C Calculate gradient components.
-c$$$            e1=e1*eps1*eps2rt**2*eps3rt**2
-c$$$            fac=-expon*(e1+evdwij)*rij_shift
-c$$$            sigder=fac*sigder
-c$$$            fac=rij*fac
-c$$$c            fac=0.0d0
-c$$$C Calculate the radial part of the gradient
-c$$$            gg(1)=xj*fac
-c$$$            gg(2)=yj*fac
-c$$$            gg(3)=zj*fac
-c$$$C Calculate angular part of the gradient.
-c$$$            call sc_grad
-c$$$c$$$          enddo      ! j
-c$$$c$$$        enddo        ! iint
-c$$$c$$$      enddo          ! i
-c$$$      energy_dec=.false.
-c$$$      return
-c$$$      end
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine perturb_side_chain(i,angle)
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.GEO'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.LOCAL'
-c$$$      include 'COMMON.IOUNITS'
-c$$$
-c$$$c     External functions
-c$$$      external ran_number
-c$$$      double precision ran_number
-c$$$
-c$$$c     Input arguments
-c$$$      integer i
-c$$$      double precision angle    ! In degrees
-c$$$
-c$$$c     Local variables
-c$$$      integer i_sc
-c$$$      double precision rad_ang,rand_v(3),length,cost,sint
-c$$$
-c$$$
-c$$$      i_sc=i+nres
-c$$$      rad_ang=angle*deg2rad
-c$$$
-c$$$      length=0.0
-c$$$      do while (length.lt.0.01)
-c$$$        rand_v(1)=ran_number(0.01D0,1.0D0)
-c$$$        rand_v(2)=ran_number(0.01D0,1.0D0)
-c$$$        rand_v(3)=ran_number(0.01D0,1.0D0)
-c$$$        length=rand_v(1)*rand_v(1)+rand_v(2)*rand_v(2)+
-c$$$     +       rand_v(3)*rand_v(3)
-c$$$        length=sqrt(length)
-c$$$        rand_v(1)=rand_v(1)/length
-c$$$        rand_v(2)=rand_v(2)/length
-c$$$        rand_v(3)=rand_v(3)/length
-c$$$        cost=rand_v(1)*dc_norm(1,i_sc)+rand_v(2)*dc_norm(2,i_sc)+
-c$$$     +       rand_v(3)*dc_norm(3,i_sc)
-c$$$        length=1.0D0-cost*cost
-c$$$        if (length.lt.0.0D0) length=0.0D0
-c$$$        length=sqrt(length)
-c$$$        rand_v(1)=rand_v(1)-cost*dc_norm(1,i_sc)
-c$$$        rand_v(2)=rand_v(2)-cost*dc_norm(2,i_sc)
-c$$$        rand_v(3)=rand_v(3)-cost*dc_norm(3,i_sc)
-c$$$      enddo
-c$$$      rand_v(1)=rand_v(1)/length
-c$$$      rand_v(2)=rand_v(2)/length
-c$$$      rand_v(3)=rand_v(3)/length
-c$$$
-c$$$      cost=dcos(rad_ang)
-c$$$      sint=dsin(rad_ang)
-c$$$      dc(1,i_sc)=vbld(i_sc)*(dc_norm(1,i_sc)*cost+rand_v(1)*sint)
-c$$$      dc(2,i_sc)=vbld(i_sc)*(dc_norm(2,i_sc)*cost+rand_v(2)*sint)
-c$$$      dc(3,i_sc)=vbld(i_sc)*(dc_norm(3,i_sc)*cost+rand_v(3)*sint)
-c$$$      dc_norm(1,i_sc)=dc(1,i_sc)*vbld_inv(i_sc)
-c$$$      dc_norm(2,i_sc)=dc(2,i_sc)*vbld_inv(i_sc)
-c$$$      dc_norm(3,i_sc)=dc(3,i_sc)*vbld_inv(i_sc)
-c$$$      c(1,i_sc)=c(1,i)+dc(1,i_sc)
-c$$$      c(2,i_sc)=c(2,i)+dc(2,i_sc)
-c$$$      c(3,i_sc)=c(3,i)+dc(3,i_sc)
-c$$$
-c$$$      call chainbuild_cart
-c$$$
-c$$$      return
-c$$$      end
-c$$$
-c$$$c----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine ss_relax3(i_in,j_in)
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.INTERACT'
-c$$$
-c$$$c     External functions
-c$$$      external ran_number
-c$$$      double precision ran_number
-c$$$
-c$$$c     Input arguments
-c$$$      integer i_in,j_in
-c$$$
-c$$$c     Local variables
-c$$$      double precision energy_sc(0:n_ene),etot
-c$$$      double precision org_dc(3),org_dc_norm(3),org_c(3)
-c$$$      double precision ang_pert,rand_fact,exp_fact,beta
-c$$$      integer n,i_pert,i
-c$$$      logical notdone
-c$$$
-c$$$
-c$$$      beta=1.0D0
-c$$$
-c$$$      mask_r=.true.
-c$$$      do i=nnt,nct
-c$$$        mask_side(i)=0
-c$$$      enddo
-c$$$      mask_side(i_in)=1
-c$$$      mask_side(j_in)=1
-c$$$
-c$$$      call etotal_sc(energy_sc)
-c$$$      etot=energy_sc(0)
-c$$$c      write(iout,'(a,3d15.5)')"     SS_MC_START ",energy_sc(0),
-c$$$c     +     energy_sc(1),energy_sc(12)
-c$$$
-c$$$      notdone=.true.
-c$$$      n=0
-c$$$      do while (notdone)
-c$$$        if (mod(n,2).eq.0) then
-c$$$          i_pert=i_in
-c$$$        else
-c$$$          i_pert=j_in
-c$$$        endif
-c$$$        n=n+1
-c$$$
-c$$$        do i=1,3
-c$$$          org_dc(i)=dc(i,i_pert+nres)
-c$$$          org_dc_norm(i)=dc_norm(i,i_pert+nres)
-c$$$          org_c(i)=c(i,i_pert+nres)
-c$$$        enddo
-c$$$        ang_pert=ran_number(0.0D0,3.0D0)
-c$$$        call perturb_side_chain(i_pert,ang_pert)
-c$$$        call etotal_sc(energy_sc)
-c$$$        exp_fact=exp(beta*(etot-energy_sc(0)))
-c$$$        rand_fact=ran_number(0.0D0,1.0D0)
-c$$$        if (rand_fact.lt.exp_fact) then
-c$$$c          write(iout,'(a,3d15.5)')"     SS_MC_ACCEPT ",energy_sc(0),
-c$$$c     +     energy_sc(1),energy_sc(12)
-c$$$          etot=energy_sc(0)
-c$$$        else
-c$$$c          write(iout,'(a,3d15.5)')"     SS_MC_REJECT ",energy_sc(0),
-c$$$c     +     energy_sc(1),energy_sc(12)
-c$$$          do i=1,3
-c$$$            dc(i,i_pert+nres)=org_dc(i)
-c$$$            dc_norm(i,i_pert+nres)=org_dc_norm(i)
-c$$$            c(i,i_pert+nres)=org_c(i)
-c$$$          enddo
-c$$$        endif
-c$$$
-c$$$        if (n.eq.10000.or.etot.lt.30.0D0) notdone=.false.
-c$$$      enddo
-c$$$
-c$$$      mask_r=.false.
-c$$$
-c$$$      return
-c$$$      end
-c$$$
-c$$$c----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine ss_relax2(etot,iretcode,nfun,i_in,j_in)
-c$$$      implicit none
-c$$$      include 'DIMENSIONS'
-c$$$      integer liv,lv
-c$$$      parameter (liv=60,lv=(77+maxres6*(maxres6+17)/2)) 
-c$$$*********************************************************************
-c$$$* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for *
-c$$$* the calling subprogram.                                           *     
-c$$$* when d(i)=1.0, then v(35) is the length of the initial step,      *     
-c$$$* calculated in the usual pythagorean way.                          *     
-c$$$* absolute convergence occurs when the function is within v(31) of  *     
-c$$$* zero. unless you know the minimum value in advance, abs convg     *     
-c$$$* is probably not useful.                                           *     
-c$$$* relative convergence is when the model predicts that the function *   
-c$$$* will decrease by less than v(32)*abs(fun).                        *   
-c$$$*********************************************************************
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.GEO'
-c$$$      include 'COMMON.MINIM'
-c$$$      include 'COMMON.CHAIN'
-c$$$
-c$$$      double precision orig_ss_dc,orig_ss_var,orig_ss_dist
-c$$$      common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar),
-c$$$     +     orig_ss_dist(maxres2,maxres2)
-c$$$
-c$$$      double precision etot
-c$$$      integer iretcode,nfun,i_in,j_in
-c$$$
-c$$$      external dist
-c$$$      double precision dist
-c$$$      external ss_func,fdum
-c$$$      double precision ss_func,fdum
-c$$$
-c$$$      integer iv(liv),uiparm(2)
-c$$$      double precision v(lv),x(maxres6),d(maxres6),rdum
-c$$$      integer i,j,k
-c$$$
-c$$$
-c$$$      call deflt(2,iv,liv,lv,v)                                         
-c$$$* 12 means fresh start, dont call deflt                                 
-c$$$      iv(1)=12                                                          
-c$$$* max num of fun calls                                                  
-c$$$      if (maxfun.eq.0) maxfun=500
-c$$$      iv(17)=maxfun
-c$$$* max num of iterations                                                 
-c$$$      if (maxmin.eq.0) maxmin=1000
-c$$$      iv(18)=maxmin
-c$$$* controls output                                                       
-c$$$      iv(19)=2                                                          
-c$$$* selects output unit                                                   
-c$$$c      iv(21)=iout                                                       
-c$$$      iv(21)=0
-c$$$* 1 means to print out result                                           
-c$$$      iv(22)=0                                                          
-c$$$* 1 means to print out summary stats                                    
-c$$$      iv(23)=0                                                          
-c$$$* 1 means to print initial x and d                                      
-c$$$      iv(24)=0                                                          
-c$$$* min val for v(radfac) default is 0.1                                  
-c$$$      v(24)=0.1D0                                                       
-c$$$* max val for v(radfac) default is 4.0                                  
-c$$$      v(25)=2.0D0                                                       
-c$$$c     v(25)=4.0D0                                                       
-c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)    
-c$$$* the sumsl default is 0.1                                              
-c$$$      v(26)=0.1D0
-c$$$* false conv if (act fnctn decrease) .lt. v(34)                         
-c$$$* the sumsl default is 100*machep                                       
-c$$$      v(34)=v(34)/100.0D0                                               
-c$$$* absolute convergence                                                  
-c$$$      if (tolf.eq.0.0D0) tolf=1.0D-4
-c$$$      v(31)=tolf
-c$$$      v(31)=1.0D-1
-c$$$* relative convergence                                                  
-c$$$      if (rtolf.eq.0.0D0) rtolf=1.0D-4
-c$$$      v(32)=rtolf
-c$$$      v(32)=1.0D-1
-c$$$* controls initial step size                                            
-c$$$      v(35)=1.0D-1
-c$$$* large vals of d correspond to small components of step                
-c$$$      do i=1,6*nres
-c$$$        d(i)=1.0D0
-c$$$      enddo
-c$$$
-c$$$      do i=0,2*nres
-c$$$        do j=1,3
-c$$$          orig_ss_dc(j,i)=dc(j,i)
-c$$$        enddo
-c$$$      enddo
-c$$$      call geom_to_var(nvar,orig_ss_var)
-c$$$
-c$$$      do i=1,nres
-c$$$        do j=i,nres
-c$$$          orig_ss_dist(j,i)=dist(j,i)
-c$$$          orig_ss_dist(j+nres,i)=dist(j+nres,i)
-c$$$          orig_ss_dist(j,i+nres)=dist(j,i+nres)
-c$$$          orig_ss_dist(j+nres,i+nres)=dist(j+nres,i+nres)
-c$$$        enddo
-c$$$      enddo
-c$$$
-c$$$      k=0
-c$$$      do i=1,nres-1
-c$$$        do j=1,3
-c$$$          k=k+1
-c$$$          x(k)=dc(j,i)
-c$$$        enddo
-c$$$      enddo
-c$$$      do i=2,nres-1
-c$$$        if (ialph(i,1).gt.0) then
-c$$$        do j=1,3
-c$$$          k=k+1
-c$$$          x(k)=dc(j,i+nres)
-c$$$        enddo
-c$$$        endif
-c$$$      enddo
-c$$$
-c$$$      uiparm(1)=i_in
-c$$$      uiparm(2)=j_in
-c$$$      call smsno(k,d,x,ss_func,iv,liv,lv,v,uiparm,rdum,fdum)
-c$$$      etot=v(10)
-c$$$      iretcode=iv(1)
-c$$$      nfun=iv(6)+iv(30)
-c$$$
-c$$$      k=0
-c$$$      do i=1,nres-1
-c$$$        do j=1,3
-c$$$          k=k+1
-c$$$          dc(j,i)=x(k)
-c$$$        enddo
-c$$$      enddo
-c$$$      do i=2,nres-1
-c$$$        if (ialph(i,1).gt.0) then
-c$$$        do j=1,3
-c$$$          k=k+1
-c$$$          dc(j,i+nres)=x(k)
-c$$$        enddo
-c$$$        endif
-c$$$      enddo
-c$$$      call chainbuild_cart
-c$$$
-c$$$      return  
-c$$$      end  
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine ss_func(n,x,nf,f,uiparm,urparm,ufparm)  
-c$$$      implicit none
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.INTERACT'
-c$$$      include 'COMMON.SBRIDGE'
-c$$$
-c$$$      double precision orig_ss_dc,orig_ss_var,orig_ss_dist
-c$$$      common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar),
-c$$$     +     orig_ss_dist(maxres2,maxres2)
-c$$$
-c$$$      integer n
-c$$$      double precision x(maxres6)
-c$$$      integer nf
-c$$$      double precision f
-c$$$      integer uiparm(2)
-c$$$      real*8 urparm(1)
-c$$$      external ufparm
-c$$$      double precision ufparm
-c$$$
-c$$$      external dist
-c$$$      double precision dist
-c$$$
-c$$$      integer i,j,k,ss_i,ss_j
-c$$$      double precision tempf,var(maxvar)
-c$$$
-c$$$
-c$$$      ss_i=uiparm(1)
-c$$$      ss_j=uiparm(2)
-c$$$      f=0.0D0
-c$$$
-c$$$      k=0
-c$$$      do i=1,nres-1
-c$$$        do j=1,3
-c$$$          k=k+1
-c$$$          dc(j,i)=x(k)
-c$$$        enddo
-c$$$      enddo
-c$$$      do i=2,nres-1
-c$$$        if (ialph(i,1).gt.0) then
-c$$$        do j=1,3
-c$$$          k=k+1
-c$$$          dc(j,i+nres)=x(k)
-c$$$        enddo
-c$$$        endif
-c$$$      enddo
-c$$$      call chainbuild_cart
-c$$$
-c$$$      call geom_to_var(nvar,var)
-c$$$
-c$$$c     Constraints on all angles
-c$$$      do i=1,nvar
-c$$$        tempf=var(i)-orig_ss_var(i)
-c$$$        f=f+tempf*tempf
-c$$$      enddo
-c$$$
-c$$$c     Constraints on all distances
-c$$$      do i=1,nres-1
-c$$$        if (i.gt.1) then
-c$$$          tempf=dist(i+nres,i)-orig_ss_dist(i+nres,i)
-c$$$          f=f+tempf*tempf
-c$$$        endif
-c$$$        do j=i+1,nres
-c$$$          tempf=dist(j,i)-orig_ss_dist(j,i)
-c$$$          if (tempf.lt.0.0D0 .or. j.eq.i+1) f=f+tempf*tempf
-c$$$          tempf=dist(j+nres,i)-orig_ss_dist(j+nres,i)
-c$$$          if (tempf.lt.0.0D0) f=f+tempf*tempf
-c$$$          tempf=dist(j,i+nres)-orig_ss_dist(j,i+nres)
-c$$$          if (tempf.lt.0.0D0) f=f+tempf*tempf
-c$$$          tempf=dist(j+nres,i+nres)-orig_ss_dist(j+nres,i+nres)
-c$$$          if (tempf.lt.0.0D0) f=f+tempf*tempf
-c$$$        enddo
-c$$$      enddo
-c$$$
-c$$$c     Constraints for the relevant CYS-CYS
-c$$$      tempf=dist(nres+ss_i,nres+ss_j)-8.0D0
-c$$$      f=f+tempf*tempf
-c$$$CCCCCCCCCCCCCCCCC      ADD SOME ANGULAR STUFF
-c$$$
-c$$$c$$$      if (nf.ne.nfl) then
-c$$$c$$$        write(iout,'(a,i10,2d15.5)')"IN DIST_FUNC (NF,F,DIST)",nf,
-c$$$c$$$     +       f,dist(5+nres,14+nres)
-c$$$c$$$      endif
-c$$$
-c$$$      nfl=nf
-c$$$
-c$$$      return                                                            
-c$$$      end                                                               
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$C-----------------------------------------------------------------------------
-         subroutine triple_ssbond_ene(resi,resj,resk,eij)
-      implicit real*8 (a-h,o-z)
+#ifdef SSREAD
+#ifdef WHAM
+      subroutine read_ssHist
+      implicit none
+
+c     Includes
+      include 'DIMENSIONS'
+      include "DIMENSIONS.FREE"
+      include 'COMMON.FREE'
+
+c     Local variables
+      integer i,j
+      character*80 controlcard
+
+      do i=1,dyn_nssHist
+        call card_concat(controlcard,.true.)
+        read(controlcard,*)
+     &       dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
+      enddo
+
+      return
+      end
+#endif
+#endif
+c$$$C----------------------------------------------------------------------------
+      subroutine triple_ssbond_ene(resi,resj,resk,eij)
       include 'DIMENSIONS'
       include 'COMMON.SBRIDGE'
       include 'COMMON.CHAIN'
index fa08111..91fc05e 100644 (file)
@@ -24,7 +24,7 @@
       DATA EXTEN /'.pdb'/,extmol /'.mol2'/,NUMM /'000'/,MUMM /'000'/
       external ilen
       logical viol_nmr
-      integer ib,list_peak_viol(maxdim)
+      integer ib,list_peak_viol(maxdim_cont)
       double precision Esaxs_all(maxgr),Pcalc_all(maxsaxs,maxgr)
 
       do i=1,64
index ec15fdc..da83764 100644 (file)
@@ -1,9 +1,11 @@
       integer nres,nsup,nstart_sup,nz_start,nz_end,iz_sc,
      &  nres0,nstart_seq,nchain,chain_length,chain_border,iprzes,
-     &  chain_border1,ireschain,tabpermchain,npermchain,afmend,afmbeg
+     &  chain_border1,ireschain,tabpermchain,npermchain,afmend,afmbeg,
+     &  nres_chomo,nmodel_start
       double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm,t,r,
      & prod,rt,dc_work,cref,crefjlee,dc_norm2,velAFMconst,
      & totTafm,chomo
+      character*256 pdbfiles_chomo(max_template)
       common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2),
      & xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2),
      & dc_norm2(3,0:maxres2),
@@ -30,4 +32,6 @@
      & totTafm
       common /tube/ tubecenter(3),tubeR0,
      & buftubebot, buftubetop,bordtubebot,bordtubetop,tubebufthick          
-      common /chomo_models/ chomo(3,maxres2+2,max_template)
+      common /chomo_models/ chomo(3,maxres2+2,max_template),
+     & nres_chomo(max_template),nmodel_start
+      common /chomo_files/ pdbfiles_chomo
index d65e291..8e7e4ff 100644 (file)
@@ -19,8 +19,9 @@ C 12/26/95 - H-bonding contacts
      &  facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
      &  ees0m(maxconts,maxres),d_cont(maxconts,maxres),
      &  num_cont_hb(maxres),jcont_hb(maxconts,maxres)
-C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole 
-C         interactions     
+      double precision a_chuj,a_chuj_der
+      common /dipmat/ a_chuj(2,2,maxconts,maxres),
+     &  a_chuj_der(2,2,3,5,maxconts,maxres)
 c 7/25/08 Commented out; not needed when cumulants used
 C Interactions of pseudo-dipoles generated by loc-el interactions.
 c      double precision dip,dipderg,dipderx
index 5f154e0..ae25625 100644 (file)
@@ -30,9 +30,6 @@ C consecutive amino-acid residues.
      &  costab2(maxres),sintab2(maxres)
 C This common block contains dipole-interaction matrices and their 
 C Cartesian derivatives.
-      double precision a_chuj,a_chuj_der
-      common /dipmat/ a_chuj(2,2,maxconts,maxres),
-     &  a_chuj_der(2,2,3,5,maxconts,maxres)
       double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx,
      &  ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx,
      &  AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont,EAEA,EAEAderg,EAEAderx,
index f19f0c6..e9b6320 100644 (file)
@@ -4,9 +4,10 @@
       common /homol/ waga_homology(maxprocs/20),
      & waga_dist,waga_angle,waga_theta,waga_d,dist_cut,dist2_cut
 ! Restraint parameters
-      double precision odl(max_template,maxdim),
-     & sigma_odl(max_template,maxdim),dih(max_template,maxres),
-     & sigma_dih(max_template,maxres),sigma_odlir(max_template,maxdim)
+      double precision odl(max_template,maxdim_cont),
+     & sigma_odl(max_template,maxdim_cont),dih(max_template,maxres),
+     & sigma_dih(max_template,maxres),
+     & sigma_odlir(max_template,maxdim_cont)
 !
 !    Specification of new variables used in  subroutine e_modeller
 !    modified by FP (Nov.,2014)
      & thetatpl(max_template,maxres),sigma_theta(max_template,maxres),
      & sigma_d(max_template,maxres)
 !
-      integer ires_homo(maxdim),jres_homo(maxdim),
+      integer ires_homo(maxdim_cont),jres_homo(maxdim_cont),
      & idomain(max_template,maxres),lim_odl,lim_dih,link_start_homo,
      & link_end_homo,idihconstr_start_homo,idihconstr_end_homo
-      logical l_homo(max_template,maxdim)
+      logical l_homo(max_template,maxdim_cont)
 !
       common /homrestr/ odl,dih,sigma_dih,sigma_odl,
      & lim_odl,lim_dih,ires_homo,jres_homo,link_start_homo,
index 8e4e063..8c4876d 100644 (file)
      & iatsc_s,iatsc_e,iatel_s,iatel_e,iatel_s_vdw,iatel_e_vdw,
      & iatscp_s,iatscp_e,ispp,iscp
 C 3/26/20 Interaction lists
-      integer newcontlisti(2000*maxres),newcontlistj(2000*maxres),
-     & newcontlistppi(2000*maxres),newcontlistppj(2000*maxres),
-     & newcontlistpp_vdwi(2000*maxres),newcontlistpp_vdwj(2000*maxres),
-     & newcontlistscpi(2000*maxres),newcontlistscpj(2000*maxres),
+      integer newcontlisti(maxint_res*maxres),
+     & newcontlistj(maxint_res*maxres),
+     & newcontlistppi(maxint_res*maxres),
+     & newcontlistppj(maxint_res*maxres),
+     & newcontlistpp_vdwi(maxint_res*maxres),
+     & newcontlistpp_vdwj(maxint_res*maxres),
+     & newcontlistscpi(2*maxint_res*maxres),
+     & newcontlistscpj(2*maxint_res*maxres),
      & g_listscsc_start,g_listscsc_end,g_listpp_start,g_listpp_end,
      & g_listpp_vdw_start,g_listpp_vdw_end,g_listscp_start,g_listscp_end
       common /interact_list/newcontlisti,newcontlistj,g_listscsc_start,
index e5f9a33..a71e1de 100644 (file)
@@ -1,21 +1,23 @@
       double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss
-      integer ns,nss,nfree,iss
+      integer ns,nss,nfree,iss,icys
       common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,
-     & ns,nss,nfree,iss(maxss)
+     & ns,nss,nfree,iss(max_cyst),icys(maxres)
       double precision dhpb,dhpb1,forcon,fordepth,xlscore,wboltzd,
      & dhpb_peak,dhpb1_peak,forcon_peak,fordepth_peak,scal_peak,bfac
       integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb,ibecarb_peak,npeak,
      & ipeak,
      & irestr_type,irestr_type_peak,ihpb_peak,jhpb_peak,nhpb_peak
       logical restr_on_coord
-      common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim),
-     & fordepth(maxdim),bfac(maxres),xlscore(maxdim),wboltzd,
-     & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),irestr_type(maxdim),
-     & nhpb,restr_on_coord
-      common /NMRpeaks/ dhpb_peak(maxdim),dhpb1_peak(maxdim),
-     & forcon_peak(maxdim),fordepth_peak(maxdim),scal_peak,
-     & ihpb_peak(maxdim),jhpb_peak(maxdim),ibecarb_peak(maxdim),
-     & irestr_type_peak(maxdim),ipeak(2,maxdim),npeak,nhpb_peak
+      common /links/ dhpb(maxdim_cont),dhpb1(maxdim_cont),
+     & forcon(maxdim_cont),fordepth(maxdim_cont),bfac(maxres),
+     & xlscore(maxdim_cont),wboltzd,
+     & ihpb(maxdim_cont),jhpb(maxdim_cont),ibecarb(maxdim_cont),
+     & irestr_type(maxdim_cont),nhpb,restr_on_coord
+      common /NMRpeaks/ dhpb_peak(maxdim_cont),dhpb1_peak(maxdim_cont),
+     & forcon_peak(maxdim_cont),fordepth_peak(maxdim_cont),scal_peak,
+     & ihpb_peak(maxdim_cont),jhpb_peak(maxdim_cont),
+     & ibecarb_peak(maxdim_cont),irestr_type_peak(maxdim_cont),
+     & ipeak(2,maxdim_cont),npeak,nhpb_peak
       double precision weidis
       common /restraints/ weidis
       integer link_start,link_end,link_start_peak,link_end_peak
@@ -23,6 +25,6 @@
      & link_end_peak
       double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss
       logical dyn_ss,dyn_ss_mask
-      common /dyn_ssbond/ dyn_ssbond_ij(maxres,maxres),
+      common /dyn_ssbond/ dyn_ssbond_ij(max_cyst,max_cyst),
      &  Ht,dtriss,atriss,btriss,ctriss,dyn_ss,dyn_ss_mask(maxres),
-     &  idssb(maxdim),jdssb(maxdim)
+     &  idssb(maxss),jdssb(maxss)
index aead071..eecd4c9 100644 (file)
@@ -5,10 +5,11 @@
        common /shield/ VSolvSphere,VSolvSphere_div,buff_shield,
      & long_r_sidechain(ntyp),
      & short_r_sidechain(ntyp),fac_shield(maxres),wshield,
-     & grad_shield_side(3,maxcont,-1:maxres),grad_shield(3,-1:maxres),
-     &  grad_shield_loc(3,maxcont,-1:maxres),
-     & ishield_list(maxres),shield_list(maxcont,maxres),
-     & ees0plist(maxcont,maxres)
+     & grad_shield_side(3,maxint_res,-1:maxres),
+     & grad_shield(3,-1:maxres),
+     & grad_shield_loc(3,maxint_res,-1:maxres),
+     & ishield_list(maxres),shield_list(maxint_res,maxres),
+     & ees0plist(maxint_res,maxres)
 
 
        
index 599bfa2..137b45d 100644 (file)
@@ -16,14 +16,16 @@ C Max. number of coarse-grain processors
       parameter (max_cg_procs=maxprocs)
 C Max. number of AA residues
       integer maxres
-      parameter (maxres=5000)
+      parameter (maxres=10000)
 C Max. number of AA residues per chain
       integer maxres_chain
       parameter (maxres_chain=1200)
+C Max. number of cysteines and other bridging residues
+      integer max_cyst
+      parameter (max_cyst=100)
 C Appr. max. number of interaction sites
-      integer maxres2,maxres6,maxres2_chain,mmaxres2,mmaxres2_chain
+      integer maxres2,maxres6,maxres2_chain,mmaxres2_chain
       parameter (maxres2=2*maxres,maxres6=6*maxres)
-      parameter (mmaxres2=(maxres2*(maxres2+1)/2))
       parameter (maxres2_chain=2*maxres_chain,
      &           mmaxres2_chain=maxres2_chain*(maxres2_chain+1)/2)
 C Max number of symetric chains
@@ -49,6 +51,16 @@ C Max. number of contacts per residue
       integer maxconts
       parameter (maxconts=maxres)
 c      parameter (maxconts=50)
+C Max. number of interactions within cutoff per residue
+      integer maxint_res
+      parameter (maxint_res=200)
+C Max. number od residues within distance cufoff from a given residue to 
+C     include in template-based/contact distance restraints.
+      integer maxcont_res
+      parameter (maxcont_res=200)
+C Max. number of distance/contact-distance restraints
+      integer maxdim_cont
+      parameter (maxdim_cont=maxres*maxcont_res)
 C Number of AA types (at present only natural AA's will be handled
       integer ntyp,ntyp1
       parameter (ntyp=24,ntyp1=ntyp+1)
@@ -74,9 +86,10 @@ c Max number of torsional terms in SCCOR
 C Max. number of lobes in SC distribution
       integer maxlob
       parameter (maxlob=4)
-C Max. number of S-S bridges
+C Max. number of S-S bridges and other links
       integer maxss
-      parameter (maxss=20)
+c      parameter (maxss=20)
+      parameter (maxss=max_cyst*(max_cyst-1)/2)
 C Max. number of dihedral angle constraints
       integer maxdih_constr
       parameter (maxdih_constr=maxres)
index d82cf17..fcef69e 100644 (file)
@@ -264,10 +264,10 @@ C          call check_ecartint
         if (rstcount.eq.1000.or.itime.eq.n_timestep) then
            open(irest2,file=rest2name,status='unknown')
            write(irest2,*) totT,EK,potE,totE,t_bath
-           do i=1,2*nres
+           do i=0,2*nres-1
             write (irest2,'(3e15.5)') (d_t(j,i),j=1,3)
            enddo
-           do i=1,2*nres
+           do i=0,2*nres-1
             write (irest2,'(3e15.5)') (dc(j,i),j=1,3)
            enddo
           close(irest2)
@@ -1671,6 +1671,7 @@ c  Set up the initial conditions of a MD simulation
       integer iran_num
       double precision etot
       logical fail
+      integer i_start_models(0:nodes-1)
       write (iout,*) "init_MD INDPDB",indpdb
       d_time0=d_time
 c      write(iout,*) "d_time", d_time
@@ -1758,10 +1759,10 @@ c        statname=statname(:ilen(statname)-5)//qstr(:ipos-1)//'.stat'
          if (me.eq.king)
      &     inquire(file=mremd_rst_name,exist=file_exist)
 #ifdef MPI
-           write (*,*) me," Before broadcast: file_exist",file_exist
+c           write (*,*) me," Before broadcast: file_exist",file_exist
          call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM,
      &          IERR)
-         write (*,*) me," After broadcast: file_exist",file_exist
+c         write (*,*) me," After broadcast: file_exist",file_exist
 c        inquire(file=mremd_rst_name,exist=file_exist)
 #endif
         if(me.eq.king.or..not.out1file)
@@ -1839,7 +1840,18 @@ c Removing the velocity of the center of mass
        call flush(iout)
       endif
       endif
-      write (iout,*) "init_MD before initial structure REST ",rest
+c      write (iout,*) "init_MD before initial structure REST ",rest
+      if(start_from_model .and. (me.eq.king .or. .not. out1file))
+     &    write(iout,*) 'START_FROM_MODELS is ON'
+      if(start_from_model .and. rest) then 
+        if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
+         write(iout,*) 
+     &   'START_FROM_MODELS is OFF because the run is restarted'
+         write(iout,*) 'Remove restart keyword from input'
+        endif
+      endif
+c      write (iout,*) "rest ",rest," start_from_model",start_from_model,
+c     &  " nmodel_start",nmodel_start," preminim",preminim
       if (.not.rest) then
   122   continue
         if (iranconf.ne.0) then
@@ -1920,9 +1932,12 @@ c 8/22/17 AL Loop to produce a low-energy random conformation
         else if (preminim) then
           if (start_from_model) then
             n_model_try=0
-            do while (fail .and. n_model_try.lt.constr_homology)
+            fail=.true.
+            list_model_try=0
+            do while (fail .and. n_model_try.lt.nmodel_start)
+              write (iout,*) "n_model_try",n_model_try
               do
-                i_model=iran_num(1,constr_homology)
+                i_model=iran_num(1,nmodel_start)
                 do k=1,n_model_try
                   if (i_model.eq.list_model_try(k)) exit
                 enddo
@@ -1930,7 +1945,9 @@ c 8/22/17 AL Loop to produce a low-energy random conformation
               enddo
               n_model_try=n_model_try+1
               list_model_try(n_model_try)=i_model
-              write (iout,*) 'starting from model ',i_model
+              if (me.eq.king .or. .not. out1file)
+     &         write (iout,*) 'Trying to start from model ',
+     &         pdbfiles_chomo(i_model)(:ilen(pdbfiles_chomo(i_model)))
               do i=1,2*nres
                 do j=1,3
                   c(j,i)=chomo(j,i,i_model)
@@ -1981,10 +1998,14 @@ c 8/22/17 AL Loop to produce a low-energy random conformation
               call etotal(energia(0))
 #endif
             enddo
-            if (n_model_try.gt.constr_homology) then
+            call MPI_Gather(i_model,1,MPI_INTEGER,i_start_models(0),
+     &        1,MPI_INTEGER,king,CG_COMM,IERROR)
+            if (n_model_try.gt.nmodel_start .and. 
+     &         (me.eq.king .or. out1file)) then
               write (iout,*) 
      &    "All models have irreparable overlaps. Trying randoms starts."
               iranconf=1
+              i_model=nmodel_start+1
               goto 122
             endif
           else
@@ -2027,6 +2048,17 @@ C 8/22/17 AL Minimize initial structure
 #endif
           endif
         endif
+        if (nmodel_start.gt.0 .and. me.eq.king) then
+          write (iout,'(a)') "Task  Starting model"
+          do i=0,nodes-1
+            if (i_start_models(i).gt.nmodel_start) then
+              write (iout,'(i4,2x,a)') i,"RANDOM STRUCTURE"
+            else
+              write(iout,'(i4,2x,a)')i,pdbfiles_chomo(i_start_models(i))
+     &          (:ilen(pdbfiles_chomo(i_start_models(i))))
+            endif
+          enddo
+        endif
       endif ! .not. rest
       call chainbuild_cart
       call kinetic(EK)
@@ -2034,6 +2066,7 @@ C 8/22/17 AL Minimize initial structure
         call verlet_bath
       endif
       kinetic_T=2.0d0/(dimen3*Rb)*EK
+      write (iout,*) "Initial kinetic energy",EK," kinetic T",kinetic_T
       if(me.eq.king.or..not.out1file)then
        call cartprint
        call intout
index debe2b1..d0b13b1 100644 (file)
@@ -36,11 +36,11 @@ c  determine # of nodes and current node
       MyRank=me
 C Determine the number of "fine-grain" tasks
       call getenv_loc("FGPROCS",cfgprocs)
-      print *,cfgprocs
+c      print *,cfgprocs
       read (cfgprocs,'(i3)') nfgtasks
       if (nfgtasks.eq.0) nfgtasks=1
       call getenv_loc("MAXGSPROCS",cfgprocs)
-      print *,cfgprocs
+c      print *,cfgprocs
       read (cfgprocs,'(i3)') max_gs_size
       if (max_gs_size.eq.0) max_gs_size=2
       if (lprn) 
index 9191402..f22e2f6 100644 (file)
@@ -57,7 +57,7 @@ cold      integer nup(0:maxprocs),ndown(0:maxprocs)
       integer rep2i(0:maxprocs),ireqi(maxprocs)
       integer icache_all(maxprocs)
       integer status(MPI_STATUS_SIZE),statusi(MPI_STATUS_SIZE,maxprocs)
-      logical synflag,end_of_run,file_exist /.false./,ovrtim
+      logical synflag,end_of_run,file_exist /.false./,ovrtim,first_pass
       double precision t_bath_temp,delta,ene_iex_iex,ene_i_i,ene_iex_i,
      & ene_i_iex,xxx,tmp,econstr_temp_iex,econstr_temp_i
       integer iran_num
@@ -145,8 +145,8 @@ cold       endif
 cd       print '(i4,a6,100i4)',me,' ndown',(ndown(i),i=0,ndown(0))
 
        
-       write (*,*) "Processor",me," rest",rest,"
-     &   restart1fie",restart1file
+c       write (*,*) "Processor",me," rest",rest,"
+c     &   restart1fie",restart1file
        if(rest.and.restart1file) then 
            if (me.eq.king)
      &     inquire(file=mremd_rst_name,exist=file_exist)
@@ -424,6 +424,8 @@ c   Entering the MD loop
 #endif
       itime=0
       end_of_run=.false.
+      first_pass=.not.rest
+c      write (iout,*) "first_pass",first_pass
       do while(.not.end_of_run)
         itime=itime+1
         if(itime.eq.n_timestep.and.me.eq.king) end_of_run=.true.
@@ -942,7 +944,10 @@ c               write (iout,*) "ene_i_i",remd_ene(0,i)
 c               call flush(iout)
 c               write (iout,*) "rescaling weights with temperature",
 c     &          remd_t_bath(iex)
-               if (real(ene_i_i).ne.real(remd_ene(0,i))) then
+c               write (iout,*) "first_pass",first_pass
+               if (.not.first_pass.and.
+     &           real(ene_i_i).ne.real(remd_ene(0,i))) 
+     &         then
                 write (iout,*) "ERROR: inconsistent energies:",i,
      &            ene_i_i,remd_ene(0,i)
                endif
@@ -960,7 +965,8 @@ c               write (iout,*) "0,iex",remd_t_bath(iex)
 c               call enerprint(remd_ene(0,iex))
 
                call sum_energy(remd_ene(0,iex),.false.)
-               if (real(ene_iex_iex).ne.real(remd_ene(0,iex))) then
+               if (.not.first_pass.and.
+     &           real(ene_iex_iex).ne.real(remd_ene(0,iex))) then
                 write (iout,*) "ERROR: inconsistent energies:",iex,
      &            ene_iex_iex,remd_ene(0,iex)
                endif
@@ -1065,6 +1071,7 @@ c              call flush(iout)
             endif
            enddo
            enddo
+           first_pass=.false.
 cd           write (iout,*) "exchange completed"
 cd           call flush(iout) 
         ELSE
@@ -1383,7 +1390,7 @@ c-----------------------------------------------------------------------
       include 'COMMON.SBRIDGE'
       include 'COMMON.INTERACT'
                
-      real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres),
+      real d_restart1(3,2*maxres*maxprocs),r_d(3,0:2*maxres-1),
      &     d_restart2(3,2*maxres*maxprocs)
       real t5_restart1(5)
       integer iret,itmp
@@ -1403,7 +1410,7 @@ c-----------------------------------------------------------------------
      &      t_restart1,5,mpi_real,king,CG_COMM,ierr)
 
 
-       do i=1,2*nres
+       do i=0,2*nres-1
          do j=1,3
            r_d(j,i)=d_t(j,i)
          enddo
@@ -1413,7 +1420,7 @@ c-----------------------------------------------------------------------
      &           CG_COMM,ierr)
 
 
-       do i=1,2*nres
+       do i=0,2*nres-1
          do j=1,3
            r_d(j,i)=dc(j,i)
          enddo
@@ -1794,14 +1801,14 @@ c end debugging
       include 'COMMON.CHAIN'
       include 'COMMON.SBRIDGE'
       include 'COMMON.INTERACT'
-      real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres),
+      real d_restart1(3,2*maxres*maxprocs),r_d(3,0:2*maxres-1),
      &                 t5_restart1(5)
       integer*2 i_index
      &            (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200)
       common /przechowalnia/ d_restart1
       integer i,j,il,il1,ixdrf,iret,itmp
       integer ierr
-      write (*,*) "Processor",me," called read1restart"
+c      write (*,*) "Processor",me," called read1restart"
 
          if(me.eq.king)then
               open(irest2,file=mremd_rst_name,status='unknown')
@@ -1888,7 +1895,7 @@ c     &                (d_restart1(j,i+2*nres*il),j=1,3)
          call mpi_scatter(d_restart1,3*2*nres,mpi_real,
      &           r_d,3*2*nres,mpi_real,king,CG_COMM,ierr)
 
-         do i=1,2*nres
+         do i=0,2*nres-1
            do j=1,3
             d_t(j,i)=r_d(j,i)
            enddo
@@ -1910,7 +1917,7 @@ c     &                (d_restart1(j,i+2*nres*il),j=1,3)
          endif
          call mpi_scatter(d_restart1,3*2*nres,mpi_real,
      &           r_d,3*2*nres,mpi_real,king,CG_COMM,ierr)
-         do i=1,2*nres
+         do i=0,2*nres-1
            do j=1,3
             dc(j,i)=r_d(j,i)
            enddo
@@ -1991,7 +1998,7 @@ c     &           CG_COMM,ierr)
       include 'COMMON.CHAIN'
       include 'COMMON.SBRIDGE'
       include 'COMMON.INTERACT'
-      real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres),
+      real d_restart1(3,2*maxres*maxprocs),r_d(3,0:2*maxres-1),
      &                 t5_restart1(5)
       common /przechowalnia/ d_restart1
       integer i,j,il,itmp
@@ -2027,7 +2034,7 @@ c     &           CG_COMM,ierr)
          call mpi_scatter(d_restart1,3*2*nres,mpi_real,
      &           r_d,3*2*nres,mpi_real,king,CG_COMM,ierr)
 
-         do i=1,2*nres
+         do i=0,2*nres-1
            do j=1,3
             d_t(j,i)=r_d(j,i)
            enddo
@@ -2042,7 +2049,7 @@ c     &           CG_COMM,ierr)
          endif
          call mpi_scatter(d_restart1,3*2*nres,mpi_real,
      &           r_d,3*2*nres,mpi_real,king,CG_COMM,ierr)
-         do i=1,2*nres
+         do i=0,2*nres-1
            do j=1,3
             dc(j,i)=r_d(j,i)
            enddo
diff --git a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton
new file mode 100644 (file)
index 0000000..11b83dd
--- /dev/null
@@ -0,0 +1,200 @@
+###################################################################
+#INSTALL_DIR = /opt/cray/mpt/7.3.2/gni/mpich-intel/15.0
+
+FC = mpif90 -fc=ifort
+
+OPT =  -O3 -ip -mcmodel=medium -shared-intel
+#OPT =  -g -CA -CB -mcmodel=medium -shared-intel
+
+FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include
+FFLAGS1 = -c  -g -CA -CB -mcmodel=medium -shared-intel
+#FFLAGS1 = ${FFLAGS}
+FFLAGS2 = -c  -g -O0 -mcmodel=medium -shared-intel
+#FFLAGSE = -c  -O3 -ipo -mcmodel=medium -shared-intel
+FFLAGSE = ${FFLAGS}
+
+
+#LIBS = -L$(INSTALL_DIR)/lib -lmpi xdrf/libxdrf.a
+LIBS = -lmpi xdrf/libxdrf.a
+#/opt/cray/mpt/7.3.2/gni/mpich-intel/15.0/lib/libmpich.a
+
+ARCH = LINUX
+PP = /lib/cpp -P
+
+all: no_option
+       @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR"
+
+.SUFFIXES: .F
+.F.o:
+       ${FC} ${FFLAGS} ${CPPFLAGS} $*.F
+
+
+object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \
+        matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \
+        pinorm.o randgens.o rescode.o intcor.o timing.o misc.o \
+        cart2intgrad.o checkder_p.o contact_cp econstr_local.o econstr_qlike.o \
+       econstrq-PMF.o PMFprocess.o energy_p_new_barrier.o make_xx_list.o \
+       energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \
+        cored.o rmdd.o geomout.o readpdb-mult.o int_from_cart.o regularize.o \
+       thread.o fitsq.o mcm.o \
+        mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o \
+        eigen.o blas.o add.o entmcm.o minim_mcmf.o \
+        together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \
+        indexx.o MP.o compare_s1.o prng_32.o \
+        banach.o rmsd.o rmscalc.o elecont.o dihed_cons.o \
+        sc_move.o local_move.o djacob.o \
+        intcartderiv.o lagrangian_lesyng.o\
+       chain_symmetry.o permut.o seq2chains.o iperm.o\
+       stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \
+        surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \
+       q_measure.o gnmr1.o mygauss.o ssMD.o
+
+object_lbfgs = inform.o iounit.o keys.o linmin.o math.o minima.o scales.o output.o lbfgs.o search.o optsave_dum.o
+
+no_option:
+
+GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
+       -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY
+GAB: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD.exe
+GAB: ${object} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       ${FC} ${OPT} ${object} cinfo.o ${LIBS}  -o ${BIN}
+
+4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
+       -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY
+4P: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD.exe
+4P: ${object} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       ${FC} ${OPT} ${object} cinfo.o ${LIBS}  -o ${BIN}
+
+E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
+       -DSPLITELE -DLANG0 -DFOURBODY
+E0LL2Y: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD.exe
+E0LL2Y: ${object} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       ${FC} ${OPT} ${object} cinfo.o ${LIBS}  -o ${BIN}
+
+E0LL2Y_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
+       -DSPLITELE -DLANG0 -DFOURBODY -DDFA
+E0LL2Y_DFA: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD-DFA.exe
+E0LL2Y_DFA: ${object} dfa.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       ${FC} ${OPT} ${object} dfa.o cinfo.o ${LIBS}  -o ${BIN}
+
+NEWCORR: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
+       -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD #-DFOURBODY #-DMYGAUSS #-DTIMING
+NEWCORR: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD.exe
+NEWCORR: ${object} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
+
+NEWCORR5D: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
+       -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DFIVEDIAG -DLBFGS #-DMYGAUSS #-DTIMING
+NEWCORR5D: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD5.exe
+NEWCORR5D: ${object_lbfgs} ${object} fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       ${FC} ${OPT} ${object} ${object_lbfgs} fdisy.o fdiag.o machpd.o kinetic_CASC.o cinfo.o ${LIBS} -o ${BIN}
+#${FC} ${OPT} ${object} ${object_lbfgs} fdisy.o fdiag.o machpd.o kinetic_CASC.o cinfo.o ${LIBS} -Wl,-M -o ${BIN}
+
+NEWCORR_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
+       -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DDFA #-DMYGAUSS #-DTIMING
+NEWCORR_DFA: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD-DFA.exe
+NEWCORR_DFA: ${object} dfa.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       ${FC} ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN}
+
+NEWCORR5D_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
+       -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DFIVEDIAG -DLBFGS -DDFA #-DMYGAUSS #-DTIMING
+NEWCORR5D_DFA: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD5-DFA.exe
+NEWCORR5D_DFA: ${object_lbfgs} ${object} dfa.o fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       ${FC} ${OPT} ${object_lbfgs} ${object} fdisy.o fdiag.o machpd.o dfa.o kinetic_CASC.o cinfo.o ${LIBS}  -o ${BIN}
+
+xdrf/libxdrf.a:
+       cd xdrf && make
+
+
+clean:
+       /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean
+
+test.o: test.F
+       ${FC} ${FFLAGS} ${CPPFLAGS} test.F
+
+chainbuild.o: chainbuild.F
+       ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F
+
+djacob.o: djacob.f
+       ${FC} ${FFLAGS2} djacob.f
+
+matmult.o: matmult.f
+       ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f
+
+parmread.o : parmread.F
+       ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F
+
+intcor.o : intcor.f
+       ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f
+
+cartder.o : cartder.F
+       ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F
+
+readpdb.o : readpdb.F
+       ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F
+
+readpdb-mult.o : readpdb-mult.F
+       ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb-mult.F
+
+sumsld.o : sumsld.f
+       ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f
+        
+cored.o : cored.f
+       ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f
+rmdd.o : rmdd.f
+       ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f
+
+energy_p_new_barrier.o : energy_p_new_barrier.F
+       ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F
+
+gradient_p.o : gradient_p.F
+       ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F
+
+energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F
+       ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F
+
+lagrangian_lesyng.o : lagrangian_lesyng.F
+       ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F
+
+MD_A-MTS.o : MD_A-MTS.F
+       ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F
+
+blas.o : blas.f
+       ${FC} ${FFLAGS1} blas.f
+
+add.o : add.f
+       ${FC} ${FFLAGS1} add.f
+
+eigen.o : eigen.f
+       ${FC} ${FFLAGS2} eigen.f
+
+dfa.o: dfa.F
+       ${FC} ${FFLAGS2} dfa.F
+
+proc_proc.o: proc_proc.c
+       ${CC} ${CFLAGS} proc_proc.c
diff --git a/source/unres/src-HCD-5D/contact_cp2.F b/source/unres/src-HCD-5D/contact_cp2.F
new file mode 100644 (file)
index 0000000..785c8cb
--- /dev/null
@@ -0,0 +1,148 @@
+      subroutine contact_cp2(var,var2,iff,ieval,in_pdb)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+#ifdef MPI
+      include 'mpif.h'
+#endif
+      include 'COMMON.SBRIDGE'
+      include 'COMMON.FFIELD'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.DISTFIT'
+      include 'COMMON.VAR'
+      include 'COMMON.CHAIN'
+      include 'COMMON.MINIM'
+
+      character*50 linia
+      integer nf,ij(4)
+      double precision var(maxvar),var2(maxvar)
+      double precision time0,time1
+      integer iff(maxres),ieval      
+      double precision theta1(maxres),phi1(maxres),alph1(maxres),     
+     &                 omeg1(maxres)                             
+      
+
+       call var_to_geom(nvar,var)
+       call chainbuild                                                           
+       nhpb0=nhpb
+       ind=0                                                                     
+       do i=1,nres-3                                                             
+         do j=i+3,nres                                                           
+          ind=ind+1                                                              
+          if ( iff(i).eq.1.and.iff(j).eq.1 ) then                                           
+            d0(ind)=DIST(i,j)                                                     
+            w(ind)=10.0                                                           
+            nhpb=nhpb+1                                                           
+            ihpb(nhpb)=i                                                          
+            jhpb(nhpb)=j                                                          
+            forcon(nhpb)=10.0                                                     
+            dhpb(nhpb)=d0(ind)                                                    
+          else
+            w(ind)=0.0
+          endif                                                                  
+         enddo                                                                   
+       enddo                                    
+       call hpb_partition
+
+       do i=1,nres                                                               
+        theta1(i)=theta(i)                                                      
+        phi1(i)=phi(i)                                                          
+        alph1(i)=alph(i)                                                        
+        omeg1(i)=omeg(i)                                                        
+       enddo                      
+
+       call var_to_geom(nvar,var2)
+
+       do i=1,nres                                                             
+          if ( iff(i).eq.1 ) then                                           
+              theta(i)=theta1(i)                                                      
+              phi(i)=phi1(i)                                                          
+              alph(i)=alph1(i)                                                        
+              omeg(i)=omeg1(i)                       
+          endif
+       enddo
+
+       call chainbuild
+cd       call write_pdb(3,'combined structure',0d0)
+cd       time0=MPI_WTIME()
+       
+       NX=NRES-3                                                                 
+       NY=((NRES-4)*(NRES-5))/2 
+       call distfit(.true.,200)
+   
+cd       time1=MPI_WTIME()
+cd       write (iout,'(a,f6.2,a)') ' Time for distfit ',time1-time0,' sec'
+
+       ipot0=ipot
+       maxmin0=maxmin
+       maxfun0=maxfun
+       wstrain0=wstrain
+
+       ipot=6
+       maxmin=2000
+       maxfun=5000
+       call geom_to_var(nvar,var)
+cd       time0=MPI_WTIME()
+       call minimize(etot,var,iretcode,nfun)                               
+       write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun   
+
+cd       time1=MPI_WTIME()
+cd       write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0,
+cd     &         nfun/(time1-time0),' SOFT eval/s'
+        call var_to_geom(nvar,var)
+        call chainbuild
+
+
+        iwsk=0
+        nf=0
+        if (iff(1).eq.1) then
+          iwsk=1
+          nf=nf+1
+          ij(nf)=0
+        endif
+        do i=2,nres
+           if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then
+             iwsk=1
+             nf=nf+1
+             ij(nf)=i
+           endif
+           if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then
+             iwsk=0
+             nf=nf+1
+             ij(nf)=i-1
+           endif
+        enddo
+        if (iff(nres).eq.1) then
+          nf=nf+1
+          ij(nf)=nres
+        endif
+
+
+cd        write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)')
+cd     &                     "select",ij(1),"-",ij(2),
+cd     &                         ",",ij(3),"-",ij(4)
+cd        call write_pdb(in_pdb,linia,etot)
+
+
+       ipot=ipot0
+       maxmin=maxmin0
+       maxfun=maxfun0
+cd       time0=MPI_WTIME()
+       call minimize(etot,var,iretcode,nfun)
+cd       write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun
+       ieval=nfun
+
+cd       time1=MPI_WTIME()
+cd       write (iout,'(a,f6.2,f8.2,a)')' Time for DIST min.',time1-time0,
+cd     &         nfun/(time1-time0),' eval/s'
+cd       call var_to_geom(nvar,var)
+cd       call chainbuild
+cd       call write_pdb(6,'dist structure',etot)
+
+
+       nhpb= nhpb0                                                                  
+       link_start=1                                                            
+       link_end=nhpb     
+       wstrain=wstrain0
+
+       return
+       end
index 96f7777..28ba1d1 100644 (file)
@@ -639,7 +639,6 @@ c     double precision rrsave(maxdim)
       logical lprn
       evdw=0.0D0
 c     print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
-      evdw=0.0D0
 c     if (icall.eq.0) then
 c       lprn=.true.
 c     else
@@ -1100,7 +1099,6 @@ C
       double precision sss1,sssgrad1
       evdw=0.0D0
 c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
-      evdw=0.0D0
       lprn=.false.
 c     if (icall.eq.0) lprn=.true.
       ind=0
@@ -1254,7 +1252,6 @@ C
       double precision boxshift
       evdw=0.0D0
 c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
-      evdw=0.0D0
       lprn=.false.
 c     if (icall.eq.0) lprn=.true.
       ind=0
index 190574e..3f5429d 100644 (file)
@@ -118,9 +118,17 @@ c        call chainbuild_cart
 c      write (iout,*) "itime_mat",itime_mat," imatupdate",imatupdate
       if (mod(itime_mat,imatupdate).eq.0) then
         call make_SCp_inter_list
+c        write (iout,*) "Finished make_SCp_inter_list"
+c        call flush(iout)
         call make_SCSC_inter_list
+c        write (iout,*) "Finished make_SCSC_inter_list"
+c        call flush(iout)
         call make_pp_inter_list
+c        write (iout,*) "Finished make_pp_inter_list"
+c        call flush(iout)
         call make_pp_vdw_inter_list
+c        write (iout,*) "Finished make_pp_vdw_inter_list"
+c        call flush(iout)
       endif
 c      print *,'Processor',myrank,' calling etotal ipot=',ipot
 c      print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
@@ -366,7 +374,17 @@ c         call flush(iout)
 c         write (iout,*) "MULTIBODY_HB ecorr",ecorr,ecorr5,ecorr6,n_corr,
 c     &     n_corr1
 c         call flush(iout)
+      else
+         ecorr=0.0d0
+         ecorr5=0.0d0
+         ecorr6=0.0d0
+         eturn6=0.0d0
       endif
+#else
+      ecorr=0.0d0
+      ecorr5=0.0d0
+      ecorr6=0.0d0
+      eturn6=0.0d0
 #endif
 c      print *,"Processor",myrank," computed Ucorr"
 c      write (iout,*) "nsaxs",nsaxs," saxs_mode",saxs_mode
@@ -409,15 +427,17 @@ C      print *,"za lipidami"
         call AFMforce(Eafmforce)
       else if (selfguide.gt.0) then
         call AFMvel(Eafmforce)
+      else 
+        Eafmforce=0.0d0
       endif
       if (TUBElog.eq.1) then
 C      print *,"just before call"
         call calctube(Etube)
-       elseif (TUBElog.eq.2) then
+      elseif (TUBElog.eq.2) then
         call calctube2(Etube)
-       else
-       Etube=0.0d0
-       endif
+      else
+        Etube=0.0d0
+      endif
 
 #ifdef TIMING
       time_enecalc=time_enecalc+MPI_Wtime()-time00
index f16bc1b..11ea406 100644 (file)
@@ -44,6 +44,13 @@ c        if (fg_rank.eq.0) call int_from_cart1(.false.)
 #endif
       endif
 #ifdef MPI      
+      edfadis=0.0d0
+      edfator=0.0d0
+      edfanei=0.0d0
+      edfabet=0.0d0
+      ehomology_constr=0.0d0
+      Uconst=0.0d0
+      Uconst_back=0.0d0
 c      write(iout,*) "ETOTAL_LONG Processor",fg_rank,
 c     & " absolute rank",myrank," nfgtasks",nfgtasks
 c      call flush(iout)
@@ -137,7 +144,6 @@ c      print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
         call make_pp_vdw_inter_list
       endif
 #endif     
-
 cd    print *,'nnt=',nnt,' nct=',nct
 C
 C Compute the side-chain and electrostatic interaction energy
@@ -231,7 +237,17 @@ c     &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
       endif
       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)
+      else
+         ecorr=0.0d0
+         ecorr5=0.0d0
+         ecorr6=0.0d0
+         eturn6=0.0d0
       endif
+#else
+         ecorr=0.0d0
+         ecorr5=0.0d0
+         ecorr6=0.0d0
+         eturn6=0.0d0
 #endif
 C 
 C If performing constraint dynamics, call the constraint energy
@@ -340,6 +356,18 @@ c      call flush(iout)
       edfanei=0.0d0
       edfabet=0.0d0
 #endif
+      evdw=0.0d0
+      ees=0.0d0
+      evdw1=0.0d0
+      eel_loc=0.0d0
+      eello_turn3=0.0d0
+      eello_turn4=0.0d0
+      evdw2=0
+      evdw2_14=0
+      ecorr=0.0d0
+      ecorr5=0.0d0
+      ecorr6=0.0d0
+      eturn6=0.0d0
 c      write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
 c     & " absolute rank",myrank," nfgtasks",nfgtasks
 c      call flush(iout)
@@ -526,6 +554,21 @@ c Lipid transfer
       else
         eliptran=0.0d0
       endif
+      if (AFMlog.gt.0) then
+        call AFMforce(Eafmforce)
+      else if (selfguide.gt.0) then
+        call AFMvel(Eafmforce)
+      else 
+        Eafmforce=0.0d0
+      endif
+      if (TUBElog.eq.1) then
+C      print *,"just before call"
+        call calctube(Etube)
+      elseif (TUBElog.eq.2) then
+        call calctube2(Etube)
+      else
+        Etube=0.0d0
+      endif
 
       if (ndih_constr.gt.0) call etor_constr(edihcnstr)
 c      print *,"Processor",myrank," computed Utor"
index b5e5595..9f5567d 100644 (file)
@@ -281,7 +281,7 @@ c-------------------------------------------------------------------------
       double precision eig_limit /1.0D-8/
       double precision Big /10.0D0/
       double precision vec(3,3)
-      logical lprint,fail,lcheck
+      logical lprint,fail,lcheck,lprn /.false./
       lcheck=.false.
       lprint=.false.
       fail=.false.
@@ -514,10 +514,12 @@ C
       endif
       if (box(1,2).lt.-MaxBoxLen .or. box(2,2).gt.MaxBoxLen) then
 #ifdef MPI
+        if (lprn) then
         write (iout,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.'
         write (*,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.'
+        endif
 #else
-c        write (iout,'(a)') 'Bad sampling box.'
+        if (lprn) write (iout,'(a)') 'Bad sampling box.'
 #endif
         fail=.true.
         return
index 855c7a4..710f907 100644 (file)
@@ -261,10 +261,10 @@ C Initialize the bridge arrays
       ns=0
       nss=0 
       nhpb=0
-      do i=1,maxss
+      do i=1,max_cyst
        iss(i)=0
       enddo
-      do i=1,maxdim
+      do i=1,maxdim_cont
        dhpb(i)=0.0D0
       enddo
       do i=1,maxres
index a69ee13..480aeb2 100644 (file)
@@ -5,6 +5,7 @@
       include 'mpif.h'
       include "COMMON.SETUP"
 #endif
+      include "COMMON.CONTROL"
       include "COMMON.CHAIN"
       include "COMMON.INTERACT"
       include "COMMON.SPLITELE"
       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
      &  xj_temp,yj_temp,zj_temp
       double precision dist_init, dist_temp,r_buff_list
-      integer contlisti(2000*maxres),contlistj(2000*maxres)
+      integer contlisti(maxint_res*maxres),contlistj(maxint_res*maxres)
 !      integer :: newcontlisti(200*nres),newcontlistj(200*nres) 
       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
      &  ilist_sc,g_ilist_sc
       integer displ(0:max_fg_procs),i_ilist_sc(0:max_fg_procs),ierr
+      logical lprn /.false./
 !            print *,"START make_SC"
 #ifdef DEBUG
-      write (iout,*) "make_SCSC_inter_list"
+      write (iout,*) "make_SCSC_inter_list maxint_res",maxint_res
 #endif
           r_buff_list=5.0d0
             ilist_sc=0
@@ -80,7 +82,7 @@
                zj=zj_safe-zi
                endif
 ! r_buff_list is a read value for a buffer 
-               if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then
+               if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
 ! Here the list is created
                  ilist_sc=ilist_sc+1
 ! this can be substituted by cantor and anti-cantor
 
         call MPI_Reduce(ilist_sc,g_ilist_sc,1,
      &                  MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+c        write (iout,*) "SCSC after reduce ierr",ierr
+        if (fg_rank.eq.0.and.g_ilist_sc.gt.maxres*maxint_res) then
+          if ((me.eq.king.or.out1file).and.energy_dec) then
+            write (iout,*) "Too many SCSC interactions",
+     &      g_ilist_sc," only",maxres*maxint_res," allowed."
+            write (iout,*) "Reduce r_cut_int and resubmit"
+            write (iout,*) "Specify a smaller r_cut_int and resubmit"
+            call flush(iout)
+          endif
+          write (*,*) "Processor:",me,": Too many SCSC interactions",
+     &      g_ilist_sc," only",maxres*maxint_res," allowed."
+            write (iout,*) "Reduce r_cut_int and resubmit"
+            write (iout,*) "Specify a smaller r_cut_int and resubmit"
+          call MPI_Abort(MPI_COMM_WORLD,ierr)
+        endif
 c        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)
+c        write (iout,*) "SCSC after gather ierr",ierr
         displ(0)=0
         do i=1,nfgtasks-1,1
           displ(i)=i_ilist_sc(i-1)+displ(i-1)
@@ -117,16 +135,20 @@ c        write(iout,*) "before bcast",g_ilist_sc
         call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER,
      &                   newcontlisti,i_ilist_sc,displ,MPI_INTEGER,
      &                   king,FG_COMM,IERR)
+c        write (iout,*) "SCSC after gatherv ierr",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)
+c        write (iout,*) "SCSC bcast reduce ierr",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)
+c        write (iout,*) "SCSC bcast reduce ierr",ierr
         call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,
      &                 IERR)
+c        write (iout,*) "SCSC after bcast ierr",ierr
 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 
         else
@@ -140,8 +162,11 @@ c        write(iout,*) "before bcast",g_ilist_sc
 #ifdef MPI
         endif
 #endif      
+      if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) 
+     & write (iout,'(a30,i10,a,i4)') "Number of SC-SC interactions",
+     & g_ilist_sc," per residue on average",g_ilist_sc/nres
 #ifdef DEBUG
-      write (iout,*) "after GATHERV",g_ilist_sc
+      write (iout,*) "make_SCSC_inter_list: after GATHERV",g_ilist_sc
       do i=1,g_ilist_sc
       write (iout,*) i,newcontlisti(i),newcontlistj(i)
       enddo
@@ -157,6 +182,7 @@ c        write(iout,*) "before bcast",g_ilist_sc
       include 'mpif.h'
       include "COMMON.SETUP"
 #endif
+      include "COMMON.CONTROL"
       include "COMMON.CHAIN"
       include "COMMON.INTERACT"
       include "COMMON.SPLITELE"
@@ -164,16 +190,18 @@ c        write(iout,*) "before bcast",g_ilist_sc
       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
      &  xj_temp,yj_temp,zj_temp
       double precision dist_init, dist_temp,r_buff_list
-      integer contlistscpi(2000*maxres),contlistscpj(2000*maxres)
+      integer contlistscpi(2*maxint_res*maxres),
+     & contlistscpj(2*maxint_res*maxres)
 !      integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres)
       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
      &  ilist_scp,g_ilist_scp
       integer displ(0:max_fg_procs),i_ilist_scp(0:max_fg_procs),ierr
-      integer contlistscpi_f(2000*maxres),contlistscpj_f(2000*maxres)
+c      integer contlistscpi_f(2*maxint_res*maxres),
+c     &  contlistscpj_f(2*maxint_res*maxres)
       integer ilist_scp_first,ifirstrun,g_ilist_sc
 !            print *,"START make_SC"
 #ifdef DEBUG
-      write (iout,*) "make_SCp_inter_list"
+      write (iout,*) "make_SCp_inter_list maxint_res",maxint_res
 #endif
       r_buff_list=5.0
             ilist_scp=0
@@ -245,7 +273,7 @@ c        write(iout,*) "before bcast",g_ilist_sc
        endif
 #ifdef DEBUG
                 ! r_buff_list is a read value for a buffer 
-              if ((sqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0))
+              if((dsqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0))
      &        then
 ! Here the list is created
                  ilist_scp_first=ilist_scp_first+1
@@ -255,7 +283,7 @@ c        write(iout,*) "before bcast",g_ilist_sc
               endif
 #endif
 ! r_buff_list is a read value for a buffer 
-               if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then
+               if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
 ! Here the list is created
                  ilist_scp=ilist_scp+1
 ! this can be substituted by cantor and anti-cantor
@@ -276,9 +304,23 @@ c        write(iout,*) "before bcast",g_ilist_sc
 
         call MPI_Reduce(ilist_scp,g_ilist_scp,1,
      &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+c        write (iout,*) "SCp after reduce ierr",ierr
+        if (fg_rank.eq.0.and.g_ilist_scp.gt.2*maxres*maxint_res) then
+          if ((me.eq.king.or.out1file).and.energy_dec) then
+            write (iout,*) "Too many SCp interactions",
+     &      g_ilist_scp," only",2*maxres*maxint_res," allowed."
+            write (iout,*) "Specify a smaller r_cut_int and resubmit"
+            call flush(iout)
+          endif
+          write (*,*) "Processor:",me,": Too many SCp interactions",
+     &      g_ilist_scp," only",2*maxres*maxint_res," allowed."
+          write (*,*) "Specify a smaller r_cut_int and resubmit"
+          call MPI_Abort(MPI_COMM_WORLD,ierr)
+        endif
 c        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)
+c        write (iout,*) "SCp after gather ierr",ierr
         displ(0)=0
         do i=1,nfgtasks-1,1
           displ(i)=i_ilist_scp(i-1)+displ(i-1)
@@ -287,16 +329,21 @@ c        write(iout,*) "before bcast",g_ilist_sc
         call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER,
      &                   newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER,
      &                   king,FG_COMM,IERR)
+c        write (iout,*) "SCp after gatherv ierr",ierr
         call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER,
      &                   newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER,
      &                   king,FG_COMM,IERR)
+c        write (iout,*) "SCp after gatherv ierr",ierr
         call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR)
+c        write (iout,*) "SCp after bcast ierr",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)
+c        write (iout,*) "SCp after bcast ierr",ierr
         call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM,
      &                   IERR)
+c        write (iout,*) "SCp bcast reduce ierr",ierr
 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
         else
 #endif
@@ -309,8 +356,11 @@ c        write(iout,*) "before bcast",g_ilist_sc
 #ifdef MPI
         endif
 #endif
+      if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) 
+     & write (iout,'(a30,i10,a,i4)') "Number of SC-p interactions",
+     & g_ilist_scp," per residue on average",g_ilist_scp/nres
 #ifdef DEBUG
-      write (iout,*) "after MPIREDUCE",g_ilist_scp
+      write (iout,*) "make_SCp_inter_list: after GATHERV",g_ilist_scp
       do i=1,g_ilist_scp
       write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i)
       enddo
@@ -338,6 +388,7 @@ c        write(iout,*) "before bcast",g_ilist_sc
       include 'mpif.h'
       include "COMMON.SETUP"
 #endif
+      include "COMMON.CONTROL"
       include "COMMON.CHAIN"
       include "COMMON.INTERACT"
       include "COMMON.SPLITELE"
@@ -349,7 +400,8 @@ c        write(iout,*) "before bcast",g_ilist_sc
      &  xmedi,ymedi,zmedi
       double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,
      &  dx_normj,dy_normj,dz_normj
-      integer contlistpp_vdwi(2000*maxres),contlistpp_vdwj(2000*maxres)
+      integer contlistpp_vdwi(maxint_res*maxres),
+     & contlistpp_vdwj(maxint_res*maxres)
 !      integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
      &  ilist_pp_vdw,g_ilist_pp_vdw
@@ -422,7 +474,7 @@ c        write(iout,*) "before bcast",g_ilist_sc
           enddo
           enddo
 
-          if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then
+          if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
 ! Here the list is created
             ilist_pp_vdw=ilist_pp_vdw+1
 ! this can be substituted by cantor and anti-cantor
@@ -443,6 +495,18 @@ c        write(iout,*) "before bcast",g_ilist_sc
 
         call MPI_Reduce(ilist_pp_vdw,g_ilist_pp_vdw,1,
      &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+        if (fg_rank.eq.0.and.g_ilist_pp_vdw.gt.maxres*maxint_res) then
+          if ((me.eq.king.or.out1file).and.energy_dec) then
+            write (iout,*) "Too many pp VDW interactions",
+     &      g_ilist_pp_vdw," only",maxres*maxint_res," allowed."
+            write (iout,*) "Specify a smaller r_cut_int and resubmit"
+            call flush(iout)
+          endif
+          write (*,*) "Processor:",me,": Too many pp VDW interactions",
+     &      g_ilist_pp_vdw," only",maxres*maxint_res," allowed."
+          write (8,*) "Specify a smaller r_cut_int and resubmit"
+          call MPI_Abort(MPI_COMM_WORLD,ierr)
+        endif
 !        write(iout,*) "before bcast",g_ilist_sc
         call MPI_Gather(ilist_pp_vdw,1,MPI_INTEGER,
      &                  i_ilist_pp_vdw,1,MPI_INTEGER,king,FG_COMM,IERR)
@@ -480,10 +544,14 @@ c        write(iout,*) "before bcast",g_ilist_sc
 #endif
         call int_bounds(g_ilist_pp_vdw,g_listpp_vdw_start,
      &       g_listpp_vdw_end)
+      if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) 
+     &write (iout,'(a30,i10,a,i4)') "Number of p-p VDW interactions",
+     & g_ilist_pp_vdw," per residue on average",g_ilist_pp_vdw/nres
 #ifdef DEBUG
       write (iout,*) "g_listpp_vdw_start",g_listpp_vdw_start,
      &  "g_listpp_vdw_end",g_listpp_vdw_end
-      write (iout,*) "after MPIREDUCE",g_ilist_pp_vdw
+      write (iout,*) "make_pp_vdw_inter_list: after GATHERV",
+     &  g_ilist_pp_vdw
       do i=1,g_ilist_pp_vdw
         write (iout,*) i,newcontlistpp_vdwi(i),newcontlistpp_vdwj(i)
       enddo
@@ -498,6 +566,7 @@ c        write(iout,*) "before bcast",g_ilist_sc
       include 'mpif.h'
       include "COMMON.SETUP"
 #endif
+      include "COMMON.CONTROL"
       include "COMMON.CHAIN"
       include "COMMON.INTERACT"
       include "COMMON.SPLITELE"
@@ -509,7 +578,8 @@ c        write(iout,*) "before bcast",g_ilist_sc
      &  xmedi,ymedi,zmedi
       double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,
      &  dx_normj,dy_normj,dz_normj
-      integer contlistppi(2000*maxres),contlistppj(2000*maxres)
+      integer contlistppi(maxint_res*maxres),
+     &  contlistppj(maxint_res*maxres)
 !      integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
      &  ilist_pp,g_ilist_pp
@@ -582,7 +652,7 @@ c        write(iout,*) "before bcast",g_ilist_sc
        enddo
        enddo
 
-      if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then
+      if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
 ! Here the list is created
                  ilist_pp=ilist_pp+1
 ! this can be substituted by cantor and anti-cantor
@@ -603,9 +673,23 @@ c        write(iout,*) "before bcast",g_ilist_sc
 
         call MPI_Reduce(ilist_pp,g_ilist_pp,1,
      &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+c       write (iout,*) "After reduce ierr",ierr
+        if (fg_rank.eq.0.and.g_ilist_pp.gt.maxres*maxint_res) then
+          if ((me.eq.king.or.out1file).and.energy_dec) then
+            write (iout,*) "Too many pp interactions",
+     &      g_ilist_pp," only",maxres*maxint_res," allowed."
+            write (iout,*) "Specify a smaller r_cut_int and resubmit"
+            call flush(iout)
+          endif
+          write (*,*) "Processor:",me,": Too many pp interactions",
+     &      g_ilist_pp," only",maxres*maxint_res," allowed."
+          write (*,*) "Specify a smaller r_cut_int and resubmit"
+          call MPI_Abort(MPI_COMM_WORLD,ierr)
+        endif
 !        write(iout,*) "before bcast",g_ilist_sc
         call MPI_Gather(ilist_pp,1,MPI_INTEGER,
      &                  i_ilist_pp,1,MPI_INTEGER,king,FG_COMM,IERR)
+c       write (iout,*) "After gather ierr",ierr
         displ(0)=0
         do i=1,nfgtasks-1,1
           displ(i)=i_ilist_pp(i-1)+displ(i-1)
@@ -614,16 +698,21 @@ c        write(iout,*) "before bcast",g_ilist_sc
         call MPI_Gatherv(contlistppi,ilist_pp,MPI_INTEGER,
      &                   newcontlistppi,i_ilist_pp,displ,MPI_INTEGER,
      &                   king,FG_COMM,IERR)
+c       write (iout,*) "After gatherb ierr",ierr
         call MPI_Gatherv(contlistppj,ilist_pp,MPI_INTEGER,
      &                   newcontlistppj,i_ilist_pp,displ,MPI_INTEGER,
      &                   king,FG_COMM,IERR)
+c       write (iout,*) "After gatherb ierr",ierr
         call MPI_Bcast(g_ilist_pp,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)
+c       write (iout,*) "After bcast ierr",ierr
         call MPI_Bcast(newcontlistppi,g_ilist_pp,MPI_INT,king,FG_COMM,
      &                   IERR)
+c       write (iout,*) "After bcast ierr",ierr
         call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM,
      &                   IERR)
+c       write (iout,*) "After bcast ierr",ierr
 
 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 
@@ -639,8 +728,11 @@ c        write(iout,*) "before bcast",g_ilist_sc
         endif
 #endif
         call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end)
+      if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) 
+     & write (iout,'(a30,i10,a,i4)') "Number of p-p interactions",
+     & g_ilist_pp," per residue on average",g_ilist_pp/nres
 #ifdef DEBUG
-      write (iout,*) "after MPIREDUCE",g_ilist_pp
+      write (iout,*) "make_pp_inter_list: after GATHERV",g_ilist_pp
       do i=1,g_ilist_pp
       write (iout,*) i,newcontlistppi(i),newcontlistppj(i)
       enddo
index 7162afb..5551640 100644 (file)
@@ -37,11 +37,11 @@ c  controls minimization and sorting routines
       include 'COMMON.GEO'
       include 'COMMON.FFIELD'
       include 'COMMON.SBRIDGE'
-      include 'COMMON.DISTFIT'
+c      include 'COMMON.DISTFIT'
       include 'COMMON.CHAIN'
       dimension var(maxvar),erg(mxch*(mxch+1)/2+1)
       dimension var2(maxvar)
-      integer iffr(maxres),ihpbt(maxdim),jhpbt(maxdim)
+      integer iffr(maxres),ihpbt(maxdim_cont),jhpbt(maxdim_cont)
       double precision d(maxvar),garbage(maxvar),g(maxvar)
       double precision energia(0:n_ene),time0s,time1s
       dimension indx(9),info(12)
index cea54c4..41a1a27 100644 (file)
@@ -198,8 +198,8 @@ c----------------------------------------------------------------------------
       include 'COMMON.TIME1'
       double precision z(maxres6),d_a_tmp(maxres6)
       double precision edum(0:n_ene),time_order(0:10)
-      double precision Gcopy(maxres2,maxres2)
-      common /przechowalnia/ Gcopy
+c      double precision Gcopy(maxres2,maxres2)
+c      common /przechowalnia/ Gcopy
       integer icall /0/
       integer i,j,iorder
 C Workers wait for variables and NF, and NFL from the boss 
index 2da8851..4da2913 100644 (file)
@@ -2096,11 +2096,12 @@ C 12/1/95 Added weight for the multi-body term WCORR
       do i=1,maxres
         dyn_ss_mask(i)=.false.
       enddo
-      do i=1,maxres-1
-        do j=i+1,maxres
+      do i=1,max_cyst-1
+        do j=i+1,max_cyst
           dyn_ssbond_ij(i,j)=1.0d300
         enddo
       enddo
+      call flush(iout)
       call reada(weightcard,"HT",Ht,0.0D0)
       if (dyn_ss) then
         ss_depth=ebr/wsc-0.25*eps(1,1)
@@ -2131,7 +2132,7 @@ C 12/1/95 Added weight for the multi-body term WCORR
        write (iout,*) "BTRISS=", btriss
        write (iout,*) "CTRISS=", ctriss
        write (iout,*) "DTRISS=", dtriss
-       print *,'indpdb=',indpdb,' pdbref=',pdbref
+c       print *,'indpdb=',indpdb,' pdbref=',pdbref
       endif
       return
       end
diff --git a/source/unres/src-HCD-5D/read_constr_homology.F b/source/unres/src-HCD-5D/read_constr_homology.F
new file mode 100644 (file)
index 0000000..3fd4ae5
--- /dev/null
@@ -0,0 +1,717 @@
+      subroutine read_constr_homology
+      implicit none
+      include 'DIMENSIONS'
+#ifdef MPI
+      include 'mpif.h'
+#endif
+      include 'COMMON.SETUP'
+      include 'COMMON.CONTROL'
+      include 'COMMON.HOMOLOGY'
+      include 'COMMON.CHAIN'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.MD'
+      include 'COMMON.QRESTR'
+      include 'COMMON.GEO'
+      include 'COMMON.INTERACT'
+      include 'COMMON.NAMES'
+c
+c For new homol impl
+c
+      include 'COMMON.VAR'
+c
+
+c     double precision odl_temp,sigma_odl_temp,waga_theta,waga_d,
+c    &                 dist_cut
+c     common /przechowalnia/ odl_temp(maxres,maxres,max_template),
+c    &    sigma_odl_temp(maxres,maxres,max_template)
+      character*2 kic2
+      character*24 model_ki_dist, model_ki_angle
+      character*500 controlcard
+      integer ki,i,ii,j,k,l,ii_in_use(maxdim),i_tmp,idomain_tmp,irec,
+     & ik,iistart,nres_temp
+      integer ilen
+      external ilen
+      logical liiflag,lfirst
+      integer i01,i10
+c
+c     FP - Nov. 2014 Temporary specifications for new vars
+c
+      double precision rescore_tmp,x12,y12,z12,rescore2_tmp,
+     &                 rescore3_tmp
+      double precision, dimension (max_template,maxres) :: rescore
+      double precision, dimension (max_template,maxres) :: rescore2
+      double precision, dimension (max_template,maxres) :: rescore3
+      double precision distal
+      character*24 pdbfile,tpl_k_rescore
+c -----------------------------------------------------------------
+c Reading multiple PDB ref structures and calculation of retraints
+c not using pre-computed ones stored in files model_ki_{dist,angle}
+c FP (Nov., 2014)
+c -----------------------------------------------------------------
+c
+c
+c Alternative: reading from input
+      call card_concat(controlcard)
+      call reada(controlcard,"HOMOL_DIST",waga_dist,1.0d0)
+      call reada(controlcard,"HOMOL_ANGLE",waga_angle,1.0d0)
+      call reada(controlcard,"HOMOL_THETA",waga_theta,1.0d0) ! new
+      call reada(controlcard,"HOMOL_SCD",waga_d,1.0d0) ! new
+      call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) ! for diff ways of calc sigma
+      call reada(controlcard,'DIST2_CUT',dist2_cut,9999.0d0)
+      call readi(controlcard,"HOMOL_NSET",homol_nset,1)       
+      read2sigma=(index(controlcard,'READ2SIGMA').gt.0)
+      start_from_model=(index(controlcard,'START_FROM_MODELS').gt.0)
+      if(.not.read2sigma.and.start_from_model) then
+          if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) 
+     &      write(iout,*) 'START_FROM_MODELS works only with READ2SIGMA'
+          start_from_model=.false.
+      endif
+      if(start_from_model .and. (me.eq.king .or. .not. out1file))
+     &    write(iout,*) 'START_FROM_MODELS is ON'
+      if(start_from_model .and. rest) then 
+        if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
+         write(iout,*) 'START_FROM_MODELS is OFF'
+         write(iout,*) 'remove restart keyword from input'
+        endif
+      endif
+      if (homol_nset.gt.1)then
+         call card_concat(controlcard)
+         read(controlcard,*) (waga_homology(i),i=1,homol_nset) 
+         if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
+          write(iout,*) "iset homology_weight "
+          do i=1,homol_nset
+           write(iout,*) i,waga_homology(i)
+          enddo
+         endif
+         iset=mod(kolor,homol_nset)+1
+      else
+       iset=1
+       waga_homology(1)=1.0
+      endif
+
+cd      write (iout,*) "nnt",nnt," nct",nct
+cd      call flush(iout)
+
+
+      lim_odl=0
+      lim_dih=0
+c
+c      write(iout,*) 'nnt=',nnt,'nct=',nct
+c
+      do i = nnt,nct
+        do k=1,constr_homology
+         idomain(k,i)=0
+        enddo
+      enddo
+
+      ii=0
+      do i = nnt,nct-2 
+        do j=i+2,nct 
+        ii=ii+1
+        ii_in_use(ii)=0
+        enddo
+      enddo
+
+      if (read_homol_frag) then
+        call read_klapaucjusz
+      else
+
+      do k=1,constr_homology
+
+        read(inp,'(a)') pdbfile
+        if(me.eq.king .or. .not. out1file)
+     &    write (iout,'(a,5x,a)') 'HOMOL: Opening PDB file',
+     &  pdbfile(:ilen(pdbfile))
+        open(ipdbin,file=pdbfile,status='old',err=33)
+        goto 34
+  33    write (iout,'(a,5x,a)') 'Error opening PDB file',
+     &  pdbfile(:ilen(pdbfile))
+        stop
+  34    continue
+c        print *,'Begin reading pdb data'
+c
+c Files containing res sim or local scores (former containing sigmas)
+c
+
+        write(kic2,'(bz,i2.2)') k
+
+        tpl_k_rescore="template"//kic2//".sco"
+
+        unres_pdb=.false.
+        nres_temp=nres
+        if (read2sigma) then
+          call readpdb_template(k)
+        else
+          call readpdb
+        endif
+        nres_chomo(k)=nres
+        nres=nres_temp
+c
+c     Distance restraints
+c
+c          ... --> odl(k,ii)
+C Copy the coordinates from reference coordinates (?)
+        do i=1,2*nres_chomo(k)
+          do j=1,3
+            c(j,i)=cref(j,i)
+c           write (iout,*) "c(",j,i,") =",c(j,i)
+          enddo
+        enddo
+c
+c From read_dist_constr (commented out 25/11/2014 <-> res sim)
+c
+c         write(iout,*) "tpl_k_rescore - ",tpl_k_rescore
+          open (ientin,file=tpl_k_rescore,status='old')
+          if (nnt.gt.1) rescore(k,1)=0.0d0
+          do irec=nnt,nct ! loop for reading res sim 
+            if (read2sigma) then
+             read (ientin,*,end=1401) i_tmp,rescore2_tmp,rescore_tmp,
+     &                                rescore3_tmp,idomain_tmp
+             i_tmp=i_tmp+nnt-1
+             idomain(k,i_tmp)=idomain_tmp
+             rescore(k,i_tmp)=rescore_tmp
+             rescore2(k,i_tmp)=rescore2_tmp
+             rescore3(k,i_tmp)=rescore3_tmp
+             if (.not. out1file .or. me.eq.king)
+     &        write(iout,'(a7,i5,3f10.5,i5)') "rescore",
+     &                      i_tmp,rescore2_tmp,rescore_tmp,
+     &                                rescore3_tmp,idomain_tmp
+            else
+             idomain(k,irec)=1
+             read (ientin,*,end=1401) rescore_tmp
+
+c           rescore(k,irec)=rescore_tmp+1.0d0 ! to avoid 0 values
+             rescore(k,irec)=0.5d0*(rescore_tmp+0.5d0) ! alt transf to reduce scores
+c           write(iout,*) "rescore(",k,irec,") =",rescore(k,irec)
+            endif
+          enddo  
+ 1401   continue
+        close (ientin)        
+        if (waga_dist.ne.0.0d0) then
+          ii=0
+          do i = nnt,nct-2 
+            do j=i+2,nct 
+
+              x12=c(1,i)-c(1,j)
+              y12=c(2,i)-c(2,j)
+              z12=c(3,i)-c(3,j)
+              distal=dsqrt(x12*x12+y12*y12+z12*z12) 
+c              write (iout,*) k,i,j,distal,dist2_cut
+
+            if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0
+     &            .and. distal.le.dist2_cut ) then
+
+              ii=ii+1
+              ii_in_use(ii)=1
+              l_homo(k,ii)=.true.
+
+c             write (iout,*) "k",k
+c             write (iout,*) "i",i," j",j," constr_homology",
+c    &                       constr_homology
+              ires_homo(ii)=i
+              jres_homo(ii)=j
+              odl(k,ii)=distal
+              if (read2sigma) then
+                sigma_odl(k,ii)=0
+                do ik=i,j
+                 sigma_odl(k,ii)=sigma_odl(k,ii)+rescore2(k,ik)
+                enddo
+                sigma_odl(k,ii)=sigma_odl(k,ii)/(j-i+1)
+                if (odl(k,ii).gt.dist_cut) sigma_odl(k,ii) = 
+     &        sigma_odl(k,ii)*dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0)
+              else
+                if (odl(k,ii).le.dist_cut) then
+                 sigma_odl(k,ii)=rescore(k,i)+rescore(k,j) 
+                else
+#ifdef OLDSIGMA
+                 sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* 
+     &                      dexp(0.5d0*(odl(k,ii)/dist_cut)**2)
+#else
+                 sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* 
+     &                      dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0)
+#endif
+                endif
+              endif
+              sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii)) 
+            else
+              ii=ii+1
+              l_homo(k,ii)=.false.
+            endif
+            enddo
+          enddo
+        lim_odl=ii
+        endif
+c        write (iout,*) "Distance restraints set"
+c        call flush(iout)
+c
+c     Theta, dihedral and SC retraints
+c
+        if (waga_angle.gt.0.0d0) then
+c         open (ientin,file=tpl_k_sigma_dih,status='old')
+c         do irec=1,maxres-3 ! loop for reading sigma_dih
+c            read (ientin,*,end=1402) i,j,ki,l,sigma_dih(k,i+nnt-1) ! j,ki,l what for?
+c            if (i+nnt-1.gt.lim_dih) lim_dih=i+nnt-1 ! right?
+c            sigma_dih(k,i+nnt-1)=sigma_dih(k,i+nnt-1)* ! not inverse because of use of res. similarity
+c    &                            sigma_dih(k,i+nnt-1)
+c         enddo
+c1402   continue
+c         close (ientin)
+          do i = nnt+3,nct 
+            if (idomain(k,i).eq.0) then 
+               sigma_dih(k,i)=0.0
+               cycle
+            endif
+            dih(k,i)=phiref(i) ! right?
+c           read (ientin,*) sigma_dih(k,i) ! original variant
+c             write (iout,*) "dih(",k,i,") =",dih(k,i)
+c             write(iout,*) "rescore(",k,i,") =",rescore(k,i),
+c    &                      "rescore(",k,i-1,") =",rescore(k,i-1),
+c    &                      "rescore(",k,i-2,") =",rescore(k,i-2),
+c    &                      "rescore(",k,i-3,") =",rescore(k,i-3)
+
+            sigma_dih(k,i)=(rescore(k,i)+rescore(k,i-1)+
+     &                     rescore(k,i-2)+rescore(k,i-3))/4.0
+c            if (read2sigma) sigma_dih(k,i)=sigma_dih(k,i)/4.0
+c           write (iout,*) "Raw sigmas for dihedral angle restraints"
+c           write (iout,'(i5,10(2f8.2,4x))') i,sigma_dih(k,i)
+c           sigma_dih(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)*
+c                          rescore(k,i-2)*rescore(k,i-3)  !  right expression ?
+c   Instead of res sim other local measure of b/b str reliability possible
+            if (sigma_dih(k,i).ne.0)
+     &       sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i))
+c           sigma_dih(k,i)=sigma_dih(k,i)*sigma_dih(k,i)
+          enddo
+          lim_dih=nct-nnt-2 
+        endif
+c        write (iout,*) "Dihedral angle restraints set"
+c        call flush(iout)
+
+        if (waga_theta.gt.0.0d0) then
+c         open (ientin,file=tpl_k_sigma_theta,status='old')
+c         do irec=1,maxres-2 ! loop for reading sigma_theta, right bounds?
+c            read (ientin,*,end=1403) i,j,ki,sigma_theta(k,i+nnt-1) ! j,ki what for?
+c            sigma_theta(k,i+nnt-1)=sigma_theta(k,i+nnt-1)* ! not inverse because of use of res. similarity
+c    &                              sigma_theta(k,i+nnt-1)
+c         enddo
+c1403   continue
+c         close (ientin)
+
+          do i = nnt+2,nct ! right? without parallel.
+c         do i = i=1,nres ! alternative for bounds acc to readpdb?
+c         do i=ithet_start,ithet_end ! with FG parallel.
+             if (idomain(k,i).eq.0) then  
+              sigma_theta(k,i)=0.0
+              cycle
+             endif
+             thetatpl(k,i)=thetaref(i)
+c            write (iout,*) "thetatpl(",k,i,") =",thetatpl(k,i)
+c            write(iout,*)  "rescore(",k,i,") =",rescore(k,i),
+c    &                      "rescore(",k,i-1,") =",rescore(k,i-1),
+c    &                      "rescore(",k,i-2,") =",rescore(k,i-2)
+c            read (ientin,*) sigma_theta(k,i) ! 1st variant
+             sigma_theta(k,i)=(rescore(k,i)+rescore(k,i-1)+
+     &                        rescore(k,i-2))/3.0
+c             if (read2sigma) sigma_theta(k,i)=sigma_theta(k,i)/3.0
+             if (sigma_theta(k,i).ne.0)
+     &       sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i))
+
+c            sigma_theta(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)*
+c                             rescore(k,i-2) !  right expression ?
+c            sigma_theta(k,i)=sigma_theta(k,i)*sigma_theta(k,i)
+          enddo
+        endif
+c        write (iout,*) "Angle restraints set"
+c        call flush(iout)
+
+        if (waga_d.gt.0.0d0) then
+c       open (ientin,file=tpl_k_sigma_d,status='old')
+c         do irec=1,maxres-1 ! loop for reading sigma_theta, right bounds?
+c            read (ientin,*,end=1404) i,j,sigma_d(k,i+nnt-1) ! j,ki what for?
+c            sigma_d(k,i+nnt-1)=sigma_d(k,i+nnt-1)* ! not inverse because of use of res. similarity
+c    &                          sigma_d(k,i+nnt-1)
+c         enddo
+c1404   continue
+
+          do i = nnt,nct ! right? without parallel.
+c         do i=2,nres-1 ! alternative for bounds acc to readpdb?
+c         do i=loc_start,loc_end ! with FG parallel.
+               if (itype(i).eq.10) cycle 
+               if (idomain(k,i).eq.0 ) then 
+                  sigma_d(k,i)=0.0
+                  cycle
+               endif
+               xxtpl(k,i)=xxref(i)
+               yytpl(k,i)=yyref(i)
+               zztpl(k,i)=zzref(i)
+c              write (iout,*) "xxtpl(",k,i,") =",xxtpl(k,i)
+c              write (iout,*) "yytpl(",k,i,") =",yytpl(k,i)
+c              write (iout,*) "zztpl(",k,i,") =",zztpl(k,i)
+c              write(iout,*)  "rescore(",k,i,") =",rescore(k,i)
+               sigma_d(k,i)=rescore3(k,i) !  right expression ?
+               if (sigma_d(k,i).ne.0)
+     &          sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i))
+
+c              sigma_d(k,i)=hmscore(k)*rescore(k,i) !  right expression ?
+c              sigma_d(k,i)=sigma_d(k,i)*sigma_d(k,i)
+c              read (ientin,*) sigma_d(k,i) ! 1st variant
+          enddo
+        endif
+      enddo
+c      write (iout,*) "SC restraints set"
+c      call flush(iout)
+c
+c remove distance restraints not used in any model from the list
+c shift data in all arrays
+c
+c      write (iout,*) "waga_dist",waga_dist," nnt",nnt," nct",nct
+      if (waga_dist.ne.0.0d0) then
+        ii=0
+        liiflag=.true.
+        lfirst=.true.
+        do i=nnt,nct-2 
+         do j=i+2,nct 
+          ii=ii+1
+c          if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0
+c     &            .and. distal.le.dist2_cut ) then
+c          write (iout,*) "i",i," j",j," ii",ii
+c          call flush(iout)
+          if (ii_in_use(ii).eq.0.and.liiflag.or.
+     &     ii_in_use(ii).eq.1.and.liiflag.and.ii.eq.lim_odl) then
+            liiflag=.false.
+            i10=ii
+            if (lfirst) then
+              lfirst=.false.
+              iistart=ii
+            else
+              if(i10.eq.lim_odl) i10=i10+1
+              do ki=0,i10-i01-1
+               ires_homo(iistart+ki)=ires_homo(ki+i01)
+               jres_homo(iistart+ki)=jres_homo(ki+i01)
+               ii_in_use(iistart+ki)=ii_in_use(ki+i01)
+               do k=1,constr_homology
+                odl(k,iistart+ki)=odl(k,ki+i01)
+                sigma_odl(k,iistart+ki)=sigma_odl(k,ki+i01)
+                l_homo(k,iistart+ki)=l_homo(k,ki+i01)
+               enddo
+              enddo
+              iistart=iistart+i10-i01
+            endif
+          endif
+          if (ii_in_use(ii).ne.0.and..not.liiflag) then
+             i01=ii
+             liiflag=.true.
+          endif
+         enddo
+        enddo
+        lim_odl=iistart-1
+      endif
+c      write (iout,*) "Removing distances completed"
+c      call flush(iout)
+      endif ! .not. klapaucjusz
+
+      if (constr_homology.gt.0) call homology_partition
+c      write (iout,*) "After homology_partition"
+c      call flush(iout)
+      if (constr_homology.gt.0) call init_int_table
+c      write (iout,*) "After init_int_table"
+c      call flush(iout)
+c      write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
+c      write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
+c
+c Print restraints
+c
+      if (.not.out_template_restr) return
+cd      write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
+      if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
+       write (iout,*) "Distance restraints from templates"
+       do ii=1,lim_odl
+       write(iout,'(3i5,100(2f8.2,1x,l1,4x))') 
+     &  ii,ires_homo(ii),jres_homo(ii),
+     &  (odl(ki,ii),1.0d0/dsqrt(sigma_odl(ki,ii)),l_homo(ki,ii),
+     &  ki=1,constr_homology)
+       enddo
+       write (iout,*) "Dihedral angle restraints from templates"
+       do i=nnt+3,nct
+        write (iout,'(i5,a4,100(2f8.2,4x))') i,restyp(itype(i)),
+     &      (rad2deg*dih(ki,i),
+     &      rad2deg/dsqrt(sigma_dih(ki,i)),ki=1,constr_homology)
+       enddo
+       write (iout,*) "Virtual-bond angle restraints from templates"
+       do i=nnt+2,nct
+        write (iout,'(i5,a4,100(2f8.2,4x))') i,restyp(itype(i)),
+     &      (rad2deg*thetatpl(ki,i),
+     &      rad2deg/dsqrt(sigma_theta(ki,i)),ki=1,constr_homology)
+       enddo
+       write (iout,*) "SC restraints from templates"
+       do i=nnt,nct
+        write(iout,'(i5,100(4f8.2,4x))') i,
+     &  (xxtpl(ki,i),yytpl(ki,i),zztpl(ki,i),
+     &   1.0d0/dsqrt(sigma_d(ki,i)),ki=1,constr_homology)
+       enddo
+      endif
+c -----------------------------------------------------------------
+      return
+      end
+c----------------------------------------------------------------------
+      subroutine read_klapaucjusz
+      implicit none
+      include 'DIMENSIONS'
+#ifdef MPI
+      include 'mpif.h'
+#endif
+      include 'COMMON.SETUP'
+      include 'COMMON.CONTROL'
+      include 'COMMON.HOMOLOGY'
+      include 'COMMON.CHAIN'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.MD'
+      include 'COMMON.GEO'
+      include 'COMMON.INTERACT'
+      include 'COMMON.NAMES'
+      character*256 fragfile
+      integer ninclust(maxclust),inclust(max_template,maxclust),
+     &  nresclust(maxclust),iresclust(maxres,maxclust),nclust
+
+      character*2 kic2
+      character*24 model_ki_dist, model_ki_angle
+      character*500 controlcard
+      integer ki, i, j, k, l, ii_in_use(maxdim),i_tmp,idomain_tmp,
+     & ik,ll,ii,kk,iistart,iishift,lim_xx
+      double precision distal
+      logical lprn /.true./
+      integer nres_temp
+      integer ilen
+      external ilen
+      logical liiflag
+c
+c
+      double precision rescore_tmp,x12,y12,z12,rescore2_tmp
+      double precision, dimension (max_template,maxres) :: rescore
+      double precision, dimension (max_template,maxres) :: rescore2
+      character*24 pdbfile,tpl_k_rescore
+
+c
+c For new homol impl
+c
+      include 'COMMON.VAR'
+c
+      call getenv("FRAGFILE",fragfile) 
+      open(ientin,file=fragfile,status="old",err=10)
+      read(ientin,*) constr_homology,nclust
+      l_homo = .false.
+      sigma_theta=0.0
+      sigma_d=0.0
+      sigma_dih=0.0
+c Read pdb files 
+      do k=1,constr_homology 
+        read(ientin,'(a)') pdbfile
+        write (iout,'(a,5x,a)') 'KLAPAUCJUSZ: Opening PDB file',
+     &  pdbfile(:ilen(pdbfile))
+        open(ipdbin,file=pdbfile,status='old',err=33)
+        goto 34
+  33    write (iout,'(a,5x,a)') 'Error opening PDB file',
+     &  pdbfile(:ilen(pdbfile))
+        stop
+  34    continue
+        unres_pdb=.false.
+        nres_temp=nres
+        call readpdb_template(k)
+        nres_chomo(k)=nres
+        nres=nres_temp
+        do i=1,nres
+          rescore(k,i)=0.2d0
+          rescore2(k,i)=1.0d0
+        enddo
+      enddo
+c Read clusters
+      do i=1,nclust
+        read(ientin,*) ninclust(i),nresclust(i)
+        read(ientin,*) (inclust(k,i),k=1,ninclust(i))
+        read(ientin,*) (iresclust(k,i),k=1,nresclust(i))
+      enddo
+c
+c Loop over clusters
+c
+      do l=1,nclust
+        do ll = 1,ninclust(l)
+        
+        k = inclust(ll,l)
+        do i=1,nres
+          idomain(k,i)=0
+        enddo
+        do i=1,nresclust(l)
+          if (nnt.gt.1)  then
+            idomain(k,iresclust(i,l)+1) = 1
+          else
+            idomain(k,iresclust(i,l)) = 1
+          endif
+        enddo
+c
+c     Distance restraints
+c
+c          ... --> odl(k,ii)
+C Copy the coordinates from reference coordinates (?)
+        nres_temp=nres
+        nres=nres_chomo(k)
+        do i=1,2*nres
+          do j=1,3
+            c(j,i)=chomo(j,i,k)
+c           write (iout,*) "c(",j,i,") =",c(j,i)
+          enddo
+        enddo
+        call int_from_cart(.true.,.false.)
+        call sc_loc_geom(.false.)
+        do i=1,nres
+          thetaref(i)=theta(i)
+          phiref(i)=phi(i)
+        enddo
+        nres=nres_temp
+        if (waga_dist.ne.0.0d0) then
+          ii=0
+          do i = nnt,nct-2 
+            do j=i+2,nct 
+
+              x12=c(1,i)-c(1,j)
+              y12=c(2,i)-c(2,j)
+              z12=c(3,i)-c(3,j)
+              distal=dsqrt(x12*x12+y12*y12+z12*z12) 
+c              write (iout,*) k,i,j,distal,dist2_cut
+
+            if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0
+     &            .and. distal.le.dist2_cut ) then
+
+              ii=ii+1
+              ii_in_use(ii)=1
+              l_homo(k,ii)=.true.
+
+c             write (iout,*) "k",k
+c             write (iout,*) "i",i," j",j," constr_homology",
+c    &                       constr_homology
+              ires_homo(ii)=i
+              jres_homo(ii)=j
+              odl(k,ii)=distal
+              if (read2sigma) then
+                sigma_odl(k,ii)=0
+                do ik=i,j
+                 sigma_odl(k,ii)=sigma_odl(k,ii)+rescore2(k,ik)
+                enddo
+                sigma_odl(k,ii)=sigma_odl(k,ii)/(j-i+1)
+                if (odl(k,ii).gt.dist_cut) sigma_odl(k,ii) = 
+     &        sigma_odl(k,ii)*dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0)
+              else
+                if (odl(k,ii).le.dist_cut) then
+                 sigma_odl(k,ii)=rescore(k,i)+rescore(k,j) 
+                else
+#ifdef OLDSIGMA
+                 sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* 
+     &                      dexp(0.5d0*(odl(k,ii)/dist_cut)**2)
+#else
+                 sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* 
+     &                      dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0)
+#endif
+                endif
+              endif
+              sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii)) 
+            else
+              ii=ii+1
+c              l_homo(k,ii)=.false.
+            endif
+            enddo
+          enddo
+        lim_odl=ii
+        endif
+c
+c     Theta, dihedral and SC retraints
+c
+        if (waga_angle.gt.0.0d0) then
+          do i = nnt+3,nct 
+            if (idomain(k,i).eq.0) then 
+c               sigma_dih(k,i)=0.0
+               cycle
+            endif
+            dih(k,i)=phiref(i)
+            sigma_dih(k,i)=(rescore(k,i)+rescore(k,i-1)+
+     &                     rescore(k,i-2)+rescore(k,i-3))/4.0
+c            write (iout,*) "k",k," l",l," i",i," rescore",rescore(k,i),
+c     &       " sigma_dihed",sigma_dih(k,i)
+            if (sigma_dih(k,i).ne.0)
+     &       sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i))
+          enddo
+          lim_dih=nct-nnt-2 
+        endif
+
+        if (waga_theta.gt.0.0d0) then
+          do i = nnt+2,nct
+             if (idomain(k,i).eq.0) then  
+c              sigma_theta(k,i)=0.0
+              cycle
+             endif
+             thetatpl(k,i)=thetaref(i)
+             sigma_theta(k,i)=(rescore(k,i)+rescore(k,i-1)+
+     &                        rescore(k,i-2))/3.0
+             if (sigma_theta(k,i).ne.0)
+     &       sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i))
+          enddo
+        endif
+
+        if (waga_d.gt.0.0d0) then
+          do i = nnt,nct
+               if (itype(i).eq.10) cycle 
+               if (idomain(k,i).eq.0 ) then 
+c                  sigma_d(k,i)=0.0
+                  cycle
+               endif
+               xxtpl(k,i)=xxref(i)
+               yytpl(k,i)=yyref(i)
+               zztpl(k,i)=zzref(i)
+               sigma_d(k,i)=rescore(k,i)
+               if (sigma_d(k,i).ne.0)
+     &          sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i))
+               if (i-nnt+1.gt.lim_xx) lim_xx=i-nnt+1
+          enddo
+        endif
+      enddo ! l
+      enddo ! ll
+c
+c remove distance restraints not used in any model from the list
+c shift data in all arrays
+c
+      if (waga_dist.ne.0.0d0) then
+        ii=0
+        liiflag=.true.
+        do i=nnt,nct-2 
+         do j=i+2,nct 
+          ii=ii+1
+          if (ii_in_use(ii).eq.0.and.liiflag) then
+            liiflag=.false.
+            iistart=ii
+          endif
+          if (ii_in_use(ii).ne.0.and..not.liiflag.or.
+     &                   .not.liiflag.and.ii.eq.lim_odl) then
+             if (ii.eq.lim_odl) then
+              iishift=ii-iistart+1
+             else
+              iishift=ii-iistart
+             endif
+             liiflag=.true.
+             do ki=iistart,lim_odl-iishift
+              ires_homo(ki)=ires_homo(ki+iishift)
+              jres_homo(ki)=jres_homo(ki+iishift)
+              ii_in_use(ki)=ii_in_use(ki+iishift)
+              do k=1,constr_homology
+               odl(k,ki)=odl(k,ki+iishift)
+               sigma_odl(k,ki)=sigma_odl(k,ki+iishift)
+               l_homo(k,ki)=l_homo(k,ki+iishift)
+              enddo
+             enddo
+             ii=ii-iishift
+             lim_odl=lim_odl-iishift
+          endif
+         enddo
+        enddo
+      endif
+
+      return
+   10 stop "Error in fragment file"
+      end
+
index 40bf9ac..8346c4a 100644 (file)
@@ -20,8 +20,9 @@ C geometry.
       double precision e1(3),e2(3),e3(3)
       integer rescode,iterter(maxres),cou
       logical fail,sccalc
-      integer i,j,iii,ires,ires_old,ishift,ishift1,ibeg
-      double precision dcj,efree_temp
+      integer i,j,iii,ires,ires_old,ishift,ishift1,ibeg,ifree
+      double precision dcj!,efree_temp
+      logical zero
       bfac=0.0d0
       do i=1,maxres
          iterter(i)=0
@@ -36,6 +37,7 @@ C geometry.
       do
         read (ipdbin,'(a80)',end=10) card
 c        write (iout,'(a)') card
+c        call flush(iout)
         if (card(:5).eq.'HELIX') then
           nhfrag=nhfrag+1
           lsecondary=.true.
@@ -76,7 +78,11 @@ c        write (iout,'(a)') card
           sccalc=.true.
         endif
 ! Read free energy
-        if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp
+c        if (index(card,"FREE ENERGY").gt.0) then
+c          ifree=index(card,"FREE ENERGY")+12
+c          read(card(ifree:),*,err=1115,end=1115) efree_temp
+c 1115     continue
+c        endif
 ! Fish out the ATOM cards.
         if (index(card(1:4),'ATOM').gt.0) then  
           sccalc=.false.
@@ -96,9 +102,11 @@ c          write (iout,*) "IRES",ires-ishift+ishift1,ires_old
 !            if (ibeg.eq.0) call sccenter(ires,iii,sccor)
             if (ibeg.eq.0) then
 c              write (iout,*) "Calculating sidechain center iii",iii
+c              write (iout,*) "ires",ires
               if (unres_pdb) then
+c                write (iout,'(i5,3f10.5)') ires,(sccor(j,iii),j=1,3)
                 do j=1,3
-                  dc(j,ires+nres)=sccor(j,iii)
+                  dc(j,ires_old)=sccor(j,iii)
                 enddo
               else
                 call sccenter(ires_old,iii,sccor)
@@ -153,7 +161,7 @@ c          write (2,*) "ires",ires," res ",res!," ity"!,ity
             read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3)
 !            write (iout,*) "backbone ",atom
 #ifdef DEBUG
-            write (iout,'(2i3,2x,a,3f8.3)') 
+            write (iout,'(i6,i3,2x,a,3f8.3)') 
      &      ires,itype(ires),res,(c(j,ires),j=1,3)
 #endif
             iii=iii+1
@@ -178,6 +186,10 @@ c      write (iout,*) "iii",iii
 C Calculate dummy residue coordinates inside the "chain" of a multichain
 C system
       nres=ires
+c      write (iout,*) "dc"
+c      do i=1,nres
+c        write (iout,'(i5,3f10.5)') i,(dc(j,i),j=1,3)
+c      enddo
       do i=2,nres-1
 c        write (iout,*) i,itype(i),itype(i+1),ntyp1,iterter(i)
         if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then
@@ -187,14 +199,14 @@ C first is connected prevous chain (itype(i+1).eq.ntyp1)=true
 C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false
            if (unres_pdb) then
 C 2/15/2013 by Adam: corrected insertion of the last dummy residue
-            print *,i,'tu dochodze'
+c            print *,i,'tu dochodze'
             call refsys(i-3,i-2,i-1,e1,e2,e3,fail)
             if (fail) then
               e2(1)=0.0d0
               e2(2)=1.0d0
               e2(3)=0.0d0
             endif !fail
-            print *,i,'a tu?'
+c            print *,i,'a tu?'
             do j=1,3
              c(j,i)=c(j,i-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0)
             enddo
@@ -312,6 +324,18 @@ C Calculate internal coordinates.
       enddo
       call flush(iout)
       endif
+      zero=.false.
+      do ires=1,nres
+        zero=zero.or.itype(ires).eq.0
+      enddo
+      if (zero) then
+        write (iout,'(2a)') "Gaps in PDB coordinates detected;",
+     &    " look for ZERO in the control output above."
+        write (iout,'(2a)') "Repair the PDB file using MODELLER",
+     &    " or other softwared and resubmit."
+        call flush(iout)
+        stop
+      endif
 c      write(iout,*)"before int_from_cart nres",nres
       call int_from_cart(.true.,.false.)
       do i=1,nres
@@ -439,7 +463,7 @@ C Calculate the CM of the preceding residue.
             if (ibeg.eq.0) then
               if (unres_pdb) then
                 do j=1,3
-                  dc(j,ires)=sccor(j,iii)
+                  dc(j,ires_old)=sccor(j,iii)
                 enddo
               else
                 call sccenter(ires_old,iii,sccor)
@@ -652,7 +676,7 @@ C Calculate internal coordinates.
       enddo
       endif
 C Calculate internal coordinates.
-      call int_from_cart(.true.,.true.)
+      call int_from_cart(.true.,out_template_coord)
       call sc_loc_geom(.false.)
       do i=1,nres
         thetaref(i)=theta(i)
index 16c0f37..d76b29e 100644 (file)
@@ -187,7 +187,6 @@ c      call readi(controlcard,'IZ_SC',iz_sc,0)
       pdbref=(index(controlcard,'PDBREF').gt.0)
       refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0)
       indpdb=index(controlcard,'PDBSTART')
-      extconf=(index(controlcard,'EXTCONF').gt.0)
       AFMlog=(index(controlcard,'AFM'))
       selfguide=(index(controlcard,'SELFGUIDE'))
 c      print *,'AFMlog',AFMlog,selfguide,"KUPA"
@@ -296,6 +295,12 @@ cfmc        modecalc=10
       indphi=index(controlcard,'PHI')
       indback=index(controlcard,'BACK')
       iranconf=index(controlcard,'RAND_CONF')
+      start_from_model=(index(controlcard,'START_FROM_MODELS').gt.0)
+      extconf=(index(controlcard,'EXTCONF').gt.0)
+      if (start_from_model) then
+        iranconf=0
+        extconf=.false.
+      endif
       i2ndstr=index(controlcard,'USE_SEC_PRED')
       gradout=index(controlcard,'GRADOUT').gt.0
       gnorm_check=index(controlcard,'GNORM_CHECK').gt.0
@@ -736,7 +741,7 @@ C
       integer ilen
       external ilen
       integer iperm,tperm
-      integer i,j,ii,k,l,itrial,itmp,i1,i2,it1,it2
+      integer i,j,ii,k,l,itrial,itmp,i1,i2,it1,it2,nres_temp
       double precision sumv
 C
 C Read PDB structure if applicable
@@ -831,7 +836,7 @@ c      print '(20i4)',(itype(i),i=1,nres)
        do i=1,nres-1
          write (iout,*) i,itype(i),itel(i)
        enddo
-       print *,'Call Read_Bridge.'
+c       print *,'Call Read_Bridge.'
       endif
       nnt=1
       nct=nres
@@ -844,7 +849,7 @@ cd      print *,'NNT=',NNT,' NCT=',NCT
         chain_border1(1,i)=chain_border(1,i)-1
         chain_border1(2,i)=chain_border(2,i)+1
       enddo
-      chain_border1(1,nchain)=chain_border(1,nchain)-1
+      if (nchain.gt.1) chain_border1(1,nchain)=chain_border(1,nchain)-1
       chain_border1(2,nchain)=nres
       write(iout,*) "nres",nres," nchain",nchain
       do i=1,nchain
@@ -870,9 +875,9 @@ c      enddo
       if (.not. (wdfa_dist.eq.0.0 .and. wdfa_tor.eq.0.0 .and.
      &            wdfa_nei.eq.0.0 .and. wdfa_beta.eq.0.0)) then
        call init_dfa_vars
-       print*, 'init_dfa_vars finished!'
+c       print*, 'init_dfa_vars finished!'
        call read_dfa_info
-       print*, 'read_dfa_info finished!'
+c       print*, 'read_dfa_info finished!'
       endif
 #endif
       if (pdbref) then
@@ -1097,10 +1102,10 @@ czscore          call geom_to_var(nvar,coord_exp_zs(1,1))
         endif
       endif
 c        print *, "A TU"
-      write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup
+c      write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup
       call flush(iout)
       if (constr_dist.gt.0) call read_dist_constr
-      write (iout,*) "After read_dist_constr nhpb",nhpb
+c      write (iout,*) "After read_dist_constr nhpb",nhpb
       if ((AFMlog.gt.0).or.(selfguide.gt.0)) call read_afminp
       call hpb_partition
       call NMRpeak_partition
@@ -1163,6 +1168,49 @@ c        print *, "A TU"
        enddo
       else
         homol_nset=0
+        if (start_from_model) then
+          nmodel_start=0 
+          do 
+            read(inp,'(a)',end=332,err=332) pdbfile
+            if (me.eq.king .or. .not. out1file)
+     &        write (iout,'(a,5x,a)') 'Opening PDB file',
+     &        pdbfile(:ilen(pdbfile))
+            open(ipdbin,file=pdbfile,status='old',err=336)
+            goto 335
+ 336        write (iout,'(a,5x,a)') 'Error opening PDB file',
+     &      pdbfile(:ilen(pdbfile))
+            call flush(iout)
+            stop
+ 335        continue
+            unres_pdb=.false.
+            nres_temp=nres
+            call readpdb
+            close(ipdbin)
+            if (nres.ge.nres_temp) then
+              nmodel_start=nmodel_start+1
+              pdbfiles_chomo(nmodel_start)=pdbfile
+              do i=1,2*nres
+                do j=1,3
+                  chomo(j,i,nmodel_start)=c(j,i)
+                enddo
+              enddo
+            else
+              if (me.eq.king .or. .not. out1file)
+     &          write (iout,'(a,2i5,1x,a)') 
+     &           "Different number of residues",nres_temp,nres,
+     &           " model skipped."
+            endif
+            nres=nres_temp
+          enddo
+  332     continue
+          if (nmodel_start.eq.0) then
+            if (me.eq.king .or. .not. out1file)
+     &        write (iout,'(a)')
+     &        "No valid starting model found START_FROM_MODELS is OFF"
+              start_from_model=.false.
+          endif
+          write (iout,*) "nmodel_start",nmodel_start
+        endif
       endif
 
 
@@ -1172,14 +1220,15 @@ C      endif
      &    modecalc.ne.10) then
 C If input structure hasn't been supplied from the PDB file read or generate
 C initial geometry.
-        if (iranconf.eq.0 .and. .not. extconf) then
+        if (iranconf.eq.0 .and. .not. extconf .and. .not.
+     &     start_from_model) then
           if(me.eq.king.or..not.out1file .and.fg_rank.eq.0)
      &     write (iout,'(a)') 'Initial geometry will be read in.'
           if (read_cart) then
             read(inp,'(8f10.5)',end=36,err=36)
      &       ((c(l,k),l=1,3),k=1,nres),
      &       ((c(l,k+nres),l=1,3),k=nnt,nct)
-            write (iout,*) "Exit READ_CART"
+c            write (iout,*) "Exit READ_CART"
 c            write (iout,'(8f10.5)') 
 c     &       ((c(l,k),l=1,3),k=1,nres),
 c     &       ((c(l,k+nres),l=1,3),k=nnt,nct)
@@ -1405,7 +1454,13 @@ C Read information about disulfide bridges.
       integer i,j
 C Read bridging residues.
       read (inp,*) ns,(iss(i),i=1,ns)
-      print *,'ns=',ns
+c 5/24/2020 Adam: Added a table to translate residue numbers to cysteine
+c     numbers
+      icys=0
+      do i=1,ns
+        icys(iss(i))=i
+      enddo
+c      print *,'ns=',ns
       if(me.eq.king.or..not.out1file)
      &  write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns)
 C Check whether the specified bridging residues are cystines.
@@ -1614,9 +1669,11 @@ C Generate CA distance constraints.
       include 'COMMON.CONTROL'
       include 'COMMON.DBASE'
       include 'COMMON.THREAD'
+      include 'COMMON.SPLITELE'
       include 'COMMON.TIME1'
       integer i,j,itype_pdb(maxres)
       common /pizda/ itype_pdb
+      double precision dd
       double precision dist
       character*2 iden
 cd      print *,'gen_dist_constr: nnt=',nnt,' nct=',nct
@@ -1627,11 +1684,14 @@ cd     & ' nsup',nsup
 cd      write (2,*) 'i',i,' seq ',restyp(itype(i+nstart_seq-nstart_sup)),
 cd     &    ' seq_pdb', restyp(itype_pdb(i))
         do j=i+2,nstart_sup+nsup-1
+c 5/24/2020 Adam: Cutoff included to reduce array size
+          dd = dist(i,j)
+          if (dd.gt.r_cut_int) cycle
           nhpb=nhpb+1
           ihpb(nhpb)=i+nstart_seq-nstart_sup
           jhpb(nhpb)=j+nstart_seq-nstart_sup
           forcon(nhpb)=weidis
-          dhpb(nhpb)=dist(i,j)
+          dhpb(nhpb)=dd
         enddo
       enddo 
 cd      write (iout,'(a)') 'Distance constraints:' 
@@ -2375,10 +2435,10 @@ c------------------------------------------------------------------------------
       open(irest2,file=rest2name,status='unknown')
       read(irest2,*) totT,EK,potE,totE,t_bath
       totTafm=totT
-      do i=1,2*nres
+      do i=0,2*nres-1
          read(irest2,'(3e15.5)') (d_t(j,i),j=1,3)
       enddo
-      do i=1,2*nres
+      do i=0,2*nres-1
          read(irest2,'(3e15.5)') (dc(j,i),j=1,3)
       enddo
       if(usampl) then
@@ -2468,7 +2528,7 @@ c      print *, "wchodze"
       call readi(afmcard,"END",afmend,0)
       call reada(afmcard,"FORCE",forceAFMconst,0.0d0)
       call reada(afmcard,"VEL",velAFMconst,0.0d0)
-      print *,'FORCE=' ,forceAFMconst
+c      print *,'FORCE=' ,forceAFMconst
 CCCC NOW PROPERTIES FOR AFM
        distafminit=0.0d0
        do i=1,3
@@ -2979,7 +3039,7 @@ c    &    sigma_odl_temp(maxres,maxres,max_template)
       character*24 model_ki_dist, model_ki_angle
       character*500 controlcard
       integer ki,i,ii,j,k,l,ii_in_use(maxdim),i_tmp,idomain_tmp,irec,
-     & ik,iistart
+     & ik,iistart,nres_temp
       integer ilen
       external ilen
       logical liiflag,lfirst
@@ -3016,15 +3076,17 @@ c Alternative: reading from input
           if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) 
      &      write(iout,*) 'START_FROM_MODELS works only with READ2SIGMA'
           start_from_model=.false.
+          iranconf=(indpdb.le.0)
       endif
       if(start_from_model .and. (me.eq.king .or. .not. out1file))
      &    write(iout,*) 'START_FROM_MODELS is ON'
-      if(start_from_model .and. rest) then 
-        if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
-         write(iout,*) 'START_FROM_MODELS is OFF'
-         write(iout,*) 'remove restart keyword from input'
-        endif
-      endif
+c      if(start_from_model .and. rest) then 
+c        if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
+c         write(iout,*) 'START_FROM_MODELS is OFF'
+c         write(iout,*) 'remove restart keyword from input'
+c        endif
+c      endif
+      if (start_from_model) nmodel_start=constr_homology
       if (homol_nset.gt.1)then
          call card_concat(controlcard)
          read(controlcard,*) (waga_homology(i),i=1,homol_nset) 
         tpl_k_rescore="template"//kic2//".sco"
 
         unres_pdb=.false.
+        nres_temp=nres
         if (read2sigma) then
           call readpdb_template(k)
         else
           call readpdb
         endif
+        nres_chomo(k)=nres
+        nres=nres_temp
 c
 c     Distance restraints
 c
 c          ... --> odl(k,ii)
 C Copy the coordinates from reference coordinates (?)
-        do i=1,2*nres
+        do i=1,2*nres_chomo(k)
           do j=1,3
             c(j,i)=cref(j,i)
 c           write (iout,*) "c(",j,i,") =",c(j,i)
@@ -3562,6 +3627,7 @@ c----------------------------------------------------------------------
      & ik,ll,ii,kk,iistart,iishift,lim_xx
       double precision distal
       logical lprn /.true./
+      integer nres_temp
       integer ilen
       external ilen
       logical liiflag
@@ -3596,7 +3662,10 @@ c Read pdb files
         stop
   34    continue
         unres_pdb=.false.
+        nres_temp=nres
         call readpdb_template(k)
+        nres_chomo(k)=nres
+        nres=nres_temp
         do i=1,nres
           rescore(k,i)=0.2d0
           rescore2(k,i)=1.0d0
@@ -3630,6 +3699,8 @@ c     Distance restraints
 c
 c          ... --> odl(k,ii)
 C Copy the coordinates from reference coordinates (?)
+        nres_temp=nres
+        nres=nres_chomo(k)
         do i=1,2*nres
           do j=1,3
             c(j,i)=chomo(j,i,k)
@@ -3642,6 +3713,7 @@ c           write (iout,*) "c(",j,i,") =",c(j,i)
           thetaref(i)=theta(i)
           phiref(i)=phi(i)
         enddo
+        nres=nres_temp
         if (waga_dist.ne.0.0d0) then
           ii=0
           do i = nnt,nct-2 
index c506b8a..72d92da 100644 (file)
@@ -7,7 +7,8 @@
       include 'COMMON.HEADER'
       include 'COMMON.IOUNITS'
       include 'COMMON.MINIM'
-      double precision przes(3),obrot(3,3),fhpb0(maxdim),varia(maxvar)
+      double precision przes(3),obrot(3,3),fhpb0(maxdim_cont),
+     & varia(maxvar)
       double precision cref0(3,ncart)
       double precision energia(0:n_ene)
       logical non_conv
index aa938b5..26807a0 100644 (file)
@@ -84,10 +84,13 @@ ct           rij=ran_number(rmin,rmax)
 C-----------------------------------------------------------------------------
 
       subroutine dyn_ssbond_ene(resi,resj,eij)
-c      implicit none
-
-c     Includes
+      implicit none
       include 'DIMENSIONS'
+#ifdef MPI
+      include 'mpif.h'
+      include 'COMMON.SETUP'
+      integer ierr
+#endif 
       include 'COMMON.SBRIDGE'
       include 'COMMON.CHAIN'
       include 'COMMON.DERIV'
@@ -96,6 +99,7 @@ c     Includes
       include 'COMMON.VAR'
       include 'COMMON.IOUNITS'
       include 'COMMON.CALC'
+      include 'COMMON.NAMES'
 #ifndef CLUST
 #ifndef WHAM
       include 'COMMON.MD'
@@ -128,6 +132,9 @@ c      integer itypi,itypj,k,l
       double precision omega,delta_inv,deltasq_inv,fac1,fac2
 c-------FIRST METHOD
       double precision xm,d_xm(1:3)
+      double precision sslipi,sslipj,ssgradlipi,ssgradlipj
+      integer ici,icj,itypi,itypj
+      double precision boxshift,sscale,sscagrad
 c-------END FIRST METHOD
 c-------SECOND METHOD
 c$$$      double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
@@ -144,125 +151,52 @@ c-------END TESTING CODE
 
       i=resi
       j=resj
-
+      ici=icys(i)
+      icj=icys(j)
+      if (ici.eq.0 .or. icj.eq.0) then
+#ifdef MPI
+        write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') 
+     &  "Processor",me," attempt to create",
+     &  " a disulfide link between non-cysteine residues ",restyp(i),i,
+     &  restyp(j),j
+        call MPI_Abort(MPI_COMM_WORLD,ierr)
+#else
+        write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') 
+     &  "Processor",me," attempt to create",
+     &  " a disulfide link between non-cysteine residues ",restyp(i),i,
+     &  restyp(j),j
+        stop
+#endif
+      endif
       itypi=itype(i)
       dxi=dc_norm(1,nres+i)
       dyi=dc_norm(2,nres+i)
       dzi=dc_norm(3,nres+i)
       dsci_inv=vbld_inv(i+nres)
-        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
+      xi=c(1,nres+i)
+      yi=c(2,nres+i)
+      zi=c(3,nres+i)
+      call to_box(xi,yi,zi)
 C define scaling factor for lipids
 
 C        if (positi.le.0) positi=positi+boxzsize
 C        print *,i
 C first for peptide groups
 c for each residue check if it is in lipid or lipid water border area
-       if ((zi.gt.bordlipbot)
-     &.and.(zi.lt.bordliptop)) then
-C the energy transfer exist
-        if (zi.lt.buflipbot) then
-C what fraction I am in
-         fracinbuf=1.0d0-
-     &        ((positi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-         sslipi=sscalelip(fracinbuf)
-         ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
-        elseif (zi.gt.bufliptop) then
-         fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
-         sslipi=sscalelip(fracinbuf)
-         ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
-        else
-         sslipi=1.0d0
-         ssgradlipi=0.0
-        endif
-       else
-         sslipi=0.0d0
-         ssgradlipi=0.0
-       endif
+      call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
       itypj=itype(j)
-            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
-       if ((zj.gt.bordlipbot)
-     &.and.(zj.lt.bordliptop)) then
-C the energy transfer exist
-        if (zj.lt.buflipbot) then
-C what fraction I am in
-         fracinbuf=1.0d0-
-     &        ((positi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-         sslipj=sscalelip(fracinbuf)
-         ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
-        elseif (zi.gt.bufliptop) then
-         fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
-         sslipj=sscalelip(fracinbuf)
-         ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
-        else
-         sslipj=1.0d0
-         ssgradlipj=0.0
-        endif
-       else
-         sslipj=0.0d0
-         ssgradlipj=0.0
-       endif
+      xj=c(1,nres+j)
+      yj=c(2,nres+j)
+      zj=c(3,nres+j)
+      call to_box(xj,yj,zj)
+      call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
       aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
      &  +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
       bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
      &  +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
-
-      dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
-      xj_safe=xj
-      yj_safe=yj
-      zj_safe=zj
-      subchap=0
-      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
-
-C     xj=c(1,nres+j)-c(1,nres+i)
-C      yj=c(2,nres+j)-c(2,nres+i)
-C      zj=c(3,nres+j)-c(3,nres+i)
+      xj=boxshift(xj-xi,boxxsize)
+      yj=boxshift(yj-yi,boxysize)
+      zj=boxshift(zj-zi,boxzsize)
       dxj=dc_norm(1,nres+j)
       dyj=dc_norm(2,nres+j)
       dzj=dc_norm(3,nres+j)
@@ -522,9 +456,10 @@ c     &         "SSBOND_E_FORM",totT,t_bath,i,j
 c        endif
 #endif
 #endif
-        dyn_ssbond_ij(i,j)=eij
-      else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
-        dyn_ssbond_ij(i,j)=1.0d300
+        dyn_ssbond_ij(ici,icj)=eij
+      else if (.not.havebond .and. dyn_ssbond_ij(ici,icj).lt.1.0d300) 
+     &then
+        dyn_ssbond_ij(ici,icj)=1.0d300
 #ifndef CLUST
 #ifndef WHAM
 c        write(iout,'(a15,f12.2,f8.1,2i5)')
@@ -646,16 +581,16 @@ c     Includes
 c     Local variables
       double precision emin
       integer i,j,imin
-      integer diff,allflag(maxdim),allnss,
-     &     allihpb(maxdim),alljhpb(maxdim),
-     &     newnss,newihpb(maxdim),newjhpb(maxdim)
+      integer diff,allflag(maxss),allnss,
+     &     allihpb(maxss),alljhpb(maxss),
+     &     newnss,newihpb(maxss),newjhpb(maxss)
       logical found
       integer i_newnss(max_fg_procs),displ(0:max_fg_procs)
-      integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss
+      integer g_newihpb(maxss),g_newjhpb(maxss),g_newnss
 
       allnss=0
-      do i=1,nres-1
-        do j=i+1,nres
+      do i=1,ns-1
+        do j=i+1,ns
           if (dyn_ssbond_ij(i,j).lt.1.0d300) then
             allnss=allnss+1
             allflag(allnss)=0
@@ -2037,7 +1972,7 @@ c$$$      end
 c$$$
 c$$$C-----------------------------------------------------------------------------
 c$$$C-----------------------------------------------------------------------------
-         subroutine triple_ssbond_ene(resi,resj,resk,eij)
+      subroutine triple_ssbond_ene(resi,resj,resk,eij)
       include 'DIMENSIONS'
       include 'COMMON.SBRIDGE'
       include 'COMMON.CHAIN'
index 368cf97..c83e9ce 100644 (file)
@@ -496,6 +496,10 @@ c------------------------------------------------------------------
       double precision time00
 #endif
       include 'DIMENSIONS'
+#ifndef FIVEDIAG
+      integer mmaxres2
+      parameter (mmaxres2=(maxres2*(maxres2+1)/2))
+#endif
       include 'COMMON.VAR'
       include 'COMMON.CHAIN'
       include 'COMMON.DERIV'
index ac867d9..1ea11ab 100644 (file)
@@ -8,7 +8,7 @@
       include 'COMMON.VAR'
       include 'COMMON.INTERACT'
       include 'COMMON.IOUNITS'
-      include 'COMMON.DISTFIT'
+c      include 'COMMON.DISTFIT'
       include 'COMMON.SBRIDGE'
       include 'COMMON.CONTROL'
       include 'COMMON.FFIELD'
@@ -129,7 +129,7 @@ c       call write_pdb(999,'full min',etot)
       include 'COMMON.VAR'
       include 'COMMON.INTERACT'
       include 'COMMON.IOUNITS'
-      include 'COMMON.DISTFIT'
+c      include 'COMMON.DISTFIT'
       include 'COMMON.SBRIDGE'
       include 'COMMON.CONTROL'
       include 'COMMON.FFIELD'
@@ -324,7 +324,7 @@ c------------------------------------------
       include 'COMMON.FFIELD'
       include 'COMMON.MINIM'
 c
-      include 'COMMON.DISTFIT'       
+c      include 'COMMON.DISTFIT'       
       integer if(20,maxres),nif,ifa(20)
       integer ibc(0:maxres,0:maxres),istrand(20)
       integer ibd(maxres),ifb(10,2),nifb,lifb(10),lifb0
@@ -1032,7 +1032,7 @@ c--------------------------------------------------------
       include 'COMMON.FFIELD'
       include 'COMMON.MINIM'
 c
-      include 'COMMON.DISTFIT'       
+c      include 'COMMON.DISTFIT'       
       integer if(3,maxres),nif
       integer ibc(maxres,maxres),istrand(20)
       integer ibd(maxres),ifb(10,2),nifb,lifb(10),lifb0
@@ -1225,7 +1225,7 @@ c
       include 'COMMON.FFIELD'
       include 'COMMON.MINIM'
 c
-      include 'COMMON.DISTFIT'       
+c      include 'COMMON.DISTFIT'       
       integer if(2,2),ind
       integer iff(maxres)
       double precision time0,time1
@@ -1359,11 +1359,11 @@ c-------------------------------------------------
       include 'DIMENSIONS'
       include 'COMMON.CHAIN'
       include 'COMMON.IOUNITS'
-      include 'COMMON.DISTFIT'
+c      include 'COMMON.DISTFIT'
 
-      integer ncont,icont(2,maxres*maxres/2),isec(maxres,3)
+      integer ncont,icont(2,maxres*maxint_res),isec(maxres,3)
       logical lprint,not_done
-      real dcont(maxres*maxres/2),d
+      real dcont(maxres*maxint_res),d
       real rcomp /7.0/ 
       real rbeta /5.2/
       real ralfa /5.2/
@@ -1709,152 +1709,3 @@ c----------------------------------------------------------------------------
       end
 
 c-----------------------------------------------------------
-      subroutine contact_cp2(var,var2,iff,ieval,in_pdb)
-      implicit real*8 (a-h,o-z)
-      include 'DIMENSIONS'
-#ifdef MPI
-      include 'mpif.h'
-#endif
-      include 'COMMON.SBRIDGE'
-      include 'COMMON.FFIELD'
-      include 'COMMON.IOUNITS'
-      include 'COMMON.DISTFIT'
-      include 'COMMON.VAR'
-      include 'COMMON.CHAIN'
-      include 'COMMON.MINIM'
-
-      character*50 linia
-      integer nf,ij(4)
-      double precision var(maxvar),var2(maxvar)
-      double precision time0,time1
-      integer iff(maxres),ieval      
-      double precision theta1(maxres),phi1(maxres),alph1(maxres),     
-     &                 omeg1(maxres)                             
-      
-
-       call var_to_geom(nvar,var)
-       call chainbuild                                                           
-       nhpb0=nhpb
-       ind=0                                                                     
-       do i=1,nres-3                                                             
-         do j=i+3,nres                                                           
-          ind=ind+1                                                              
-          if ( iff(i).eq.1.and.iff(j).eq.1 ) then                                           
-            d0(ind)=DIST(i,j)                                                     
-            w(ind)=10.0                                                           
-            nhpb=nhpb+1                                                           
-            ihpb(nhpb)=i                                                          
-            jhpb(nhpb)=j                                                          
-            forcon(nhpb)=10.0                                                     
-            dhpb(nhpb)=d0(ind)                                                    
-          else
-            w(ind)=0.0
-          endif                                                                  
-         enddo                                                                   
-       enddo                                    
-       call hpb_partition
-
-       do i=1,nres                                                               
-        theta1(i)=theta(i)                                                      
-        phi1(i)=phi(i)                                                          
-        alph1(i)=alph(i)                                                        
-        omeg1(i)=omeg(i)                                                        
-       enddo                      
-
-       call var_to_geom(nvar,var2)
-
-       do i=1,nres                                                             
-          if ( iff(i).eq.1 ) then                                           
-              theta(i)=theta1(i)                                                      
-              phi(i)=phi1(i)                                                          
-              alph(i)=alph1(i)                                                        
-              omeg(i)=omeg1(i)                       
-          endif
-       enddo
-
-       call chainbuild
-cd       call write_pdb(3,'combined structure',0d0)
-cd       time0=MPI_WTIME()
-       
-       NX=NRES-3                                                                 
-       NY=((NRES-4)*(NRES-5))/2 
-       call distfit(.true.,200)
-   
-cd       time1=MPI_WTIME()
-cd       write (iout,'(a,f6.2,a)') ' Time for distfit ',time1-time0,' sec'
-
-       ipot0=ipot
-       maxmin0=maxmin
-       maxfun0=maxfun
-       wstrain0=wstrain
-
-       ipot=6
-       maxmin=2000
-       maxfun=5000
-       call geom_to_var(nvar,var)
-cd       time0=MPI_WTIME()
-       call minimize(etot,var,iretcode,nfun)                               
-       write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun   
-
-cd       time1=MPI_WTIME()
-cd       write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0,
-cd     &         nfun/(time1-time0),' SOFT eval/s'
-        call var_to_geom(nvar,var)
-        call chainbuild
-
-
-        iwsk=0
-        nf=0
-        if (iff(1).eq.1) then
-          iwsk=1
-          nf=nf+1
-          ij(nf)=0
-        endif
-        do i=2,nres
-           if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then
-             iwsk=1
-             nf=nf+1
-             ij(nf)=i
-           endif
-           if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then
-             iwsk=0
-             nf=nf+1
-             ij(nf)=i-1
-           endif
-        enddo
-        if (iff(nres).eq.1) then
-          nf=nf+1
-          ij(nf)=nres
-        endif
-
-
-cd        write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)')
-cd     &                     "select",ij(1),"-",ij(2),
-cd     &                         ",",ij(3),"-",ij(4)
-cd        call write_pdb(in_pdb,linia,etot)
-
-
-       ipot=ipot0
-       maxmin=maxmin0
-       maxfun=maxfun0
-cd       time0=MPI_WTIME()
-       call minimize(etot,var,iretcode,nfun)
-cd       write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun
-       ieval=nfun
-
-cd       time1=MPI_WTIME()
-cd       write (iout,'(a,f6.2,f8.2,a)')' Time for DIST min.',time1-time0,
-cd     &         nfun/(time1-time0),' eval/s'
-cd       call var_to_geom(nvar,var)
-cd       call chainbuild
-cd       call write_pdb(6,'dist structure',etot)
-
-
-       nhpb= nhpb0                                                                  
-       link_start=1                                                            
-       link_end=nhpb     
-       wstrain=wstrain0
-
-       return
-       end
-c-----------------------------------------------------------
index 03740bf..ea57f19 100644 (file)
@@ -5,4 +5,4 @@
      &  dist2_cut
       common /homol/  waga_homology(maxR),
      & waga_dist,waga_angle,waga_theta,waga_d,dist_cut,dist2_cut,
-     & iset,ihset,l_homo(max_template,maxdim)
+     & iset,ihset,l_homo(max_template,maxdim_cont)
index 95ea932..0e558f1 100644 (file)
@@ -1,6 +1,7 @@
-       real*8 odl(max_template,maxdim),sigma_odl(max_template,maxdim),
+       real*8 odl(max_template,maxdim_cont),
+     &   sigma_odl(max_template,maxdim_cont),
      &    dih(max_template,maxres),sigma_dih(max_template,maxres),
-     &    sigma_odlir(max_template,maxdim)
+     &    sigma_odlir(max_template,maxdim_cont)
 c
 c    Specification of new variables used in  subroutine e_modeller
 c    modified by FP (Nov.,2014)
@@ -10,7 +11,7 @@ c    modified by FP (Nov.,2014)
      &        sigma_d(max_template,maxres)
 c
 
-       integer ires_homo(maxdim),jres_homo(maxdim)
+       integer ires_homo(maxdim_cont),jres_homo(maxdim_cont)
 
        double precision 
      & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst,
index 1f96c94..8d89f0b 100644 (file)
@@ -5,10 +5,11 @@
        common /shield/ VSolvSphere,VSolvSphere_div,buff_shield,
      & long_r_sidechain(ntyp),
      & short_r_sidechain(ntyp),fac_shield(maxres),wshield,
-     & grad_shield_side(3,maxcont,-1:maxres),grad_shield(3,-1:maxres),
-     &  grad_shield_loc(3,maxcont,-1:maxres),
-     & ishield_list(maxres),shield_list(maxcont,maxres),
-     & ees0plist(maxcont,maxres)
+     & grad_shield_side(3,maxint_res,-1:maxres),
+     & grad_shield(3,-1:maxres),
+     & grad_shield_loc(3,maxint_res,-1:maxres),
+     & ishield_list(maxres),shield_list(maxint_res,maxres),
+     & ees0plist(maxint_res,maxres)
 
 
        
index 4d690f3..65b3e75 100644 (file)
@@ -15,16 +15,19 @@ C Max. number of AA residues
       integer maxres
 c      parameter (maxres=250)
 c      parameter (maxres=1200)
-      parameter (maxres=5000)
+      parameter (maxres=10000)
+C Max. number of cysteines and other bridging residues
+      integer max_cyst
+      parameter (max_cyst=100)
 C Appr. max. number of interaction sites
       integer maxres2
       parameter (maxres2=2*maxres)
 c Max. number of chains
       integer maxchain
-      parameter (maxchain=6)
+      parameter (maxchain=50)
 C Max number of symetries
        integer maxsym,maxperm
-       parameter (maxsym=maxchain,maxperm=720)
+       parameter (maxsym=maxchain,maxperm=120)
 C Max. number of variables
       integer maxvar
       parameter (maxvar=4*maxres)
@@ -42,6 +45,16 @@ C Max. number of SC contacts
 C Max. number of contacts per residue
       integer maxconts
       parameter (maxconts=maxres)
+C Max. number of interactions within cutoff per residue
+      integer maxint_res
+      parameter (maxint_res=200)
+C Max. number od residues within distance cufoff from a given residue to
+C     include in template-based/contact distance restraints.
+      integer maxcont_res
+      parameter (maxcont_res=200)
+C Max. number of distance/contact-distance restraints
+      integer maxdim_cont
+      parameter (maxdim_cont=maxres*maxcont_res)
 C Number of AA types (at present only natural AA's will be handled
       integer ntyp,ntyp1
       parameter (ntyp=24,ntyp1=ntyp+1)
@@ -71,7 +84,7 @@ C Max. number of lobes in SC distribution
       parameter (maxlob=4)
 C Max. number of S-S bridges
       integer maxss
-      parameter (maxss=20)
+      parameter (maxss=max_cyst*(max_cyst-1)/2)
 C Max. number of dihedral angle constraints
       integer maxdih_constr
       parameter (maxdih_constr=maxres)
diff --git a/source/wham/src-HCD/Makefile-tryton b/source/wham/src-HCD/Makefile-tryton
new file mode 100644 (file)
index 0000000..b595c21
--- /dev/null
@@ -0,0 +1,162 @@
+BIN = ~/unres/bin
+FC = mpif90 -fc=ifort
+OPT = -mcmodel=medium -shared-intel -O3
+#OPT = -O3 -intel-static -mcmodel=medium 
+#OPT = -O3 -ip -w 
+#OPT = -g -CB -mcmodel=medium -shared-intel
+FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include
+LIBS = -L$(INSTALL_DIR)/lib -lmpi xdrf/libxdrf.a
+
+.f.o:
+       ${FC} ${FFLAGS} $*.f
+
+.F.o:
+       ${FC} ${FFLAGS} ${CPPFLAGS} $*.F
+
+objects = \
+       wham_multparm.o \
+       bxread.o \
+       xread.o \
+       cxread.o \
+       enecalc1.o \
+       energy_p_new.o \
+       boxshift.o \
+       gnmr1.o \
+       initialize_p.o \
+       molread_zs.o \
+       openunits.o \
+       readrtns.o \
+       read_constr_homology.o \
+       arcos.o \
+       cartprint.o \
+       chainbuild.o \
+       geomout.o \
+       icant.o \
+       intcor.o \
+       int_from_cart.o \
+       refsys.o \
+       make_ensemble1.o \
+       matmult.o \
+       misc.o \
+       mygetenv.o \
+       parmread.o \
+       permut.o \
+       seq2chains.o \
+       chain_symmetry.o \
+       iperm.o \
+       pinorm.o \
+       printmat.o \
+       proc_proc.o \
+       rescode.o \
+       setup_var.o \
+       slices.o \
+       store_parm.o \
+       timing.o \
+       wham_calc1.o \
+       PMFprocess.o \
+       ssMD.o \
+       oligomer.o 
+
+objects_compar = \
+        readrtns_compar.o \
+        readpdb.o fitsq.o contact.o \
+        elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \
+        angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \
+        rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o
+
+all: no_option
+       @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR"
+
+no_option:
+
+GAB: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \
+       -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM
+GAB: ${objects} ${objects_compar} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo
+       ${FC} -c ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \
+       ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD.exe
+
+GAB_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \
+       -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM -DDFA
+GAB_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo
+       ${FC} -c ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \
+       ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD-DFA.exe
+
+4P: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPGI -DISNAN -DAMD64 \
+       -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM
+4P: ${objects} ${objects_compar} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo
+       ${FC} -c ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \
+       ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD.exe
+
+4P_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPGI -DISNAN -DAMD64 \
+       -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM -DDFA
+4P_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo
+       ${FC} -c ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \
+       ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD-DFA.exe
+
+E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DFOURBODY -DAMD64 -DWHAM
+E0LL2Y: ${objects} ${objects_compar} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo
+       ${FC} -c ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \
+       ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD.exe
+
+E0LL2Y_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DFOURBODY -DAMD64 -DWHAM -DDFA
+E0LL2Y_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo
+       ${FC} -c ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \
+       ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD-DFA.exe
+
+NEWCORR: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DPGI -DISNAN -DAMD64 -DWHAM
+NEWCORR: ${objects} ${objects_compar} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo
+       ${FC} -c ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \
+       ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD.exe
+
+NEWCORR5D: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DPGI -DISNAN -DAMD64 -DWHAM -DFIVEDIAG
+NEWCORR5D: ${objects} ${objects_compar} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo
+       ${FC} -c ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \
+       ${LIBS} -Wl,-M -o ${BIN}/wham_ifort_MPICH-tryton-HCD5-D.exe
+
+NEWCORR_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DDFA -DPGI -DISNAN -DAMD64 -DWHAM -DDFA
+NEWCORR_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo
+       ${FC} -c ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \
+       ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD-DFA-D.exe
+
+NEWCORR5D_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DDFA -DPGI -DISNAN -DAMD64 -DWHAM -DFIVEDIAG -DDFA
+NEWCORR5D_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo
+       ${FC} -c ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \
+       ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD5-DFA.exe
+
+xdrf/libxdrf.a:
+       cd xdrf && make
+
+
+clean:
+       /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean
+
index e667382..b04295c 100644 (file)
@@ -20,6 +20,7 @@ objects = \
        cxread.o \
        enecalc1.o \
        energy_p_new.o \
+       boxshift.o \
        gnmr1.o \
        initialize_p.o \
        molread_zs.o \
@@ -27,7 +28,6 @@ objects = \
        readrtns.o \
        read_constr_homology.o \
        arcos.o \
-       cartder.o \
        cartprint.o \
        chainbuild.o \
        geomout.o \
diff --git a/source/wham/src-HCD/boxshift.f b/source/wham/src-HCD/boxshift.f
new file mode 100644 (file)
index 0000000..29d3406
--- /dev/null
@@ -0,0 +1,101 @@
+
+c------------------------------------------------------------------------
+      double precision function boxshift(x,boxsize)
+      implicit none
+      double precision x,boxsize
+      double precision xtemp
+      xtemp=dmod(x,boxsize)
+      if (dabs(xtemp-boxsize).lt.dabs(xtemp)) then
+        boxshift=xtemp-boxsize
+      else if (dabs(xtemp+boxsize).lt.dabs(xtemp)) then
+        boxshift=xtemp+boxsize
+      else
+        boxshift=xtemp
+      endif
+      return
+      end
+c--------------------------------------------------------------------------
+      subroutine closest_img(xi,yi,zi,xj,yj,zj)
+      include 'DIMENSIONS'
+      include 'COMMON.CHAIN'
+      integer xshift,yshift,zshift,subchap
+      double precision dist_init,xj_safe,yj_safe,zj_safe,
+     & xj_temp,yj_temp,zj_temp,dist_temp
+      xj_safe=xj
+      yj_safe=yj
+      zj_safe=zj
+      dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+      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
+      return
+      end
+c--------------------------------------------------------------------------
+      subroutine to_box(xi,yi,zi)
+      implicit none
+      include 'DIMENSIONS'
+      include 'COMMON.CHAIN'
+      double precision xi,yi,zi
+      xi=dmod(xi,boxxsize)
+      if (xi.lt.0.0d0) xi=xi+boxxsize
+      yi=dmod(yi,boxysize)
+      if (yi.lt.0.0d0) yi=yi+boxysize
+      zi=dmod(zi,boxzsize)
+      if (zi.lt.0.0d0) zi=zi+boxzsize
+      return
+      end
+c--------------------------------------------------------------------------
+      subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+      implicit none
+      include 'DIMENSIONS'
+      include 'COMMON.CHAIN'
+      double precision xi,yi,zi,sslipi,ssgradlipi
+      double precision fracinbuf
+      double precision sscalelip,sscagradlip
+
+      if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then
+C the energy transfer exist
+        if (zi.lt.buflipbot) then
+C what fraction I am in
+          fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+          sslipi=sscalelip(fracinbuf)
+          ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+        elseif (zi.gt.bufliptop) then
+          fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+          sslipi=sscalelip(fracinbuf)
+          ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+        else
+          sslipi=1.0d0
+          ssgradlipi=0.0
+        endif
+      else
+        sslipi=0.0d0
+        ssgradlipi=0.0
+      endif
+      return
+      end
index cd29176..36ef6e6 100644 (file)
@@ -171,8 +171,12 @@ c      call flush(iout)
           c(j,i+nres+nnt-1)=xoord(j,i+nres)
         enddo
       enddo
+c      write (iout,*) "Before boxshift"
+c      call flush(iout)
 c Box shift
       call oligomer
+c      write (iout,*) "After oligomer"
+c      call flush(iout)
       do i=1,nres
         do j=1,3
           xoord(j,i)=c(j,i)
@@ -184,7 +188,8 @@ c Box shift
         enddo
       enddo
 c end change
-
+c      write (iout,*) "Before islice"
+c      call flush(iout)
       if (islice.gt.0 .and. islice.le.nslice .and. (.not.separate_parset
      &    .or. iset.eq.myparm)) then
         ii=ii+1
index 0040e37..60addc7 100644 (file)
@@ -163,8 +163,8 @@ C        write (iout,*) "tuz przed energia"
 C        write (iout,*) "tuz za energia"
 #ifdef DEBUG
         write (iout,*) "Conformation",i
-c          write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres),
-c     &                            ((c(l,k+nres),l=1,3),k=nnt,nct)
+        write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres),
+     &                            ((c(l,k+nres),l=1,3),k=nnt,nct)
         call enerprint(energia(0),fT)
 c        write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21)
 c        write (iout,*) "ftors(1)",ftors(1)
@@ -200,6 +200,8 @@ c        call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
           if (ipar.eq.iparm) write (iout,*) i,iparm,
      &      1.0d0/(beta_h(ib,ipar)*1.987D-3),eini,energia(0)
 #endif
+c          write (iout,*) "eini",eini,"energia(0)",energia(0)," diff",
+c     &       eini-energia(0)
           if (ipar.eq.iparm .and. einicheck.gt.0 .and. 
 !     &      dabs(eini-energia(0)-energia(27)).gt.tole) then
      &      dabs(eini-energia(0)).gt.tole) then
@@ -213,8 +215,8 @@ c        call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
           write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres),
      &                            ((c(l,k+nres),l=1,3),k=nnt,nct)
 c              call intout
-c              call pdbout(indstart(me1)+iii,
-c     & 1.0d0/(1.987D-3*beta_h(ib,ipar)),energia(0),eini,0.0d0,0.0d0)
+              call pdbout(indstart(me1)+iii,
+     & 1.0d0/(1.987D-3*beta_h(ib,ipar)),energia(0),eini,0.0d0,0.0d0)
               call enerprint(energia(0),fT)
               errmsg_count=errmsg_count+1
               if (errmsg_count.gt.maxerrmsg_count) 
@@ -262,6 +264,7 @@ c          call enerprint(energia(0),fT)
         iii=iii+1
         if (q(1,iii).le.0.0d0 .and. indpdb.gt.0)
      &    q(1,iii)=qwolynes(0,0,ipermin)
+c        write (iout,*) "iii",iii," q",q(1,iii)
         write (ientout,rec=iii) 
      &   ((csingle(l,k),l=1,3),k=1,nres),
      &   ((csingle(l,k+nres),l=1,3),k=nnt,nct),
index 6105156..ce7a6a7 100644 (file)
@@ -159,6 +159,7 @@ c         write (iout,*) "Calling multibody_hbond"
          call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
       endif
 #endif
+c      write (iout,*) "nsaxs",nsaxs
 c      write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
       if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
         call e_saxs(Esaxs_constr)
@@ -192,8 +193,12 @@ c      write(iout,*)'edfan is finished!', wdfa_nei,edfanei
       edfabet=0.0d0
       if (wdfa_beta.gt.0) call edfab(edfabet)
 c      write(iout,*)'edfab is finished!', wdfa_beta,edfabet
+#else
+      edfadis=0.0d0
+      edfator=0.0d0
+      edfanei=0.0d0
+      edfabet=0.0d0
 #endif
-
 c      write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
 #ifdef SPLITELE
       if (shield_mode.gt.0) then
@@ -515,6 +520,9 @@ C     Bartek
       edfator = energia(29)
       edfanei = energia(30)
       edfabet = energia(31)
+      Eafmforc=0.0d0
+      etube=0.0d0
+      Uconst=0.0d0
 #ifdef SPLITELE
       write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
      &  estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
@@ -680,6 +688,7 @@ cROZNICA
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
+        call to_box(xi,yi,zi)
 C Change 12/1/95
         num_conti=0
 C
@@ -694,6 +703,10 @@ cd   &                  'iend=',iend(i,iint)
             xj=c(1,nres+j)-xi
             yj=c(2,nres+j)-yi
             zj=c(3,nres+j)-zi
+            call to_box(xj,yj,zj)
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
 C Change 12/1/95 to calculate four-body interactions
             rij=xj*xj+yj*yj+zj*zj
             rrij=1.0D0/rij
@@ -865,6 +878,7 @@ c     print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
+        call to_box(xi,yi,zi)
 C
 C Calculate SC interaction energy.
 C
@@ -875,6 +889,10 @@ C
             xj=c(1,nres+j)-xi
             yj=c(2,nres+j)-yi
             zj=c(3,nres+j)-zi
+            call to_box(xj,yj,zj)
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
             rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
             fac_augm=rrij**expon
             e_augm=augm(itypi,itypj)*fac_augm
@@ -982,6 +1000,7 @@ c     endif
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
+        call to_box(xi,yi,zi)
         dxi=dc_norm(1,nres+i)
         dyi=dc_norm(2,nres+i)
         dzi=dc_norm(3,nres+i)
@@ -1014,9 +1033,13 @@ c           chip12=0.0D0
 c           alf1=0.0D0
 c           alf2=0.0D0
 c           alf12=0.0D0
-            xj=c(1,nres+j)-xi
-            yj=c(2,nres+j)-yi
-            zj=c(3,nres+j)-zi
+            xj=c(1,nres+j)
+            yj=c(2,nres+j)
+            zj=c(3,nres+j)
+            call to_box(xj,yj,zj)
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
             dxj=dc_norm(1,nres+j)
             dyj=dc_norm(2,nres+j)
             dzj=dc_norm(3,nres+j)
@@ -1128,35 +1151,8 @@ c      if (icall.gt.0) lprn=.true.
         yi=c(2,nres+i)
         zi=c(3,nres+i)
 C returning the ith atom to box
-          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
-       if ((zi.gt.bordlipbot)
-     &.and.(zi.lt.bordliptop)) then
-C the energy transfer exist
-        if (zi.lt.buflipbot) then
-C what fraction I am in
-         fracinbuf=1.0d0-
-     &        ((zi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-         sslipi=sscalelip(fracinbuf)
-         ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
-        elseif (zi.gt.bufliptop) then
-         fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
-         sslipi=sscalelip(fracinbuf)
-         ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
-        else
-         sslipi=1.0d0
-         ssgradlipi=0.0
-        endif
-       else
-         sslipi=0.0d0
-         ssgradlipi=0.0
-       endif
-
+        call to_box(xi,yi,zi)
+        call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
         dxi=dc_norm(1,nres+i)
         dyi=dc_norm(2,nres+i)
         dzi=dc_norm(3,nres+i)
@@ -1214,80 +1210,15 @@ c           alf12=0.0D0
             yj=c(2,nres+j)
             zj=c(3,nres+j)
 C returning jth atom to box
-          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
-       if ((zj.gt.bordlipbot)
-     &.and.(zj.lt.bordliptop)) then
-C the energy transfer exist
-        if (zj.lt.buflipbot) then
-C what fraction I am in
-         fracinbuf=1.0d0-
-     &        ((zj-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-         sslipj=sscalelip(fracinbuf)
-         ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
-        elseif (zj.gt.bufliptop) then
-         fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
-         sslipj=sscalelip(fracinbuf)
-         ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
-        else
-         sslipj=1.0d0
-         ssgradlipj=0.0
-        endif
-       else
-         sslipj=0.0d0
-         ssgradlipj=0.0
-       endif
-      aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
-     &  +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-      bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
-     &  +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-C       if (aa.ne.aa_aq(itypi,itypj)) then
-       
-C      write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
-C     & bb_aq(itypi,itypj)-bb,
-C     & sslipi,sslipj
-C         endif
-
-C        write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
-C checking the distance
-      dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
-      xj_safe=xj
-      yj_safe=yj
-      zj_safe=zj
-      subchap=0
-C finding the closest
-      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
-
+            call to_box(xj,yj,zj)
+            call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+            aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+     &        +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+            bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+     &        +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
             dxj=dc_norm(1,nres+j)
             dyj=dc_norm(2,nres+j)
             dzj=dc_norm(3,nres+j)
@@ -1413,6 +1344,8 @@ c      if (icall.gt.0) lprn=.true.
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
+        call to_box(xi,yi,zi)
+        call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
         dxi=dc_norm(1,nres+i)
         dyi=dc_norm(2,nres+i)
         dzi=dc_norm(3,nres+i)
@@ -1447,9 +1380,21 @@ c           chip12=0.0D0
 c           alf1=0.0D0
 c           alf2=0.0D0
 c           alf12=0.0D0
-            xj=c(1,nres+j)-xi
-            yj=c(2,nres+j)-yi
-            zj=c(3,nres+j)-zi
+            xj=c(1,nres+j)
+            yj=c(2,nres+j)
+            zj=c(3,nres+j)
+            call to_box(xj,yj,zj)
+            call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+            aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+     &        +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+            bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+     &        +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+C      if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
+C     &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
+C      write(iout,*) "tu,", i,j,aa,bb,aa_lip(itypi,itypj),sslipi,sslipj
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
             dxj=dc_norm(1,nres+j)
             dyj=dc_norm(2,nres+j)
             dzj=dc_norm(3,nres+j)
@@ -2271,12 +2216,7 @@ c        end if
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
-          xmedi=mod(xmedi,boxxsize)
-          if (xmedi.lt.0) xmedi=xmedi+boxxsize
-          ymedi=mod(ymedi,boxysize)
-          if (ymedi.lt.0) ymedi=ymedi+boxysize
-          zmedi=mod(zmedi,boxzsize)
-          if (zmedi.lt.0) zmedi=zmedi+boxzsize
+        call to_box(xmedi,ymedi,zmedi)
         num_conti=0
         call eelecij(i,i+2,ees,evdw1,eel_loc)
         if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
@@ -2306,37 +2246,7 @@ c     &    .or. itype(i-1).eq.ntyp1
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
-C Return atom into box, boxxsize is size of box in x dimension
-c  194   continue
-c        if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
-c        if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
-C Condition for being inside the proper box
-c        if ((xmedi.gt.((0.5d0)*boxxsize)).or.
-c     &       (xmedi.lt.((-0.5d0)*boxxsize))) then
-c        go to 194
-c        endif
-c  195   continue
-c        if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
-c        if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
-C Condition for being inside the proper box
-c        if ((ymedi.gt.((0.5d0)*boxysize)).or.
-c     &       (ymedi.lt.((-0.5d0)*boxysize))) then
-c        go to 195
-c        endif
-c  196   continue
-c        if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
-c        if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
-C Condition for being inside the proper box
-c        if ((zmedi.gt.((0.5d0)*boxzsize)).or.
-c     &       (zmedi.lt.((-0.5d0)*boxzsize))) then
-c        go to 196
-c        endif
-          xmedi=mod(xmedi,boxxsize)
-          if (xmedi.lt.0) xmedi=xmedi+boxxsize
-          ymedi=mod(ymedi,boxysize)
-          if (ymedi.lt.0) ymedi=ymedi+boxysize
-          zmedi=mod(zmedi,boxzsize)
-          if (zmedi.lt.0) zmedi=zmedi+boxzsize
+        call to_box(xmedi,ymedi,zmedi)
 #ifdef FOURBODY
         num_conti=num_cont_hb(i)
 #endif
@@ -2376,43 +2286,7 @@ c     &  .or. itype(i-1).eq.ntyp1
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
-          xmedi=mod(xmedi,boxxsize)
-          if (xmedi.lt.0) xmedi=xmedi+boxxsize
-          ymedi=mod(ymedi,boxysize)
-          if (ymedi.lt.0) ymedi=ymedi+boxysize
-          zmedi=mod(zmedi,boxzsize)
-          if (zmedi.lt.0) zmedi=zmedi+boxzsize
-C          xmedi=xmedi+xshift*boxxsize
-C          ymedi=ymedi+yshift*boxysize
-C          zmedi=zmedi+zshift*boxzsize
-
-C Return tom into box, boxxsize is size of box in x dimension
-c  164   continue
-c        if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
-c        if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
-C Condition for being inside the proper box
-c        if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
-c     &       (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
-c        go to 164
-c        endif
-c  165   continue
-c        if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
-c        if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
-C Condition for being inside the proper box
-c        if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
-c     &       (ymedi.lt.((yshift-0.5d0)*boxysize))) then
-c        go to 165
-c        endif
-c  166   continue
-c        if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
-c        if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
-cC Condition for being inside the proper box
-c        if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
-c     &       (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
-c        go to 166
-c        endif
-
-c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
+        call to_box(xmedi,ymedi,zmedi)
 #ifdef FOURBODY
         num_conti=num_cont_hb(i)
 #endif
@@ -2518,73 +2392,10 @@ C          zj=c(3,j)+0.5D0*dzj-zmedi
           xj=c(1,j)+0.5D0*dxj
           yj=c(2,j)+0.5D0*dyj
           zj=c(3,j)+0.5D0*dzj
-          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
-          if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
-      dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
-      xj_safe=xj
-      yj_safe=yj
-      zj_safe=zj
-      isubchap=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-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
-          if(dist_temp.lt.dist_init) then
-            dist_init=dist_temp
-            xj_temp=xj
-            yj_temp=yj
-            zj_temp=zj
-            isubchap=1
-          endif
-       enddo
-       enddo
-       enddo
-       if (isubchap.eq.1) then
-          xj=xj_temp-xmedi
-          yj=yj_temp-ymedi
-          zj=zj_temp-zmedi
-       else
-          xj=xj_safe-xmedi
-          yj=yj_safe-ymedi
-          zj=zj_safe-zmedi
-       endif
-C        if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
-c  174   continue
-c        if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
-c        if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
-C Condition for being inside the proper box
-c        if ((xj.gt.((0.5d0)*boxxsize)).or.
-c     &       (xj.lt.((-0.5d0)*boxxsize))) then
-c        go to 174
-c        endif
-c  175   continue
-c        if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
-c        if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
-C Condition for being inside the proper box
-c        if ((yj.gt.((0.5d0)*boxysize)).or.
-c     &       (yj.lt.((-0.5d0)*boxysize))) then
-c        go to 175
-c        endif
-c  176   continue
-c        if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
-c        if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
-C Condition for being inside the proper box
-c        if ((zj.gt.((0.5d0)*boxzsize)).or.
-c     &       (zj.lt.((-0.5d0)*boxzsize))) then
-c        go to 176
-c        endif
-C        endif !endPBC condintion
-C        xj=xj-xmedi
-C        yj=yj-ymedi
-C        zj=zj-zmedi
+          call to_box(xj,yj,zj)
+          xj=boxshift(xj-xmedi,boxxsize)
+          yj=boxshift(yj-ymedi,boxysize)
+          zj=boxshift(zj-zmedi,boxzsize)
           rij=xj*xj+yj*yj+zj*zj
 
           sss=sscale(sqrt(rij))
@@ -4075,13 +3886,7 @@ c     &   " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
         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))
-C Returning the ith atom to box
-          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
+        call to_box(xi,yi,zi)
         do iint=1,nscp_gr(i)
 
         do j=iscpstart(i,iint),iscpend(i,iint)
@@ -4096,44 +3901,10 @@ C Uncomment following three lines for Ca-p interactions
           yj=c(2,j)
           zj=c(3,j)
 C returning the jth atom to box
-          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
-C Finding the closest jth atom
-      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
+          call to_box(xj,yj,zj)
+          xj=boxshift(xj-xi,boxxsize)
+          yj=boxshift(yj-yi,boxysize)
+          zj=boxshift(zj-zi,boxzsize)
           rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
 C sss is scaling function for smoothing the cutoff gradient otherwise
 C the gradient would not be continuouse
index 67b4bb9..bf255c9 100644 (file)
@@ -5,11 +5,11 @@
      & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2,
      & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2,
      & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder,
-     & dsci_inv,dscj_inv,gg
+     & dsci_inv,dscj_inv,gg,gg_lipi,gg_lipj
       common /calc/ erij(3),rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj,
      & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12,
      & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1,
      & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2,
      & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2,
      & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder,
-     & dsci_inv,dscj_inv,gg(3),i,j
+     & dsci_inv,dscj_inv,gg(3),gg_lipi(3),gg_lipj(3),i,j
index f0b6122..6e5b5d5 100644 (file)
@@ -17,8 +17,9 @@ C 12/26/95 - H-bonding contacts
      &  facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
      &  ees0m(maxconts,maxres),d_cont(maxconts,maxres),
      &  num_cont_hb(maxres),jcont_hb(maxconts,maxres)
-C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole 
-C         interactions     
+      double precision a_chuj,a_chuj_der
+      common /dipmat/ a_chuj(2,2,maxconts,maxres),
+     &  a_chuj_der(2,2,3,5,maxconts,maxres)
 c 7/25/08 Commented out; not needed when cumulants used
 C Interactions of pseudo-dipoles generated by loc-el interactions.
 c      double precision dip,dipderg,dipderx
index 5f154e0..ae25625 100644 (file)
@@ -30,9 +30,6 @@ C consecutive amino-acid residues.
      &  costab2(maxres),sintab2(maxres)
 C This common block contains dipole-interaction matrices and their 
 C Cartesian derivatives.
-      double precision a_chuj,a_chuj_der
-      common /dipmat/ a_chuj(2,2,maxconts,maxres),
-     &  a_chuj_der(2,2,3,5,maxconts,maxres)
       double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx,
      &  ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx,
      &  AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont,EAEA,EAEAderg,EAEAderx,
index b694524..07bafe4 100644 (file)
@@ -15,7 +15,9 @@
      & gdfad,gdfat,gdfan,gdfab
       integer nfl,icg
       logical calc_grad
-      common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres),
+c      common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres),
+c 3/12/20 Adam:  Arrays dcdv, dxdv, and dxds removed following recoding of gradient.
+      common /derivat/
      & gradx(3,-1:maxres,2),gradc(3,-1:maxres,2),gvdwx(3,-1:maxres),
      & gvdwc(3,-1:maxres),gelc(3,-1:maxres),gelc_long(3,-1:maxres),
      & gvdwpp(3,-1:maxres),gvdwc_scpp(3,-1:maxres),
index 7facbfe..a313d8f 100644 (file)
@@ -1,20 +1,22 @@
       double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss
-      integer ns,nss,nfree,iss
+      integer ns,nss,nfree,iss,icys
       common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,
-     & ns,nss,nfree,iss(maxss)
+     & ns,nss,nfree,iss(maxss),icys(maxres)
       double precision dhpb,dhpb1,forcon,fordepth,xlscore,wboltzd,
      & dhpb_peak,dhpb1_peak,forcon_peak,fordepth_peak,scal_peak,bfac
       integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb,ibecarb_peak,npeak,
      & ipeak,irestr_type,irestr_type_peak,ihpb_peak,jhpb_peak,nhpb_peak
       logical restr_on_coord
-      common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim),
-     & fordepth(maxdim),bfac(maxres),xlscore(maxdim),wboltzd,
-     & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),irestr_type(maxdim),
+      common /links/ dhpb(maxdim_cont),dhpb1(maxdim_cont),
+     & forcon(maxdim_cont),fordepth(maxdim_cont),bfac(maxres),
+     & xlscore(maxdim_cont),wboltzd,ihpb(maxdim_cont),jhpb(maxdim_cont),
+     & ibecarb(maxdim_cont),irestr_type(maxdim_cont),
      & nhpb,restr_on_coord
-      common /NMRpeaks/ dhpb_peak(maxdim),dhpb1_peak(maxdim),
-     & forcon_peak(maxdim),fordepth_peak(maxdim),scal_peak,
-     & ihpb_peak(maxdim),jhpb_peak(maxdim),ibecarb_peak(maxdim),
-     & irestr_type_peak(maxdim),ipeak(2,maxdim),npeak,nhpb_peak
+      common /NMRpeaks/ dhpb_peak(maxdim_cont),dhpb1_peak(maxdim_cont),
+     & forcon_peak(maxdim_cont),fordepth_peak(maxdim_cont),scal_peak,
+     & ihpb_peak(maxdim_cont),jhpb_peak(maxdim_cont),
+     & ibecarb_peak(maxdim_cont),irestr_type_peak(maxdim_cont),
+     & ipeak(2,maxdim_cont),npeak,nhpb_peak
       double precision weidis
       common /restraints/ weidis
       integer link_start,link_end,link_start_peak,link_end_peak
@@ -23,7 +25,7 @@
       double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss
       logical dyn_ss,dyn_ss_mask
       common /dyn_ssbond/ dtriss,atriss,btriss,ctriss,Ht,
-     &  dyn_ssbond_ij(maxres,maxres),
-     &  idssb(maxdim),jdssb(maxdim)
+     &  dyn_ssbond_ij(max_cyst,max_cyst),
+     &  idssb(maxss),jdssb(maxss)
       common /dyn_ss_logic/
      &  dyn_ss,dyn_ss_mask(maxres)
index baf3aa2..a2281e5 100644 (file)
@@ -183,7 +183,7 @@ C Initialize the bridge arrays
       do i=1,maxss
        iss(i)=0
       enddo
-      do i=1,maxdim
+      do i=1,maxdim_cont
        dhpb(i)=0.0D0
       enddo
       do i=1,maxres
@@ -396,7 +396,7 @@ c---------------------------------------------------------------------------
       include 'COMMON.IOUNITS'
       include "COMMON.TORCNSTR"
       logical scheck,lprint
-      lprint=.false.
+      lprint=.true.
       do i=1,maxres
         nint_gr(i)=0
         nscp_gr(i)=0
index 878e4dd..e1a64f3 100644 (file)
@@ -79,7 +79,7 @@ C Convert sequence to numeric code
         chain_border1(1,i)=chain_border(1,i)-1
         chain_border1(2,i)=chain_border(2,i)+1
       enddo
-      chain_border1(1,nchain)=chain_border(1,nchain)-1
+      if (nchain.gt.1) chain_border1(1,nchain)=chain_border(1,nchain)-1
       chain_border1(2,nchain)=nres
       write(iout,*) "nres",nres," nchain",nchain
       do i=1,nchain
@@ -260,6 +260,7 @@ c       call flush(iout)
       endif
 
       call setup_var
+      write (iout,*) "Calling init_int_table"
       call init_int_table
       if (ns.gt.0) then
         write (iout,'(/a,i3,a)') 'The chain contains',ns,
@@ -332,6 +333,12 @@ C Read bridging residues.
       read (inp,*) ns,(iss(i),i=1,ns)
       print *,'ns=',ns
       write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns)
+c 5/24/2020 Adam: Added a table to translate residue numbers to cysteine
+c     numbers
+      icys=0
+      do i=1,ns
+        icys(iss(i))=i
+      enddo
 C Check whether the specified bridging residues are cystines.
       do i=1,ns
        if (itype(iss(i)).ne.1) then
index ecf40a7..b21acb2 100644 (file)
@@ -102,8 +102,8 @@ c
       V2SS = 7.61d0
       V3SS = 13.7d0
 
-      do i=1,maxres-1
-        do j=i+1,maxres
+      do i=1,max_cyst-1
+        do j=i+1,max_cyst
           dyn_ssbond_ij(i,j)=1.0d300
         enddo
       enddo
index 6f4ba5f..9efc6db 100644 (file)
@@ -70,7 +70,7 @@ C geometry.
           sccalc=.true.
         endif
 ! Read free energy
-        if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp
+c        if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp
 ! Fish out the ATOM cards.
         if (index(card(1:4),'ATOM').gt.0) then  
           sccalc=.false.
index e7effcd..bca3771 100644 (file)
@@ -95,6 +95,8 @@
 c Cutoff range for interactions
       call reada(controlcard,"R_CUT",r_cut,25.0d0)
       call reada(controlcard,"LAMBDA",rlamb,0.3d0)
+      write (iout,*) "Cutoff on interactions",r_cut
+      write (iout,*) "lambda",rlamb
       call reada(controlcard,"LIPTHICK",lipthick,0.0d0)
       call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0)
       unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0
index ba32ff0..4ce1b3d 100644 (file)
@@ -82,12 +82,10 @@ ct           rij=ran_number(rmin,rmax)
       end
 
 C-----------------------------------------------------------------------------
-
       subroutine dyn_ssbond_ene(resi,resj,eij)
-c      implicit none
-
-c     Includes
+      implicit none
       include 'DIMENSIONS'
+      include 'DIMENSIONS.ZSCOPT'
       include 'COMMON.SBRIDGE'
       include 'COMMON.CHAIN'
       include 'COMMON.DERIV'
@@ -96,9 +94,10 @@ c     Includes
       include 'COMMON.VAR'
       include 'COMMON.IOUNITS'
       include 'COMMON.CALC'
+      include 'COMMON.NAMES'
 #ifndef CLUST
 #ifndef WHAM
-C      include 'COMMON.MD'
+      include 'COMMON.MD'
 #endif
 #endif
 
@@ -128,6 +127,10 @@ c      integer itypi,itypj,k,l
       double precision omega,delta_inv,deltasq_inv,fac1,fac2
 c-------FIRST METHOD
       double precision xm,d_xm(1:3)
+      double precision sslipi,sslipj,ssgradlipi,ssgradlipj
+      integer ici,icj,itypi,itypj
+      double precision boxshift,sscale,sscagrad
+      double precision aa,bb
 c-------END FIRST METHOD
 c-------SECOND METHOD
 c$$$      double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
@@ -138,13 +141,21 @@ c-------TESTING CODE
       common /sschecks/ checkstop,transgrad
 
       integer icheck,nicheck,jcheck,njcheck
-      double precision echeck(-1:1),deps,ssx0,ljx0
+      double precision echeck(-1:1),deps,ssx0,ljx0,xi,yi,zi
 c-------END TESTING CODE
 
 
       i=resi
       j=resj
-
+      ici=icys(i)
+      icj=icys(j)
+      if (ici.eq.0 .or. icj.eq.0) then
+        write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') 
+     &  "Attempt to create",
+     &  " a disulfide link between non-cysteine residues ",restyp(i),i,
+     &  restyp(j),j
+        stop
+      endif
       itypi=itype(i)
       dxi=dc_norm(1,nres+i)
       dyi=dc_norm(2,nres+i)
@@ -153,73 +164,27 @@ c-------END TESTING CODE
       xi=c(1,nres+i)
       yi=c(2,nres+i)
       zi=c(3,nres+i)
-          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
-       if ((zi.gt.bordlipbot)
-     &.and.(zi.lt.bordliptop)) then
-C the energy transfer exist
-        if (zi.lt.buflipbot) then
-C what fraction I am in
-         fracinbuf=1.0d0-
-     &        ((zi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-         sslipi=sscalelip(fracinbuf)
-         ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
-        elseif (zi.gt.bufliptop) then
-         fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
-         sslipi=sscalelip(fracinbuf)
-         ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
-        else
-         sslipi=1.0d0
-         ssgradlipi=0.0
-        endif
-       else
-         sslipi=0.0d0
-         ssgradlipi=0.0
-       endif
+      call to_box(xi,yi,zi)
+C define scaling factor for lipids
+
+C        if (positi.le.0) positi=positi+boxzsize
+C        print *,i
+C first for peptide groups
+c for each residue check if it is in lipid or lipid water border area
+      call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
       itypj=itype(j)
       xj=c(1,nres+j)
       yj=c(2,nres+j)
       zj=c(3,nres+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
-       if ((zj.gt.bordlipbot)
-     &.and.(zj.lt.bordliptop)) then
-C the energy transfer exist
-        if (zj.lt.buflipbot) then
-C what fraction I am in
-         fracinbuf=1.0d0-
-     &        ((zj-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-         sslipj=sscalelip(fracinbuf)
-         ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
-        elseif (zj.gt.bufliptop) then
-         fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
-         sslipj=sscalelip(fracinbuf)
-         ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
-        else
-         sslipj=1.0d0
-         ssgradlipj=0.0
-        endif
-       else
-         sslipj=0.0d0
-         ssgradlipj=0.0
-       endif
+      call to_box(xj,yj,zj)
+      call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
       aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
-     &  +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+     &  +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
       bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
-     &  +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-      xj=xj-xi
-      yj=yj-yi
-      zj=zj-zi
+     &  +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
+      xj=boxshift(xj-xi,boxxsize)
+      yj=boxshift(yj-yi,boxysize)
+      zj=boxshift(zj-zi,boxzsize)
       dxj=dc_norm(1,nres+j)
       dyj=dc_norm(2,nres+j)
       dzj=dc_norm(3,nres+j)
@@ -237,6 +202,8 @@ C lipbufthick is thickenes of lipid buffore
 
       rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
       rij=dsqrt(rrij)  ! sc_angular needs rij to really be the inverse
+            sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
+            sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
 c     The following are set in sc_angular
 c      erij(1)=xj*rij
 c      erij(2)=yj*rij
@@ -316,15 +283,15 @@ c-------END TESTING CODE
         e1=fac*fac*aa
         e2=fac*bb
         eij=eps1*eps2rt*eps3rt*(e1+e2)
-C        write(iout,*) eij,'TU?1'
         eps2der=eij*eps3rt
         eps3der=eij*eps2rt
-        eij=eij*eps2rt*eps3rt
+        eij=eij*eps2rt*eps3rt*sss
 
         sigder=-sig/sigsq
         e1=e1*eps1*eps2rt**2*eps3rt**2
         ed=-expon*(e1+eij)/ljd
         sigder=ed*sigder
+        ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij
         eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
         eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
         eom12=eij*eps1_om12+eps2der*eps2rt_om12
@@ -333,8 +300,9 @@ C        write(iout,*) eij,'TU?1'
         havebond=.true.
         ssd=rij-ssXs
         eij=ssA*ssd*ssd+ssB*ssd+ssC
-C        write(iout,*) 'TU?2',ssc,ssd
+        eij=eij*sss        
         ed=2*akcm*ssd+akct*deltat12
+        ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij
         pom1=akct*ssd
         pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
         eom1=-2*akth*deltat1-pom1-om2*pom2
@@ -369,13 +337,14 @@ c-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
           h1=h_base(f1,hd1)
           h2=h_base(f2,hd2)
           eij=ssm*h1+Ht*h2
-C         write(iout,*) eij,'TU?3'
           delta_inv=1.0d0/(xm-ssxm)
           deltasq_inv=delta_inv*delta_inv
           fac=ssm*hd1-Ht*hd2
           fac1=deltasq_inv*fac*(xm-rij)
           fac2=deltasq_inv*fac*(rij-ssxm)
           ed=delta_inv*(Ht*hd2-ssm*hd1)
+          eij=eij*sss
+          ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij
           eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
           eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
           eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
@@ -392,13 +361,14 @@ C         write(iout,*) eij,'TU?3'
           h1=h_base(f1,hd1)
           h2=h_base(f2,hd2)
           eij=Ht*h1+ljm*h2
-C        write(iout,*) 'TU?4',ssA
           delta_inv=1.0d0/(ljxm-xm)
           deltasq_inv=delta_inv*delta_inv
           fac=Ht*hd1-ljm*hd2
           fac1=deltasq_inv*fac*(ljxm-rij)
           fac2=deltasq_inv*fac*(rij-xm)
           ed=delta_inv*(ljm*hd2-Ht*hd1)
+          eij=eij*sss
+          ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij
           eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
           eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
           eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
@@ -464,7 +434,7 @@ c$$$        if (ed.gt.0.0d0) havebond=.true.
 c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
 
       endif
-      write(iout,*) 'havebond',havebond
+
       if (havebond) then
 #ifndef CLUST
 #ifndef WHAM
@@ -474,9 +444,10 @@ c     &         "SSBOND_E_FORM",totT,t_bath,i,j
 c        endif
 #endif
 #endif
-        dyn_ssbond_ij(i,j)=eij
-      else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
-        dyn_ssbond_ij(i,j)=1.0d300
+        dyn_ssbond_ij(ici,icj)=eij
+      else if (.not.havebond .and. dyn_ssbond_ij(ici,icj).lt.1.0d300) 
+     &then
+        dyn_ssbond_ij(ici,icj)=1.0d300
 #ifndef CLUST
 #ifndef WHAM
 c        write(iout,'(a15,f12.2,f8.1,2i5)')
@@ -501,6 +472,8 @@ c-------TESTING CODE
         checkstop=.false.
       endif
 c-------END TESTING CODE
+            gg_lipi(3)=ssgradlipi*eij
+            gg_lipj(3)=ssgradlipj*eij
 
       do k=1,3
         dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
@@ -510,10 +483,10 @@ c-------END TESTING CODE
         gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
       enddo
       do k=1,3
-        gvdwx(k,i)=gvdwx(k,i)-gg(k)
+        gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
      &       +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
      &       +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
-        gvdwx(k,j)=gvdwx(k,j)+gg(k)
+        gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
      &       +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
      &       +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
       enddo
@@ -524,13 +497,12 @@ cgrad        enddo
 cgrad      enddo
 
       do l=1,3
-        gvdwc(l,i)=gvdwc(l,i)-gg(l)
-        gvdwc(l,j)=gvdwc(l,j)+gg(l)
+        gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(k)
+        gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(k)
       enddo
 
       return
       end
-
 C-----------------------------------------------------------------------------
 
       double precision function h_base(x,deriv)
@@ -571,9 +543,7 @@ c$$$      deriv=30.0d0*xsq*deriv
 
       return
       end
-
 c----------------------------------------------------------------------------
-
       subroutine dyn_set_nss
 c     Adjust nss and other relevant variables based on dyn_ssbond_ij
 c      implicit none
@@ -596,16 +566,16 @@ C      include 'COMMON.MD'
 c     Local variables
       double precision emin
       integer i,j,imin
-      integer diff,allflag(maxdim),allnss,
-     &     allihpb(maxdim),alljhpb(maxdim),
-     &     newnss,newihpb(maxdim),newjhpb(maxdim)
+      integer diff,allflag(maxdim_cont),allnss,
+     &     allihpb(maxdim_cont),alljhpb(maxdim_cont),
+     &     newnss,newihpb(maxdim_cont),newjhpb(maxdim_cont)
       logical found
       integer i_newnss(1024),displ(0:1024)
-      integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss
+      integer g_newihpb(maxdim_cont),g_newjhpb(maxdim_cont),g_newnss
 
       allnss=0
-      do i=1,nres-1
-        do j=i+1,nres
+      do i=1,ns-1
+        do j=i+1,ns
           if (dyn_ssbond_ij(i,j).lt.1.0d300) then
             allnss=allnss+1
             allflag(allnss)=0
@@ -749,1277 +719,8 @@ c     Local variables
       end
 #endif
 #endif
-c----------------------------------------------------------------------------
-
-
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-
-c$$$c-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine ss_relax(i_in,j_in)
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.INTERACT'
-c$$$
-c$$$c     Input arguments
-c$$$      integer i_in,j_in
-c$$$
-c$$$c     Local variables
-c$$$      integer i,iretcode,nfun_sc
-c$$$      logical scfail
-c$$$      double precision var(maxvar),e_sc,etot
-c$$$
-c$$$
-c$$$      mask_r=.true.
-c$$$      do i=nnt,nct
-c$$$        mask_side(i)=0
-c$$$      enddo
-c$$$      mask_side(i_in)=1
-c$$$      mask_side(j_in)=1
-c$$$
-c$$$c     Minimize the two selected side-chains
-c$$$      call overlap_sc(scfail)  ! Better not fail!
-c$$$      call minimize_sc(e_sc,var,iretcode,nfun_sc)
-c$$$
-c$$$      mask_r=.false.
-c$$$
-c$$$      return
-c$$$      end
-c$$$
-c$$$c-------------------------------------------------------------
-c$$$
-c$$$      subroutine minimize_sc(etot_sc,iretcode,nfun)
-c$$$c     Minimize side-chains only, starting from geom but without modifying
-c$$$c     bond lengths.
-c$$$c     If mask_r is already set, only the selected side-chains are minimized,
-c$$$c     otherwise all side-chains are minimized keeping the backbone frozen.
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.GEO'
-c$$$      include 'COMMON.MINIM'
-c$$$      integer icall
-c$$$      common /srutu/ icall
-c$$$
-c$$$c     Output arguments
-c$$$      double precision etot_sc
-c$$$      integer iretcode,nfun
-c$$$
-c$$$c     External functions/subroutines
-c$$$      external func_sc,grad_sc,fdum
-c$$$
-c$$$c     Local variables
-c$$$      integer liv,lv
-c$$$      parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) 
-c$$$      integer iv(liv)
-c$$$      double precision rdum(1)
-c$$$      double precision d(maxvar),v(1:lv),x(maxvar),xx(maxvar)
-c$$$      integer idum(1)
-c$$$      integer i,nvar_restr
-c$$$
-c$$$
-c$$$cmc      start_minim=.true.
-c$$$      call deflt(2,iv,liv,lv,v)                                         
-c$$$* 12 means fresh start, dont call deflt                                 
-c$$$      iv(1)=12                                                          
-c$$$* max num of fun calls                                                  
-c$$$      if (maxfun.eq.0) maxfun=500
-c$$$      iv(17)=maxfun
-c$$$* max num of iterations                                                 
-c$$$      if (maxmin.eq.0) maxmin=1000
-c$$$      iv(18)=maxmin
-c$$$* controls output                                                       
-c$$$      iv(19)=1
-c$$$* selects output unit                                                   
-c$$$      iv(21)=0
-c$$$c      iv(21)=iout               ! DEBUG
-c$$$c      iv(21)=8                  ! DEBUG
-c$$$* 1 means to print out result                                           
-c$$$      iv(22)=0
-c$$$c      iv(22)=1                  ! DEBUG
-c$$$* 1 means to print out summary stats                                    
-c$$$      iv(23)=0                                                          
-c$$$c      iv(23)=1                  ! DEBUG
-c$$$* 1 means to print initial x and d                                      
-c$$$      iv(24)=0                                                          
-c$$$c      iv(24)=1                  ! DEBUG
-c$$$* min val for v(radfac) default is 0.1                                  
-c$$$      v(24)=0.1D0                                                       
-c$$$* max val for v(radfac) default is 4.0                                  
-c$$$      v(25)=2.0D0                                                       
-c$$$c     v(25)=4.0D0                                                       
-c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)    
-c$$$* the sumsl default is 0.1                                              
-c$$$      v(26)=0.1D0
-c$$$* false conv if (act fnctn decrease) .lt. v(34)                         
-c$$$* the sumsl default is 100*machep                                       
-c$$$      v(34)=v(34)/100.0D0                                               
-c$$$* absolute convergence                                                  
-c$$$      if (tolf.eq.0.0D0) tolf=1.0D-4
-c$$$      v(31)=tolf
-c$$$* relative convergence                                                  
-c$$$      if (rtolf.eq.0.0D0) rtolf=1.0D-1
-c$$$      v(32)=rtolf
-c$$$* controls initial step size                                            
-c$$$       v(35)=1.0D-1                                                    
-c$$$* large vals of d correspond to small components of step                
-c$$$      do i=1,nphi
-c$$$        d(i)=1.0D-1
-c$$$      enddo
-c$$$      do i=nphi+1,nvar
-c$$$        d(i)=1.0D-1
-c$$$      enddo
-c$$$
-c$$$      call geom_to_var(nvar,x)
-c$$$      IF (mask_r) THEN
-c$$$        do i=1,nres             ! Just in case...
-c$$$          mask_phi(i)=0
-c$$$          mask_theta(i)=0
-c$$$        enddo
-c$$$        call x2xx(x,xx,nvar_restr)
-c$$$        call sumsl(nvar_restr,d,xx,func_sc,grad_sc,
-c$$$     &       iv,liv,lv,v,idum,rdum,fdum)      
-c$$$        call xx2x(x,xx)
-c$$$      ELSE
-c$$$c     When minimizing ALL side-chains, etotal_sc is a little
-c$$$c     faster if we don't set mask_r
-c$$$        do i=1,nres
-c$$$          mask_phi(i)=0
-c$$$          mask_theta(i)=0
-c$$$          mask_side(i)=1
-c$$$        enddo
-c$$$        call x2xx(x,xx,nvar_restr)
-c$$$        call sumsl(nvar_restr,d,xx,func_sc,grad_sc,
-c$$$     &       iv,liv,lv,v,idum,rdum,fdum)      
-c$$$        call xx2x(x,xx)
-c$$$      ENDIF
-c$$$      call var_to_geom(nvar,x)
-c$$$      call chainbuild_sc
-c$$$      etot_sc=v(10)                                                      
-c$$$      iretcode=iv(1)
-c$$$      nfun=iv(6)
-c$$$      return  
-c$$$      end  
-c$$$
-c$$$C--------------------------------------------------------------------------
-c$$$
-c$$$      subroutine chainbuild_sc
-c$$$      implicit none
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.INTERACT'
-c$$$
-c$$$c     Local variables
-c$$$      integer i
-c$$$
-c$$$
-c$$$      do i=nnt,nct
-c$$$        if (.not.mask_r .or. mask_side(i).eq.1) then
-c$$$          call locate_side_chain(i)
-c$$$        endif
-c$$$      enddo
-c$$$
-c$$$      return
-c$$$      end
-c$$$
-c$$$C--------------------------------------------------------------------------
-c$$$
-c$$$      subroutine func_sc(n,x,nf,f,uiparm,urparm,ufparm)  
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.MINIM'
-c$$$      include 'COMMON.IOUNITS'
-c$$$
-c$$$c     Input arguments
-c$$$      integer n
-c$$$      double precision x(maxvar)
-c$$$      double precision ufparm
-c$$$      external ufparm
-c$$$
-c$$$c     Input/Output arguments
-c$$$      integer nf
-c$$$      integer uiparm(1)
-c$$$      double precision urparm(1)
-c$$$
-c$$$c     Output arguments
-c$$$      double precision f
-c$$$
-c$$$c     Local variables
-c$$$      double precision energia(0:n_ene)
-c$$$#ifdef OSF
-c$$$c     Variables used to intercept NaNs
-c$$$      double precision x_sum
-c$$$      integer i_NAN
-c$$$#endif
-c$$$
-c$$$
-c$$$      nfl=nf
-c$$$      icg=mod(nf,2)+1
-c$$$
-c$$$#ifdef OSF
-c$$$c     Intercept NaNs in the coordinates, before calling etotal_sc
-c$$$      x_sum=0.D0
-c$$$      do i_NAN=1,n
-c$$$        x_sum=x_sum+x(i_NAN)
-c$$$      enddo
-c$$$c     Calculate the energy only if the coordinates are ok
-c$$$      if ((.not.(x_sum.lt.0.D0)) .and. (.not.(x_sum.ge.0.D0))) then
-c$$$        write(iout,*)"   *** func_restr_sc : Found NaN in coordinates"
-c$$$        f=1.0D+77
-c$$$        nf=0
-c$$$      else
-c$$$#endif
-c$$$
-c$$$      call var_to_geom_restr(n,x)
-c$$$      call zerograd
-c$$$      call chainbuild_sc
-c$$$      call etotal_sc(energia(0))
-c$$$      f=energia(0)
-c$$$      if (energia(1).eq.1.0D20 .or. energia(0).eq.1.0D99) nf=0
-c$$$
-c$$$#ifdef OSF
-c$$$      endif
-c$$$#endif
-c$$$
-c$$$      return                                                            
-c$$$      end                                                               
-c$$$
-c$$$c-------------------------------------------------------
-c$$$
-c$$$      subroutine grad_sc(n,x,nf,g,uiparm,urparm,ufparm)
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.INTERACT'
-c$$$      include 'COMMON.MINIM'
-c$$$
-c$$$c     Input arguments
-c$$$      integer n
-c$$$      double precision x(maxvar)
-c$$$      double precision ufparm
-c$$$      external ufparm
-c$$$
-c$$$c     Input/Output arguments
-c$$$      integer nf
-c$$$      integer uiparm(1)
-c$$$      double precision urparm(1)
-c$$$
-c$$$c     Output arguments
-c$$$      double precision g(maxvar)
-c$$$
-c$$$c     Local variables
-c$$$      double precision f,gphii,gthetai,galphai,gomegai
-c$$$      integer ig,ind,i,j,k,igall,ij
-c$$$
-c$$$
-c$$$      icg=mod(nf,2)+1
-c$$$      if (nf-nfl+1) 20,30,40
-c$$$   20 call func_sc(n,x,nf,f,uiparm,urparm,ufparm)
-c$$$c     write (iout,*) 'grad 20'
-c$$$      if (nf.eq.0) return
-c$$$      goto 40
-c$$$   30 call var_to_geom_restr(n,x)
-c$$$      call chainbuild_sc
-c$$$C
-c$$$C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
-c$$$C
-c$$$   40 call cartder
-c$$$C
-c$$$C Convert the Cartesian gradient into internal-coordinate gradient.
-c$$$C
-c$$$
-c$$$      ig=0
-c$$$      ind=nres-2
-c$$$      do i=2,nres-2
-c$$$       IF (mask_phi(i+2).eq.1) THEN
-c$$$        gphii=0.0D0
-c$$$        do j=i+1,nres-1
-c$$$          ind=ind+1
-c$$$          do k=1,3
-c$$$            gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
-c$$$            gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
-c$$$          enddo
-c$$$        enddo
-c$$$        ig=ig+1
-c$$$        g(ig)=gphii
-c$$$       ELSE
-c$$$        ind=ind+nres-1-i
-c$$$       ENDIF
-c$$$      enddo                                        
-c$$$
-c$$$
-c$$$      ind=0
-c$$$      do i=1,nres-2
-c$$$       IF (mask_theta(i+2).eq.1) THEN
-c$$$        ig=ig+1
-c$$$   gthetai=0.0D0
-c$$$   do j=i+1,nres-1
-c$$$          ind=ind+1
-c$$$     do k=1,3
-c$$$            gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
-c$$$            gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
-c$$$          enddo
-c$$$        enddo
-c$$$        g(ig)=gthetai
-c$$$       ELSE
-c$$$        ind=ind+nres-1-i
-c$$$       ENDIF
-c$$$      enddo
-c$$$
-c$$$      do i=2,nres-1
-c$$$   if (itype(i).ne.10) then
-c$$$         IF (mask_side(i).eq.1) THEN
-c$$$          ig=ig+1
-c$$$          galphai=0.0D0
-c$$$     do k=1,3
-c$$$       galphai=galphai+dxds(k,i)*gradx(k,i,icg)
-c$$$          enddo
-c$$$          g(ig)=galphai
-c$$$         ENDIF
-c$$$        endif
-c$$$      enddo
-c$$$
-c$$$      
-c$$$      do i=2,nres-1
-c$$$        if (itype(i).ne.10) then
-c$$$         IF (mask_side(i).eq.1) THEN
-c$$$          ig=ig+1
-c$$$     gomegai=0.0D0
-c$$$     do k=1,3
-c$$$       gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
-c$$$          enddo
-c$$$     g(ig)=gomegai
-c$$$         ENDIF
-c$$$        endif
-c$$$      enddo
-c$$$
-c$$$C
-c$$$C Add the components corresponding to local energy terms.
-c$$$C
-c$$$
-c$$$      ig=0
-c$$$      igall=0
-c$$$      do i=4,nres
-c$$$        igall=igall+1
-c$$$        if (mask_phi(i).eq.1) then
-c$$$          ig=ig+1
-c$$$          g(ig)=g(ig)+gloc(igall,icg)
-c$$$        endif
-c$$$      enddo
-c$$$
-c$$$      do i=3,nres
-c$$$        igall=igall+1
-c$$$        if (mask_theta(i).eq.1) then
-c$$$          ig=ig+1
-c$$$          g(ig)=g(ig)+gloc(igall,icg)
-c$$$        endif
-c$$$      enddo
-c$$$     
-c$$$      do ij=1,2
-c$$$      do i=2,nres-1
-c$$$        if (itype(i).ne.10) then
-c$$$          igall=igall+1
-c$$$          if (mask_side(i).eq.1) then
-c$$$            ig=ig+1
-c$$$            g(ig)=g(ig)+gloc(igall,icg)
-c$$$          endif
-c$$$        endif
-c$$$      enddo
-c$$$      enddo
-c$$$
-c$$$cd      do i=1,ig
-c$$$cd        write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i)
-c$$$cd      enddo
-c$$$
-c$$$      return
-c$$$      end
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine etotal_sc(energy_sc)
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.INTERACT'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.FFIELD'
-c$$$
-c$$$c     Output arguments
-c$$$      double precision energy_sc(0:n_ene)
-c$$$
-c$$$c     Local variables
-c$$$      double precision evdw,escloc
-c$$$      integer i,j
-c$$$
-c$$$
-c$$$      do i=1,n_ene
-c$$$        energy_sc(i)=0.0D0
-c$$$      enddo
-c$$$
-c$$$      if (mask_r) then
-c$$$        call egb_sc(evdw)
-c$$$        call esc_sc(escloc)
-c$$$      else
-c$$$        call egb(evdw)
-c$$$        call esc(escloc)
-c$$$      endif
-c$$$
-c$$$      if (evdw.eq.1.0D20) then
-c$$$        energy_sc(0)=evdw
-c$$$      else
-c$$$        energy_sc(0)=wsc*evdw+wscloc*escloc
-c$$$      endif
-c$$$      energy_sc(1)=evdw
-c$$$      energy_sc(12)=escloc
-c$$$
-c$$$C
-c$$$C Sum up the components of the Cartesian gradient.
-c$$$C
-c$$$      do i=1,nct
-c$$$        do j=1,3
-c$$$          gradx(j,i,icg)=wsc*gvdwx(j,i)
-c$$$        enddo
-c$$$      enddo
-c$$$
-c$$$      return
-c$$$      end
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine egb_sc(evdw)
-c$$$C
-c$$$C This subroutine calculates the interaction energy of nonbonded side chains
-c$$$C assuming the Gay-Berne potential of interaction.
-c$$$C
-c$$$      implicit real*8 (a-h,o-z)
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.GEO'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.LOCAL'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.NAMES'
-c$$$      include 'COMMON.INTERACT'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.CALC'
-c$$$      include 'COMMON.CONTROL'
-c$$$      logical lprn
-c$$$      evdw=0.0D0
-c$$$      energy_dec=.false.
-c$$$c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
-c$$$      evdw=0.0D0
-c$$$      lprn=.false.
-c$$$c     if (icall.eq.0) lprn=.false.
-c$$$      ind=0
-c$$$      do i=iatsc_s,iatsc_e
-c$$$        itypi=itype(i)
-c$$$        itypi1=itype(i+1)
-c$$$        xi=c(1,nres+i)
-c$$$        yi=c(2,nres+i)
-c$$$        zi=c(3,nres+i)
-c$$$        dxi=dc_norm(1,nres+i)
-c$$$        dyi=dc_norm(2,nres+i)
-c$$$        dzi=dc_norm(3,nres+i)
-c$$$c        dsci_inv=dsc_inv(itypi)
-c$$$        dsci_inv=vbld_inv(i+nres)
-c$$$c        write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-c$$$c        write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-c$$$C
-c$$$C Calculate SC interaction energy.
-c$$$C
-c$$$        do iint=1,nint_gr(i)
-c$$$          do j=istart(i,iint),iend(i,iint)
-c$$$          IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN
-c$$$            ind=ind+1
-c$$$            itypj=itype(j)
-c$$$c            dscj_inv=dsc_inv(itypj)
-c$$$            dscj_inv=vbld_inv(j+nres)
-c$$$c            write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
-c$$$c     &       1.0d0/vbld(j+nres)
-c$$$c            write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
-c$$$            sig0ij=sigma(itypi,itypj)
-c$$$            chi1=chi(itypi,itypj)
-c$$$            chi2=chi(itypj,itypi)
-c$$$            chi12=chi1*chi2
-c$$$            chip1=chip(itypi)
-c$$$            chip2=chip(itypj)
-c$$$            chip12=chip1*chip2
-c$$$            alf1=alp(itypi)
-c$$$            alf2=alp(itypj)
-c$$$            alf12=0.5D0*(alf1+alf2)
-c$$$C For diagnostics only!!!
-c$$$c           chi1=0.0D0
-c$$$c           chi2=0.0D0
-c$$$c           chi12=0.0D0
-c$$$c           chip1=0.0D0
-c$$$c           chip2=0.0D0
-c$$$c           chip12=0.0D0
-c$$$c           alf1=0.0D0
-c$$$c           alf2=0.0D0
-c$$$c           alf12=0.0D0
-c$$$            xj=c(1,nres+j)-xi
-c$$$            yj=c(2,nres+j)-yi
-c$$$            zj=c(3,nres+j)-zi
-c$$$            dxj=dc_norm(1,nres+j)
-c$$$            dyj=dc_norm(2,nres+j)
-c$$$            dzj=dc_norm(3,nres+j)
-c$$$c            write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
-c$$$c            write (iout,*) "j",j," dc_norm",
-c$$$c     &       dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
-c$$$            rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-c$$$            rij=dsqrt(rrij)
-c$$$C Calculate angle-dependent terms of energy and contributions to their
-c$$$C derivatives.
-c$$$            call sc_angular
-c$$$            sigsq=1.0D0/sigsq
-c$$$            sig=sig0ij*dsqrt(sigsq)
-c$$$            rij_shift=1.0D0/rij-sig+sig0ij
-c$$$c for diagnostics; uncomment
-c$$$c            rij_shift=1.2*sig0ij
-c$$$C I hate to put IF's in the loops, but here don't have another choice!!!!
-c$$$            if (rij_shift.le.0.0D0) then
-c$$$              evdw=1.0D20
-c$$$cd              write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c$$$cd     &        restyp(itypi),i,restyp(itypj),j,
-c$$$cd     &        rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) 
-c$$$              return
-c$$$            endif
-c$$$            sigder=-sig*sigsq
-c$$$c---------------------------------------------------------------
-c$$$            rij_shift=1.0D0/rij_shift 
-c$$$            fac=rij_shift**expon
-c$$$            e1=fac*fac*aa(itypi,itypj)
-c$$$            e2=fac*bb(itypi,itypj)
-c$$$            evdwij=eps1*eps2rt*eps3rt*(e1+e2)
-c$$$            eps2der=evdwij*eps3rt
-c$$$            eps3der=evdwij*eps2rt
-c$$$c            write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-c$$$c     &        " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
-c$$$            evdwij=evdwij*eps2rt*eps3rt
-c$$$            evdw=evdw+evdwij
-c$$$            if (lprn) then
-c$$$            sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-c$$$            epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-c$$$            write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c$$$     &        restyp(itypi),i,restyp(itypj),j,
-c$$$     &        epsi,sigm,chi1,chi2,chip1,chip2,
-c$$$     &        eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
-c$$$     &        om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
-c$$$     &        evdwij
-c$$$            endif
-c$$$
-c$$$            if (energy_dec) write (iout,'(a6,2i,0pf7.3)') 
-c$$$     &                        'evdw',i,j,evdwij
-c$$$
-c$$$C Calculate gradient components.
-c$$$            e1=e1*eps1*eps2rt**2*eps3rt**2
-c$$$            fac=-expon*(e1+evdwij)*rij_shift
-c$$$            sigder=fac*sigder
-c$$$            fac=rij*fac
-c$$$c            fac=0.0d0
-c$$$C Calculate the radial part of the gradient
-c$$$            gg(1)=xj*fac
-c$$$            gg(2)=yj*fac
-c$$$            gg(3)=zj*fac
-c$$$C Calculate angular part of the gradient.
-c$$$            call sc_grad
-c$$$          ENDIF
-c$$$          enddo      ! j
-c$$$        enddo        ! iint
-c$$$      enddo          ! i
-c$$$      energy_dec=.false.
-c$$$      return
-c$$$      end
-c$$$
-c$$$c-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine esc_sc(escloc)
-c$$$C Calculate the local energy of a side chain and its derivatives in the
-c$$$C corresponding virtual-bond valence angles THETA and the spherical angles 
-c$$$C ALPHA and OMEGA.
-c$$$      implicit real*8 (a-h,o-z)
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.GEO'
-c$$$      include 'COMMON.LOCAL'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.INTERACT'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.NAMES'
-c$$$      include 'COMMON.FFIELD'
-c$$$      include 'COMMON.CONTROL'
-c$$$      double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
-c$$$     &     ddersc0(3),ddummy(3),xtemp(3),temp(3)
-c$$$      common /sccalc/ time11,time12,time112,theti,it,nlobit
-c$$$      delta=0.02d0*pi
-c$$$      escloc=0.0D0
-c$$$c     write (iout,'(a)') 'ESC'
-c$$$      do i=loc_start,loc_end
-c$$$      IF (mask_side(i).eq.1) THEN
-c$$$        it=itype(i)
-c$$$        if (it.eq.10) goto 1
-c$$$        nlobit=nlob(it)
-c$$$c       print *,'i=',i,' it=',it,' nlobit=',nlobit
-c$$$c       write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
-c$$$        theti=theta(i+1)-pipol
-c$$$        x(1)=dtan(theti)
-c$$$        x(2)=alph(i)
-c$$$        x(3)=omeg(i)
-c$$$
-c$$$        if (x(2).gt.pi-delta) then
-c$$$          xtemp(1)=x(1)
-c$$$          xtemp(2)=pi-delta
-c$$$          xtemp(3)=x(3)
-c$$$          call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
-c$$$          xtemp(2)=pi
-c$$$          call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
-c$$$          call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
-c$$$     &        escloci,dersc(2))
-c$$$          call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
-c$$$     &        ddersc0(1),dersc(1))
-c$$$          call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
-c$$$     &        ddersc0(3),dersc(3))
-c$$$          xtemp(2)=pi-delta
-c$$$          call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
-c$$$          xtemp(2)=pi
-c$$$          call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
-c$$$          call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
-c$$$     &            dersc0(2),esclocbi,dersc02)
-c$$$          call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
-c$$$     &            dersc12,dersc01)
-c$$$          call splinthet(x(2),0.5d0*delta,ss,ssd)
-c$$$          dersc0(1)=dersc01
-c$$$          dersc0(2)=dersc02
-c$$$          dersc0(3)=0.0d0
-c$$$          do k=1,3
-c$$$            dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
-c$$$          enddo
-c$$$          dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
-c$$$c         write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c$$$c    &             esclocbi,ss,ssd
-c$$$          escloci=ss*escloci+(1.0d0-ss)*esclocbi
-c$$$c         escloci=esclocbi
-c$$$c         write (iout,*) escloci
-c$$$        else if (x(2).lt.delta) then
-c$$$          xtemp(1)=x(1)
-c$$$          xtemp(2)=delta
-c$$$          xtemp(3)=x(3)
-c$$$          call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
-c$$$          xtemp(2)=0.0d0
-c$$$          call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
-c$$$          call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
-c$$$     &        escloci,dersc(2))
-c$$$          call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
-c$$$     &        ddersc0(1),dersc(1))
-c$$$          call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
-c$$$     &        ddersc0(3),dersc(3))
-c$$$          xtemp(2)=delta
-c$$$          call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
-c$$$          xtemp(2)=0.0d0
-c$$$          call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
-c$$$          call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
-c$$$     &            dersc0(2),esclocbi,dersc02)
-c$$$          call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
-c$$$     &            dersc12,dersc01)
-c$$$          dersc0(1)=dersc01
-c$$$          dersc0(2)=dersc02
-c$$$          dersc0(3)=0.0d0
-c$$$          call splinthet(x(2),0.5d0*delta,ss,ssd)
-c$$$          do k=1,3
-c$$$            dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
-c$$$          enddo
-c$$$          dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
-c$$$c         write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c$$$c    &             esclocbi,ss,ssd
-c$$$          escloci=ss*escloci+(1.0d0-ss)*esclocbi
-c$$$c         write (iout,*) escloci
-c$$$        else
-c$$$          call enesc(x,escloci,dersc,ddummy,.false.)
-c$$$        endif
-c$$$
-c$$$        escloc=escloc+escloci
-c$$$        if (energy_dec) write (iout,'(a6,i,0pf7.3)')
-c$$$     &     'escloc',i,escloci
-c$$$c       write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
-c$$$
-c$$$        gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
-c$$$     &   wscloc*dersc(1)
-c$$$        gloc(ialph(i,1),icg)=wscloc*dersc(2)
-c$$$        gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
-c$$$    1   continue
-c$$$      ENDIF
-c$$$      enddo
-c$$$      return
-c$$$      end
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine egb_ij(i_sc,j_sc,evdw)
-c$$$C
-c$$$C This subroutine calculates the interaction energy of nonbonded side chains
-c$$$C assuming the Gay-Berne potential of interaction.
-c$$$C
-c$$$      implicit real*8 (a-h,o-z)
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.GEO'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.LOCAL'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.NAMES'
-c$$$      include 'COMMON.INTERACT'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.CALC'
-c$$$      include 'COMMON.CONTROL'
-c$$$      logical lprn
-c$$$      evdw=0.0D0
-c$$$      energy_dec=.false.
-c$$$c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
-c$$$      evdw=0.0D0
-c$$$      lprn=.false.
-c$$$      ind=0
-c$$$c$$$      do i=iatsc_s,iatsc_e
-c$$$      i=i_sc
-c$$$        itypi=itype(i)
-c$$$        itypi1=itype(i+1)
-c$$$        xi=c(1,nres+i)
-c$$$        yi=c(2,nres+i)
-c$$$        zi=c(3,nres+i)
-c$$$        dxi=dc_norm(1,nres+i)
-c$$$        dyi=dc_norm(2,nres+i)
-c$$$        dzi=dc_norm(3,nres+i)
-c$$$c        dsci_inv=dsc_inv(itypi)
-c$$$        dsci_inv=vbld_inv(i+nres)
-c$$$c        write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-c$$$c        write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-c$$$C
-c$$$C Calculate SC interaction energy.
-c$$$C
-c$$$c$$$        do iint=1,nint_gr(i)
-c$$$c$$$          do j=istart(i,iint),iend(i,iint)
-c$$$        j=j_sc
-c$$$            ind=ind+1
-c$$$            itypj=itype(j)
-c$$$c            dscj_inv=dsc_inv(itypj)
-c$$$            dscj_inv=vbld_inv(j+nres)
-c$$$c            write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
-c$$$c     &       1.0d0/vbld(j+nres)
-c$$$c            write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
-c$$$            sig0ij=sigma(itypi,itypj)
-c$$$            chi1=chi(itypi,itypj)
-c$$$            chi2=chi(itypj,itypi)
-c$$$            chi12=chi1*chi2
-c$$$            chip1=chip(itypi)
-c$$$            chip2=chip(itypj)
-c$$$            chip12=chip1*chip2
-c$$$            alf1=alp(itypi)
-c$$$            alf2=alp(itypj)
-c$$$            alf12=0.5D0*(alf1+alf2)
-c$$$C For diagnostics only!!!
-c$$$c           chi1=0.0D0
-c$$$c           chi2=0.0D0
-c$$$c           chi12=0.0D0
-c$$$c           chip1=0.0D0
-c$$$c           chip2=0.0D0
-c$$$c           chip12=0.0D0
-c$$$c           alf1=0.0D0
-c$$$c           alf2=0.0D0
-c$$$c           alf12=0.0D0
-c$$$            xj=c(1,nres+j)-xi
-c$$$            yj=c(2,nres+j)-yi
-c$$$            zj=c(3,nres+j)-zi
-c$$$            dxj=dc_norm(1,nres+j)
-c$$$            dyj=dc_norm(2,nres+j)
-c$$$            dzj=dc_norm(3,nres+j)
-c$$$c            write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
-c$$$c            write (iout,*) "j",j," dc_norm",
-c$$$c     &       dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
-c$$$            rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-c$$$            rij=dsqrt(rrij)
-c$$$C Calculate angle-dependent terms of energy and contributions to their
-c$$$C derivatives.
-c$$$            call sc_angular
-c$$$            sigsq=1.0D0/sigsq
-c$$$            sig=sig0ij*dsqrt(sigsq)
-c$$$            rij_shift=1.0D0/rij-sig+sig0ij
-c$$$c for diagnostics; uncomment
-c$$$c            rij_shift=1.2*sig0ij
-c$$$C I hate to put IF's in the loops, but here don't have another choice!!!!
-c$$$            if (rij_shift.le.0.0D0) then
-c$$$              evdw=1.0D20
-c$$$cd              write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c$$$cd     &        restyp(itypi),i,restyp(itypj),j,
-c$$$cd     &        rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) 
-c$$$              return
-c$$$            endif
-c$$$            sigder=-sig*sigsq
-c$$$c---------------------------------------------------------------
-c$$$            rij_shift=1.0D0/rij_shift 
-c$$$            fac=rij_shift**expon
-c$$$            e1=fac*fac*aa(itypi,itypj)
-c$$$            e2=fac*bb(itypi,itypj)
-c$$$            evdwij=eps1*eps2rt*eps3rt*(e1+e2)
-c$$$            eps2der=evdwij*eps3rt
-c$$$            eps3der=evdwij*eps2rt
-c$$$c            write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-c$$$c     &        " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
-c$$$            evdwij=evdwij*eps2rt*eps3rt
-c$$$            evdw=evdw+evdwij
-c$$$            if (lprn) then
-c$$$            sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-c$$$            epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-c$$$            write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c$$$     &        restyp(itypi),i,restyp(itypj),j,
-c$$$     &        epsi,sigm,chi1,chi2,chip1,chip2,
-c$$$     &        eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
-c$$$     &        om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
-c$$$     &        evdwij
-c$$$            endif
-c$$$
-c$$$            if (energy_dec) write (iout,'(a6,2i,0pf7.3)') 
-c$$$     &                        'evdw',i,j,evdwij
-c$$$
-c$$$C Calculate gradient components.
-c$$$            e1=e1*eps1*eps2rt**2*eps3rt**2
-c$$$            fac=-expon*(e1+evdwij)*rij_shift
-c$$$            sigder=fac*sigder
-c$$$            fac=rij*fac
-c$$$c            fac=0.0d0
-c$$$C Calculate the radial part of the gradient
-c$$$            gg(1)=xj*fac
-c$$$            gg(2)=yj*fac
-c$$$            gg(3)=zj*fac
-c$$$C Calculate angular part of the gradient.
-c$$$            call sc_grad
-c$$$c$$$          enddo      ! j
-c$$$c$$$        enddo        ! iint
-c$$$c$$$      enddo          ! i
-c$$$      energy_dec=.false.
-c$$$      return
-c$$$      end
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine perturb_side_chain(i,angle)
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.GEO'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.LOCAL'
-c$$$      include 'COMMON.IOUNITS'
-c$$$
-c$$$c     External functions
-c$$$      external ran_number
-c$$$      double precision ran_number
-c$$$
-c$$$c     Input arguments
-c$$$      integer i
-c$$$      double precision angle    ! In degrees
-c$$$
-c$$$c     Local variables
-c$$$      integer i_sc
-c$$$      double precision rad_ang,rand_v(3),length,cost,sint
-c$$$
-c$$$
-c$$$      i_sc=i+nres
-c$$$      rad_ang=angle*deg2rad
-c$$$
-c$$$      length=0.0
-c$$$      do while (length.lt.0.01)
-c$$$        rand_v(1)=ran_number(0.01D0,1.0D0)
-c$$$        rand_v(2)=ran_number(0.01D0,1.0D0)
-c$$$        rand_v(3)=ran_number(0.01D0,1.0D0)
-c$$$        length=rand_v(1)*rand_v(1)+rand_v(2)*rand_v(2)+
-c$$$     +       rand_v(3)*rand_v(3)
-c$$$        length=sqrt(length)
-c$$$        rand_v(1)=rand_v(1)/length
-c$$$        rand_v(2)=rand_v(2)/length
-c$$$        rand_v(3)=rand_v(3)/length
-c$$$        cost=rand_v(1)*dc_norm(1,i_sc)+rand_v(2)*dc_norm(2,i_sc)+
-c$$$     +       rand_v(3)*dc_norm(3,i_sc)
-c$$$        length=1.0D0-cost*cost
-c$$$        if (length.lt.0.0D0) length=0.0D0
-c$$$        length=sqrt(length)
-c$$$        rand_v(1)=rand_v(1)-cost*dc_norm(1,i_sc)
-c$$$        rand_v(2)=rand_v(2)-cost*dc_norm(2,i_sc)
-c$$$        rand_v(3)=rand_v(3)-cost*dc_norm(3,i_sc)
-c$$$      enddo
-c$$$      rand_v(1)=rand_v(1)/length
-c$$$      rand_v(2)=rand_v(2)/length
-c$$$      rand_v(3)=rand_v(3)/length
-c$$$
-c$$$      cost=dcos(rad_ang)
-c$$$      sint=dsin(rad_ang)
-c$$$      dc(1,i_sc)=vbld(i_sc)*(dc_norm(1,i_sc)*cost+rand_v(1)*sint)
-c$$$      dc(2,i_sc)=vbld(i_sc)*(dc_norm(2,i_sc)*cost+rand_v(2)*sint)
-c$$$      dc(3,i_sc)=vbld(i_sc)*(dc_norm(3,i_sc)*cost+rand_v(3)*sint)
-c$$$      dc_norm(1,i_sc)=dc(1,i_sc)*vbld_inv(i_sc)
-c$$$      dc_norm(2,i_sc)=dc(2,i_sc)*vbld_inv(i_sc)
-c$$$      dc_norm(3,i_sc)=dc(3,i_sc)*vbld_inv(i_sc)
-c$$$      c(1,i_sc)=c(1,i)+dc(1,i_sc)
-c$$$      c(2,i_sc)=c(2,i)+dc(2,i_sc)
-c$$$      c(3,i_sc)=c(3,i)+dc(3,i_sc)
-c$$$
-c$$$      call chainbuild_cart
-c$$$
-c$$$      return
-c$$$      end
-c$$$
-c$$$c----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine ss_relax3(i_in,j_in)
-c$$$      implicit none
-c$$$
-c$$$c     Includes
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.INTERACT'
-c$$$
-c$$$c     External functions
-c$$$      external ran_number
-c$$$      double precision ran_number
-c$$$
-c$$$c     Input arguments
-c$$$      integer i_in,j_in
-c$$$
-c$$$c     Local variables
-c$$$      double precision energy_sc(0:n_ene),etot
-c$$$      double precision org_dc(3),org_dc_norm(3),org_c(3)
-c$$$      double precision ang_pert,rand_fact,exp_fact,beta
-c$$$      integer n,i_pert,i
-c$$$      logical notdone
-c$$$
-c$$$
-c$$$      beta=1.0D0
-c$$$
-c$$$      mask_r=.true.
-c$$$      do i=nnt,nct
-c$$$        mask_side(i)=0
-c$$$      enddo
-c$$$      mask_side(i_in)=1
-c$$$      mask_side(j_in)=1
-c$$$
-c$$$      call etotal_sc(energy_sc)
-c$$$      etot=energy_sc(0)
-c$$$c      write(iout,'(a,3d15.5)')"     SS_MC_START ",energy_sc(0),
-c$$$c     +     energy_sc(1),energy_sc(12)
-c$$$
-c$$$      notdone=.true.
-c$$$      n=0
-c$$$      do while (notdone)
-c$$$        if (mod(n,2).eq.0) then
-c$$$          i_pert=i_in
-c$$$        else
-c$$$          i_pert=j_in
-c$$$        endif
-c$$$        n=n+1
-c$$$
-c$$$        do i=1,3
-c$$$          org_dc(i)=dc(i,i_pert+nres)
-c$$$          org_dc_norm(i)=dc_norm(i,i_pert+nres)
-c$$$          org_c(i)=c(i,i_pert+nres)
-c$$$        enddo
-c$$$        ang_pert=ran_number(0.0D0,3.0D0)
-c$$$        call perturb_side_chain(i_pert,ang_pert)
-c$$$        call etotal_sc(energy_sc)
-c$$$        exp_fact=exp(beta*(etot-energy_sc(0)))
-c$$$        rand_fact=ran_number(0.0D0,1.0D0)
-c$$$        if (rand_fact.lt.exp_fact) then
-c$$$c          write(iout,'(a,3d15.5)')"     SS_MC_ACCEPT ",energy_sc(0),
-c$$$c     +     energy_sc(1),energy_sc(12)
-c$$$          etot=energy_sc(0)
-c$$$        else
-c$$$c          write(iout,'(a,3d15.5)')"     SS_MC_REJECT ",energy_sc(0),
-c$$$c     +     energy_sc(1),energy_sc(12)
-c$$$          do i=1,3
-c$$$            dc(i,i_pert+nres)=org_dc(i)
-c$$$            dc_norm(i,i_pert+nres)=org_dc_norm(i)
-c$$$            c(i,i_pert+nres)=org_c(i)
-c$$$          enddo
-c$$$        endif
-c$$$
-c$$$        if (n.eq.10000.or.etot.lt.30.0D0) notdone=.false.
-c$$$      enddo
-c$$$
-c$$$      mask_r=.false.
-c$$$
-c$$$      return
-c$$$      end
-c$$$
-c$$$c----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine ss_relax2(etot,iretcode,nfun,i_in,j_in)
-c$$$      implicit none
-c$$$      include 'DIMENSIONS'
-c$$$      integer liv,lv
-c$$$      parameter (liv=60,lv=(77+maxres6*(maxres6+17)/2)) 
-c$$$*********************************************************************
-c$$$* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for *
-c$$$* the calling subprogram.                                           *     
-c$$$* when d(i)=1.0, then v(35) is the length of the initial step,      *     
-c$$$* calculated in the usual pythagorean way.                          *     
-c$$$* absolute convergence occurs when the function is within v(31) of  *     
-c$$$* zero. unless you know the minimum value in advance, abs convg     *     
-c$$$* is probably not useful.                                           *     
-c$$$* relative convergence is when the model predicts that the function *   
-c$$$* will decrease by less than v(32)*abs(fun).                        *   
-c$$$*********************************************************************
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.GEO'
-c$$$      include 'COMMON.MINIM'
-c$$$      include 'COMMON.CHAIN'
-c$$$
-c$$$      double precision orig_ss_dc,orig_ss_var,orig_ss_dist
-c$$$      common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar),
-c$$$     +     orig_ss_dist(maxres2,maxres2)
-c$$$
-c$$$      double precision etot
-c$$$      integer iretcode,nfun,i_in,j_in
-c$$$
-c$$$      external dist
-c$$$      double precision dist
-c$$$      external ss_func,fdum
-c$$$      double precision ss_func,fdum
-c$$$
-c$$$      integer iv(liv),uiparm(2)
-c$$$      double precision v(lv),x(maxres6),d(maxres6),rdum
-c$$$      integer i,j,k
-c$$$
-c$$$
-c$$$      call deflt(2,iv,liv,lv,v)                                         
-c$$$* 12 means fresh start, dont call deflt                                 
-c$$$      iv(1)=12                                                          
-c$$$* max num of fun calls                                                  
-c$$$      if (maxfun.eq.0) maxfun=500
-c$$$      iv(17)=maxfun
-c$$$* max num of iterations                                                 
-c$$$      if (maxmin.eq.0) maxmin=1000
-c$$$      iv(18)=maxmin
-c$$$* controls output                                                       
-c$$$      iv(19)=2                                                          
-c$$$* selects output unit                                                   
-c$$$c      iv(21)=iout                                                       
-c$$$      iv(21)=0
-c$$$* 1 means to print out result                                           
-c$$$      iv(22)=0                                                          
-c$$$* 1 means to print out summary stats                                    
-c$$$      iv(23)=0                                                          
-c$$$* 1 means to print initial x and d                                      
-c$$$      iv(24)=0                                                          
-c$$$* min val for v(radfac) default is 0.1                                  
-c$$$      v(24)=0.1D0                                                       
-c$$$* max val for v(radfac) default is 4.0                                  
-c$$$      v(25)=2.0D0                                                       
-c$$$c     v(25)=4.0D0                                                       
-c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)    
-c$$$* the sumsl default is 0.1                                              
-c$$$      v(26)=0.1D0
-c$$$* false conv if (act fnctn decrease) .lt. v(34)                         
-c$$$* the sumsl default is 100*machep                                       
-c$$$      v(34)=v(34)/100.0D0                                               
-c$$$* absolute convergence                                                  
-c$$$      if (tolf.eq.0.0D0) tolf=1.0D-4
-c$$$      v(31)=tolf
-c$$$      v(31)=1.0D-1
-c$$$* relative convergence                                                  
-c$$$      if (rtolf.eq.0.0D0) rtolf=1.0D-4
-c$$$      v(32)=rtolf
-c$$$      v(32)=1.0D-1
-c$$$* controls initial step size                                            
-c$$$      v(35)=1.0D-1
-c$$$* large vals of d correspond to small components of step                
-c$$$      do i=1,6*nres
-c$$$        d(i)=1.0D0
-c$$$      enddo
-c$$$
-c$$$      do i=0,2*nres
-c$$$        do j=1,3
-c$$$          orig_ss_dc(j,i)=dc(j,i)
-c$$$        enddo
-c$$$      enddo
-c$$$      call geom_to_var(nvar,orig_ss_var)
-c$$$
-c$$$      do i=1,nres
-c$$$        do j=i,nres
-c$$$          orig_ss_dist(j,i)=dist(j,i)
-c$$$          orig_ss_dist(j+nres,i)=dist(j+nres,i)
-c$$$          orig_ss_dist(j,i+nres)=dist(j,i+nres)
-c$$$          orig_ss_dist(j+nres,i+nres)=dist(j+nres,i+nres)
-c$$$        enddo
-c$$$      enddo
-c$$$
-c$$$      k=0
-c$$$      do i=1,nres-1
-c$$$        do j=1,3
-c$$$          k=k+1
-c$$$          x(k)=dc(j,i)
-c$$$        enddo
-c$$$      enddo
-c$$$      do i=2,nres-1
-c$$$        if (ialph(i,1).gt.0) then
-c$$$        do j=1,3
-c$$$          k=k+1
-c$$$          x(k)=dc(j,i+nres)
-c$$$        enddo
-c$$$        endif
-c$$$      enddo
-c$$$
-c$$$      uiparm(1)=i_in
-c$$$      uiparm(2)=j_in
-c$$$      call smsno(k,d,x,ss_func,iv,liv,lv,v,uiparm,rdum,fdum)
-c$$$      etot=v(10)
-c$$$      iretcode=iv(1)
-c$$$      nfun=iv(6)+iv(30)
-c$$$
-c$$$      k=0
-c$$$      do i=1,nres-1
-c$$$        do j=1,3
-c$$$          k=k+1
-c$$$          dc(j,i)=x(k)
-c$$$        enddo
-c$$$      enddo
-c$$$      do i=2,nres-1
-c$$$        if (ialph(i,1).gt.0) then
-c$$$        do j=1,3
-c$$$          k=k+1
-c$$$          dc(j,i+nres)=x(k)
-c$$$        enddo
-c$$$        endif
-c$$$      enddo
-c$$$      call chainbuild_cart
-c$$$
-c$$$      return  
-c$$$      end  
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$      subroutine ss_func(n,x,nf,f,uiparm,urparm,ufparm)  
-c$$$      implicit none
-c$$$      include 'DIMENSIONS'
-c$$$      include 'COMMON.DERIV'
-c$$$      include 'COMMON.IOUNITS'
-c$$$      include 'COMMON.VAR'
-c$$$      include 'COMMON.CHAIN'
-c$$$      include 'COMMON.INTERACT'
-c$$$      include 'COMMON.SBRIDGE'
-c$$$
-c$$$      double precision orig_ss_dc,orig_ss_var,orig_ss_dist
-c$$$      common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar),
-c$$$     +     orig_ss_dist(maxres2,maxres2)
-c$$$
-c$$$      integer n
-c$$$      double precision x(maxres6)
-c$$$      integer nf
-c$$$      double precision f
-c$$$      integer uiparm(2)
-c$$$      real*8 urparm(1)
-c$$$      external ufparm
-c$$$      double precision ufparm
-c$$$
-c$$$      external dist
-c$$$      double precision dist
-c$$$
-c$$$      integer i,j,k,ss_i,ss_j
-c$$$      double precision tempf,var(maxvar)
-c$$$
-c$$$
-c$$$      ss_i=uiparm(1)
-c$$$      ss_j=uiparm(2)
-c$$$      f=0.0D0
-c$$$
-c$$$      k=0
-c$$$      do i=1,nres-1
-c$$$        do j=1,3
-c$$$          k=k+1
-c$$$          dc(j,i)=x(k)
-c$$$        enddo
-c$$$      enddo
-c$$$      do i=2,nres-1
-c$$$        if (ialph(i,1).gt.0) then
-c$$$        do j=1,3
-c$$$          k=k+1
-c$$$          dc(j,i+nres)=x(k)
-c$$$        enddo
-c$$$        endif
-c$$$      enddo
-c$$$      call chainbuild_cart
-c$$$
-c$$$      call geom_to_var(nvar,var)
-c$$$
-c$$$c     Constraints on all angles
-c$$$      do i=1,nvar
-c$$$        tempf=var(i)-orig_ss_var(i)
-c$$$        f=f+tempf*tempf
-c$$$      enddo
-c$$$
-c$$$c     Constraints on all distances
-c$$$      do i=1,nres-1
-c$$$        if (i.gt.1) then
-c$$$          tempf=dist(i+nres,i)-orig_ss_dist(i+nres,i)
-c$$$          f=f+tempf*tempf
-c$$$        endif
-c$$$        do j=i+1,nres
-c$$$          tempf=dist(j,i)-orig_ss_dist(j,i)
-c$$$          if (tempf.lt.0.0D0 .or. j.eq.i+1) f=f+tempf*tempf
-c$$$          tempf=dist(j+nres,i)-orig_ss_dist(j+nres,i)
-c$$$          if (tempf.lt.0.0D0) f=f+tempf*tempf
-c$$$          tempf=dist(j,i+nres)-orig_ss_dist(j,i+nres)
-c$$$          if (tempf.lt.0.0D0) f=f+tempf*tempf
-c$$$          tempf=dist(j+nres,i+nres)-orig_ss_dist(j+nres,i+nres)
-c$$$          if (tempf.lt.0.0D0) f=f+tempf*tempf
-c$$$        enddo
-c$$$      enddo
-c$$$
-c$$$c     Constraints for the relevant CYS-CYS
-c$$$      tempf=dist(nres+ss_i,nres+ss_j)-8.0D0
-c$$$      f=f+tempf*tempf
-c$$$CCCCCCCCCCCCCCCCC      ADD SOME ANGULAR STUFF
-c$$$
-c$$$c$$$      if (nf.ne.nfl) then
-c$$$c$$$        write(iout,'(a,i10,2d15.5)')"IN DIST_FUNC (NF,F,DIST)",nf,
-c$$$c$$$     +       f,dist(5+nres,14+nres)
-c$$$c$$$      endif
-c$$$
-c$$$      nfl=nf
-c$$$
-c$$$      return                                                            
-c$$$      end                                                               
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$C-----------------------------------------------------------------------------
-         subroutine triple_ssbond_ene(resi,resj,resk,eij)
+c$$$C----------------------------------------------------------------------------
+      subroutine triple_ssbond_ene(resi,resj,resk,eij)
       include 'DIMENSIONS'
       include 'COMMON.SBRIDGE'
       include 'COMMON.CHAIN'
index 31de33e..7e4512d 100644 (file)
@@ -235,8 +235,8 @@ c      potEmin=potEmin_t/2
 c        write (9,'(3i5,f10.5)') i,(iparm,potE(i,iparm),iparm=1,nParmSet)
         do iparm=1,nParmSet
 #ifdef DEBUG
-          write (iout,'(2i5,21f8.2)') i,iparm,
-     &     (enetb(k,i,iparm),k=1,22)
+          write (iout,'(2i5,31f8.2)') i,iparm,
+     &     (enetb(k,i,iparm),k=1,n_ene)
 #endif
           call restore_parm(iparm)
 #ifdef DEBUG