& 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)
- 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)
& 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,
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
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)
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
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)
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"
--- /dev/null
+###################################################################
+#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
+
+
--- /dev/null
+
+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
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
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),
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
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
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
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
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)
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)
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)
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)
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)
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)
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)
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
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
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))
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)
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
& min_odl=distancek(kk)
enddo
endif
-
c write (iout,* )"min_odl",min_odl
#ifdef DEBUG
write (iout,*) "ij dij",i,j,dij
& 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
& 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,
& 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),
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
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)
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.
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
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
c implicit none
c Includes
- implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.VAR'
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'
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
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)
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)
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
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
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
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)
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)
c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
endif
-C write(iout,*) 'havebond',havebond
+
if (havebond) then
#ifndef CLUST
#ifndef WHAM
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)')
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
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
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)
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"
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
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'
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
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),
& 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
& 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
& 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,
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,
& 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,
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
& 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)
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)
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
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)
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)
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)
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
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)
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
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
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)
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
#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)
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
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)
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
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)
#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.
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
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
endif
enddo
enddo
+ first_pass=.false.
cd write (iout,*) "exchange completed"
cd call flush(iout)
ELSE
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
& 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
& 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
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')
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
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
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
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
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
--- /dev/null
+###################################################################
+#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
--- /dev/null
+ 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
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
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
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
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
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
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
#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)
call make_pp_vdw_inter_list
endif
#endif
-
cd print *,'nnt=',nnt,' nct=',nct
C
C Compute the side-chain and electrostatic interaction energy
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
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)
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"
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.
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
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
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
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)
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
#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
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 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
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
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
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)
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
#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
include 'mpif.h'
include "COMMON.SETUP"
#endif
+ include "COMMON.CONTROL"
include "COMMON.CHAIN"
include "COMMON.INTERACT"
include "COMMON.SPLITELE"
& 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
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
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)
#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
include 'mpif.h'
include "COMMON.SETUP"
#endif
+ include "COMMON.CONTROL"
include "COMMON.CHAIN"
include "COMMON.INTERACT"
include "COMMON.SPLITELE"
& 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
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
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)
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)
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
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)
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
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)
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
--- /dev/null
+ 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
+
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
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.
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.
! 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)
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
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
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
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
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)
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)
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"
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
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
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
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
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
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
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
& 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)
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.
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
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:'
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
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
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
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)
& ik,ll,ii,kk,iistart,iishift,lim_xx
double precision distal
logical lprn /.true./
+ integer nres_temp
integer ilen
external ilen
logical liiflag
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
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)
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
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
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'
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
+ include 'COMMON.NAMES'
#ifndef CLUST
#ifndef WHAM
include 'COMMON.MD'
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)
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)
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)')
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
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'
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'
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'
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'
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
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
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
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/
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-----------------------------------------------------------
& 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)
- 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)
& 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,
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)
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)
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)
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)
--- /dev/null
+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
+
cxread.o \
enecalc1.o \
energy_p_new.o \
+ boxshift.o \
gnmr1.o \
initialize_p.o \
molread_zs.o \
readrtns.o \
read_constr_homology.o \
arcos.o \
- cartder.o \
cartprint.o \
chainbuild.o \
geomout.o \
--- /dev/null
+
+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
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)
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
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)
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
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)
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),
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)
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
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),
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
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
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
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
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)
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)
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)
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)
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)
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)
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)
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
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
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))
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)
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
& 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
& 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
& 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,
& 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),
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
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)
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
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
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
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,
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
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
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.
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
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'
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
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)
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)
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)
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
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
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
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)
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)
c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
endif
- write(iout,*) 'havebond',havebond
+
if (havebond) then
#ifndef CLUST
#ifndef WHAM
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)')
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
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
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)
return
end
-
c----------------------------------------------------------------------------
-
subroutine dyn_set_nss
c Adjust nss and other relevant variables based on dyn_ssbond_ij
c implicit none
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
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'
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
projects / unres.git / commitdiff