From 47fc0fb0bccd301d26a8dac1bb693932f9ebef15 Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Fri, 29 May 2020 21:42:15 +0200 Subject: [PATCH] corrections --- source/cluster/wham/src-HCD/COMMON.HOMOLOGY | 2 +- source/cluster/wham/src-HCD/COMMON.HOMRESTR | 7 +- source/cluster/wham/src-HCD/COMMON.SBRIDGE | 26 +- source/cluster/wham/src-HCD/DIMENSIONS | 13 + .../wham/src-HCD/Makefile-MPICH-ifort-okeanos | 8 +- source/cluster/wham/src-HCD/Makefile-tryton | 125 ++ source/cluster/wham/src-HCD/boxshift.f | 101 ++ source/cluster/wham/src-HCD/energy_p_new.F | 361 +---- .../wham/src-HCD/include_unres/COMMON.CONTMAT | 5 +- .../wham/src-HCD/include_unres/COMMON.CORRMAT | 3 - .../wham/src-HCD/include_unres/COMMON.DERIV | 4 +- source/cluster/wham/src-HCD/initialize_p.F | 4 +- source/cluster/wham/src-HCD/probabl.F | 2 + source/cluster/wham/src-HCD/readpdb.F | 2 +- source/cluster/wham/src-HCD/readrtns.F | 10 +- source/cluster/wham/src-HCD/ssMD.F | 1478 ++------------------ source/cluster/wham/src-HCD/wrtclust.f | 2 +- source/unres/src-HCD-5D/COMMON.CHAIN | 8 +- source/unres/src-HCD-5D/COMMON.CONTMAT | 5 +- source/unres/src-HCD-5D/COMMON.CORRMAT | 3 - source/unres/src-HCD-5D/COMMON.HOMOLOGY | 11 +- source/unres/src-HCD-5D/COMMON.INTERACT | 12 +- source/unres/src-HCD-5D/COMMON.SBRIDGE | 26 +- source/unres/src-HCD-5D/COMMON.SHIELD | 9 +- source/unres/src-HCD-5D/DIMENSIONS | 23 +- source/unres/src-HCD-5D/MD_A-MTS.F | 51 +- source/unres/src-HCD-5D/MP.F | 4 +- source/unres/src-HCD-5D/MREMD.F | 37 +- .../unres/src-HCD-5D/Makefile_MPICH_ifort-tryton | 200 +++ source/unres/src-HCD-5D/contact_cp2.F | 148 ++ source/unres/src-HCD-5D/energy_p_new-sep_barrier.F | 3 - source/unres/src-HCD-5D/energy_p_new_barrier.F | 28 +- source/unres/src-HCD-5D/energy_split-sep.F | 45 +- source/unres/src-HCD-5D/gen_rand_conf.F | 6 +- source/unres/src-HCD-5D/initialize_p.F | 4 +- source/unres/src-HCD-5D/make_xx_list.F | 124 +- source/unres/src-HCD-5D/minim_jlee.F | 4 +- source/unres/src-HCD-5D/minimize_p.F | 4 +- source/unres/src-HCD-5D/parmread.F | 7 +- source/unres/src-HCD-5D/read_constr_homology.F | 717 ++++++++++ source/unres/src-HCD-5D/readpdb-mult.F | 42 +- source/unres/src-HCD-5D/readrtns_CSA.F | 118 +- source/unres/src-HCD-5D/regularize.F | 3 +- source/unres/src-HCD-5D/ssMD.F | 167 +-- source/unres/src-HCD-5D/stochfric.F | 4 + source/unres/src-HCD-5D/test.F | 165 +-- source/wham/src-HCD/COMMON.HOMOLOGY | 2 +- source/wham/src-HCD/COMMON.HOMRESTR | 7 +- source/wham/src-HCD/COMMON.SHIELD | 9 +- source/wham/src-HCD/DIMENSIONS | 21 +- source/wham/src-HCD/Makefile-tryton | 162 +++ source/wham/src-HCD/Makefile_MPICH_ifort-okeanos | 2 +- source/wham/src-HCD/boxshift.f | 101 ++ source/wham/src-HCD/cxread.F | 7 +- source/wham/src-HCD/enecalc1.F | 11 +- source/wham/src-HCD/energy_p_new.F | 363 +---- source/wham/src-HCD/include_unres/COMMON.CALC | 4 +- source/wham/src-HCD/include_unres/COMMON.CONTMAT | 5 +- source/wham/src-HCD/include_unres/COMMON.CORRMAT | 3 - source/wham/src-HCD/include_unres/COMMON.DERIV | 4 +- source/wham/src-HCD/include_unres/COMMON.SBRIDGE | 24 +- source/wham/src-HCD/initialize_p.F | 4 +- source/wham/src-HCD/molread_zs.F | 9 +- source/wham/src-HCD/parmread.F | 4 +- source/wham/src-HCD/readpdb.F | 2 +- source/wham/src-HCD/readrtns.F | 2 + source/wham/src-HCD/ssMD.F | 1423 +------------------ source/wham/src-HCD/wham_calc1.F | 4 +- 68 files changed, 2475 insertions(+), 3829 deletions(-) create mode 100644 source/cluster/wham/src-HCD/Makefile-tryton create mode 100644 source/cluster/wham/src-HCD/boxshift.f create mode 100644 source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton create mode 100644 source/unres/src-HCD-5D/contact_cp2.F create mode 100644 source/unres/src-HCD-5D/read_constr_homology.F create mode 100644 source/wham/src-HCD/Makefile-tryton create mode 100644 source/wham/src-HCD/boxshift.f diff --git a/source/cluster/wham/src-HCD/COMMON.HOMOLOGY b/source/cluster/wham/src-HCD/COMMON.HOMOLOGY index e2a7754..d149f8d 100644 --- a/source/cluster/wham/src-HCD/COMMON.HOMOLOGY +++ b/source/cluster/wham/src-HCD/COMMON.HOMOLOGY @@ -5,4 +5,4 @@ & dist2_cut common /homol/ waga_homology(10), & waga_dist,waga_angle,waga_theta,waga_d,dist_cut,dist2_cut, - & iset,ihset,l_homo(max_template,maxdim) + & iset,ihset,l_homo(max_template,maxdim_cont) diff --git a/source/cluster/wham/src-HCD/COMMON.HOMRESTR b/source/cluster/wham/src-HCD/COMMON.HOMRESTR index 95ea932..0e558f1 100644 --- a/source/cluster/wham/src-HCD/COMMON.HOMRESTR +++ b/source/cluster/wham/src-HCD/COMMON.HOMRESTR @@ -1,6 +1,7 @@ - real*8 odl(max_template,maxdim),sigma_odl(max_template,maxdim), + real*8 odl(max_template,maxdim_cont), + & sigma_odl(max_template,maxdim_cont), & dih(max_template,maxres),sigma_dih(max_template,maxres), - & sigma_odlir(max_template,maxdim) + & sigma_odlir(max_template,maxdim_cont) c c Specification of new variables used in subroutine e_modeller c modified by FP (Nov.,2014) @@ -10,7 +11,7 @@ c modified by FP (Nov.,2014) & sigma_d(max_template,maxres) c - integer ires_homo(maxdim),jres_homo(maxdim) + integer ires_homo(maxdim_cont),jres_homo(maxdim_cont) double precision & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst, diff --git a/source/cluster/wham/src-HCD/COMMON.SBRIDGE b/source/cluster/wham/src-HCD/COMMON.SBRIDGE index ab78ed3..a313d8f 100644 --- a/source/cluster/wham/src-HCD/COMMON.SBRIDGE +++ b/source/cluster/wham/src-HCD/COMMON.SBRIDGE @@ -1,20 +1,22 @@ double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss - integer ns,nss,nfree,iss - logical restr_on_coord + integer ns,nss,nfree,iss,icys common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, - & ns,nss,nfree,iss(maxss) + & ns,nss,nfree,iss(maxss),icys(maxres) double precision dhpb,dhpb1,forcon,fordepth,xlscore,wboltzd, & dhpb_peak,dhpb1_peak,forcon_peak,fordepth_peak,scal_peak,bfac integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb,ibecarb_peak,npeak, & ipeak,irestr_type,irestr_type_peak,ihpb_peak,jhpb_peak,nhpb_peak - common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), - & fordepth(maxdim),bfac(maxres),xlscore(maxdim),wboltzd, - & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),irestr_type(maxdim), + logical restr_on_coord + common /links/ dhpb(maxdim_cont),dhpb1(maxdim_cont), + & forcon(maxdim_cont),fordepth(maxdim_cont),bfac(maxres), + & xlscore(maxdim_cont),wboltzd,ihpb(maxdim_cont),jhpb(maxdim_cont), + & ibecarb(maxdim_cont),irestr_type(maxdim_cont), & nhpb,restr_on_coord - common /NMRpeaks/ dhpb_peak(maxdim),dhpb1_peak(maxdim), - & forcon_peak(maxdim),fordepth_peak(maxdim),scal_peak, - & ihpb_peak(maxdim),jhpb_peak(maxdim),ibecarb_peak(maxdim), - & irestr_type_peak(maxdim),ipeak(2,maxdim),npeak,nhpb_peak + common /NMRpeaks/ dhpb_peak(maxdim_cont),dhpb1_peak(maxdim_cont), + & forcon_peak(maxdim_cont),fordepth_peak(maxdim_cont),scal_peak, + & ihpb_peak(maxdim_cont),jhpb_peak(maxdim_cont), + & ibecarb_peak(maxdim_cont),irestr_type_peak(maxdim_cont), + & ipeak(2,maxdim_cont),npeak,nhpb_peak double precision weidis common /restraints/ weidis integer link_start,link_end,link_start_peak,link_end_peak @@ -23,7 +25,7 @@ double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss logical dyn_ss,dyn_ss_mask common /dyn_ssbond/ dtriss,atriss,btriss,ctriss,Ht, - & dyn_ssbond_ij(maxres,maxres), - & idssb(maxdim),jdssb(maxdim) + & dyn_ssbond_ij(max_cyst,max_cyst), + & idssb(maxss),jdssb(maxss) common /dyn_ss_logic/ & dyn_ss,dyn_ss_mask(maxres) diff --git a/source/cluster/wham/src-HCD/DIMENSIONS b/source/cluster/wham/src-HCD/DIMENSIONS index ffd3a80..e6a29b3 100644 --- a/source/cluster/wham/src-HCD/DIMENSIONS +++ b/source/cluster/wham/src-HCD/DIMENSIONS @@ -11,6 +11,9 @@ C Max. number of AA residues integer maxres,maxres2 c parameter (maxres=1200) parameter (maxres=5000) +C Max. number of cysteines and other bridging residues + integer max_cyst + parameter (max_cyst=100) C Appr. max. number of interaction sites parameter (maxres2=2*maxres) C Max. number of variables @@ -34,6 +37,16 @@ C Max. number of SC contacts C Max. number of contacts per residue integer maxconts parameter (maxconts=maxres) +C Max. number of interactions within cutoff per residue + integer maxint_res + parameter (maxint_res=200) +C Max. number od residues within distance cufoff from a given residue to +C include in template-based/contact distance restraints. + integer maxcont_res + parameter (maxcont_res=200) +C Max. number of distance/contact-distance restraints + integer maxdim_cont + parameter (maxdim_cont=maxres*maxcont_res) C Number of AA types (at present only natural AA's will be handled integer ntyp,ntyp1 parameter (ntyp=24,ntyp1=ntyp+1) diff --git a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos index 4f7f61f..425bed2 100644 --- a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos +++ b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos @@ -18,10 +18,10 @@ object = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ - int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ - setup_var.o read_ref_str.o gnmr1.o permut.o seq2chains.o \ - chain_symmetry.o iperm.o rmscalc.o rmsnat.o TMscore.o ssMD.o refsys.o \ - read_constr_homology.o + int_from_cart1.o energy_p_new.o boxshift.o icant.o proc_proc.o \ + work_partition.o setup_var.o read_ref_str.o gnmr1.o permut.o \ + seq2chains.o chain_symmetry.o iperm.o rmscalc.o rmsnat.o TMscore.o \ + ssMD.o refsys.o read_constr_homology.o all: no_option @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR" diff --git a/source/cluster/wham/src-HCD/Makefile-tryton b/source/cluster/wham/src-HCD/Makefile-tryton new file mode 100644 index 0000000..e887bc9 --- /dev/null +++ b/source/cluster/wham/src-HCD/Makefile-tryton @@ -0,0 +1,125 @@ +################################################################### +#INSTALL_DIR = /net/software/local/intel/compilers_and_libraries_2016.3.210/linux/mpi/intel64 + + +FC = mpif90 -fc=ifort + + +OPT = -O3 -ip -mcmodel=medium +#OPT = -CB -g -mcmodel=medium -shared-intel +FFLAGS = ${OPT} -c -I. -Iinclude_unres -I$(INSTALL_DIR)/include +LIBS = -L$(INSTALL_DIR)/lib -lmpi xdrf/libxdrf.a + +.c.o: + cc -c -DLINUX -DPGI $*.c + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F + +object = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ + matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ + geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ + track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ + int_from_cart1.o energy_p_new.o boxshift.o icant.o proc_proc.o \ + work_partition.o setup_var.o read_ref_str.o gnmr1.o permut.o \ + seq2chains.o chain_symmetry.o iperm.o rmscalc.o rmsnat.o TMscore.o \ + ssMD.o refsys.o read_constr_homology.o + +all: no_option + @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR" + +no_option: + +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC \ + -DFOURBODY +GAB: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_GAB-HCD.exe +GAB: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC \ + -DFOURBODY +4P: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_4P-HCD.exe +4P: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCLUST -DSPLITELE -DFOURBODY +E0LL2Y: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_E0LL2Y-HCD.exe +E0LL2Y: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCLUST -DSPLITELE -DFOURBODY -DDFA +E0LL2Y_DFA: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_E0LL2Y-HCD-DFA.exe +E0LL2Y_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DFIVEDIAG +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR5D: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD5.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR5D: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +NEWCORR_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DDFA +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR_DFA: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD-DFA.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DDFA +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR5D_DFA: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD5-DFA.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR5D_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +xdrf/libxdrf.a: + cd xdrf && make + + +clean: + /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean + + diff --git a/source/cluster/wham/src-HCD/boxshift.f b/source/cluster/wham/src-HCD/boxshift.f new file mode 100644 index 0000000..29d3406 --- /dev/null +++ b/source/cluster/wham/src-HCD/boxshift.f @@ -0,0 +1,101 @@ + +c------------------------------------------------------------------------ + double precision function boxshift(x,boxsize) + implicit none + double precision x,boxsize + double precision xtemp + xtemp=dmod(x,boxsize) + if (dabs(xtemp-boxsize).lt.dabs(xtemp)) then + boxshift=xtemp-boxsize + else if (dabs(xtemp+boxsize).lt.dabs(xtemp)) then + boxshift=xtemp+boxsize + else + boxshift=xtemp + endif + return + end +c-------------------------------------------------------------------------- + subroutine closest_img(xi,yi,zi,xj,yj,zj) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + integer xshift,yshift,zshift,subchap + double precision dist_init,xj_safe,yj_safe,zj_safe, + & xj_temp,yj_temp,zj_temp,dist_temp + xj_safe=xj + yj_safe=yj + zj_safe=zj + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + return + end +c-------------------------------------------------------------------------- + subroutine to_box(xi,yi,zi) + implicit none + include 'DIMENSIONS' + include 'COMMON.CHAIN' + double precision xi,yi,zi + xi=dmod(xi,boxxsize) + if (xi.lt.0.0d0) xi=xi+boxxsize + yi=dmod(yi,boxysize) + if (yi.lt.0.0d0) yi=yi+boxysize + zi=dmod(zi,boxzsize) + if (zi.lt.0.0d0) zi=zi+boxzsize + return + end +c-------------------------------------------------------------------------- + subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi) + implicit none + include 'DIMENSIONS' + include 'COMMON.CHAIN' + double precision xi,yi,zi,sslipi,ssgradlipi + double precision fracinbuf + double precision sscalelip,sscagradlip + + if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then +C the energy transfer exist + if (zi.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + return + end diff --git a/source/cluster/wham/src-HCD/energy_p_new.F b/source/cluster/wham/src-HCD/energy_p_new.F index 5d07d5d..119bad6 100644 --- a/source/cluster/wham/src-HCD/energy_p_new.F +++ b/source/cluster/wham/src-HCD/energy_p_new.F @@ -180,14 +180,23 @@ c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr #ifdef DFA C BARTEK for dfa test! + edfadis=0.0d0 if (wdfa_dist.gt.0) call edfad(edfadis) c write(iout,*)'edfad is finished!', wdfa_dist,edfadis + edfator=0.0d0 if (wdfa_tor.gt.0) call edfat(edfator) c write(iout,*)'edfat is finished!', wdfa_tor,edfator + edfanei=0.0d0 if (wdfa_nei.gt.0) call edfan(edfanei) c write(iout,*)'edfan is finished!', wdfa_nei,edfanei + edfabet=0.0d0 if (wdfa_beta.gt.0) call edfab(edfabet) c write(iout,*)'edfab is finished!', wdfa_beta,edfabet +#else + edfadis=0.0d0 + edfator=0.0d0 + edfanei=0.0d0 + edfabet=0.0d0 #endif #ifdef SPLITELE @@ -511,6 +520,9 @@ C Bartek edfator = energia(29) edfanei = energia(30) edfabet = energia(31) + Eafmforc=0.0d0 + etube=0.0d0 + Uconst=0.0d0 #ifdef SPLITELE write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp, & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1), @@ -674,6 +686,7 @@ cROZNICA xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) C Change 12/1/95 num_conti=0 C @@ -688,6 +701,10 @@ cd & 'iend=',iend(i,iint) xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) C Change 12/1/95 to calculate four-body interactions rij=xj*xj+yj*yj+zj*zj rrij=1.0D0/rij @@ -857,6 +874,7 @@ c enddo xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) C C Calculate SC interaction energy. C @@ -867,6 +885,10 @@ C xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) fac_augm=rrij**expon e_augm=augm(itypi,itypj)*fac_augm @@ -972,6 +994,7 @@ c endif xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1004,9 +1027,13 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -1110,35 +1137,8 @@ c if (icall.gt.0) lprn=.true. yi=c(2,nres+i) zi=c(3,nres+i) C returning the ith atom to box - xi=mod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=mod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=mod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize - if ((zi.gt.bordlipbot) - &.and.(zi.lt.bordliptop)) then -C the energy transfer exist - if (zi.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((zi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipi=sscalelip(fracinbuf) - ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) - sslipi=sscalelip(fracinbuf) - ssgradlipi=sscagradlip(fracinbuf)/lipbufthick - else - sslipi=1.0d0 - ssgradlipi=0.0 - endif - else - sslipi=0.0d0 - ssgradlipi=0.0 - endif - + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1196,80 +1196,15 @@ c alf12=0.0D0 yj=c(2,nres+j) zj=c(3,nres+j) C returning jth atom to box - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.gt.bordlipbot) - &.and.(zj.lt.bordliptop)) then -C the energy transfer exist - if (zj.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((zj-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipj=sscalelip(fracinbuf) - ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick - elseif (zj.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) - sslipj=sscalelip(fracinbuf) - ssgradlipj=sscagradlip(fracinbuf)/lipbufthick - else - sslipj=1.0d0 - ssgradlipj=0.0 - endif - else - sslipj=0.0d0 - ssgradlipj=0.0 - endif - aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 - bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 -C if (aa.ne.aa_aq(itypi,itypj)) then - -C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa, -C & bb_aq(itypi,itypj)-bb, -C & sslipi,sslipj -C endif - -C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj) -C checking the distance - dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 -C finding the closest - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - subchap=1 - endif - enddo - enddo - enddo - if (subchap.eq.1) then - xj=xj_temp-xi - yj=yj_temp-yi - zj=zj_temp-zi - else - xj=xj_safe-xi - yj=yj_safe-yi - zj=zj_safe-zi - endif - + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -1391,6 +1326,8 @@ c if (icall.gt.0) lprn=.true. xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1425,9 +1362,15 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -2256,12 +2199,7 @@ c end if xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi - xmedi=mod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=mod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=mod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize + call to_box(xmedi,ymedi,zmedi) num_conti=0 call eelecij(i,i+2,ees,evdw1,eel_loc) if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) @@ -2291,38 +2229,7 @@ c & .or. itype(i-1).eq.ntyp1 xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi -C Return atom into box, boxxsize is size of box in x dimension -c 194 continue -c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize -c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize -C Condition for being inside the proper box -c if ((xmedi.gt.((0.5d0)*boxxsize)).or. -c & (xmedi.lt.((-0.5d0)*boxxsize))) then -c go to 194 -c endif -c 195 continue -c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize -c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize -C Condition for being inside the proper box -c if ((ymedi.gt.((0.5d0)*boxysize)).or. -c & (ymedi.lt.((-0.5d0)*boxysize))) then -c go to 195 -c endif -c 196 continue -c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize -c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize -C Condition for being inside the proper box -c if ((zmedi.gt.((0.5d0)*boxzsize)).or. -c & (zmedi.lt.((-0.5d0)*boxzsize))) then -c go to 196 -c endif - xmedi=mod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=mod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=mod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize - + call to_box(xmedi,ymedi,zmedi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -2362,43 +2269,7 @@ c & .or. itype(i-1).eq.ntyp1 xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi - xmedi=mod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=mod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=mod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize -C xmedi=xmedi+xshift*boxxsize -C ymedi=ymedi+yshift*boxysize -C zmedi=zmedi+zshift*boxzsize - -C Return tom into box, boxxsize is size of box in x dimension -c 164 continue -c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize -c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize -C Condition for being inside the proper box -c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or. -c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then -c go to 164 -c endif -c 165 continue -c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize -c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize -C Condition for being inside the proper box -c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or. -c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then -c go to 165 -c endif -c 166 continue -c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize -c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize -cC Condition for being inside the proper box -c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or. -c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then -c go to 166 -c endif - -c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) + call to_box(xmedi,ymedi,zmedi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -2503,75 +2374,11 @@ C zj=c(3,j)+0.5D0*dzj-zmedi xj=c(1,j)+0.5D0*dxj yj=c(2,j)+0.5D0*dyj zj=c(3,j)+0.5D0*dzj - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ" - dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - isubchap=0 - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - isubchap=1 - endif - enddo - enddo - enddo - if (isubchap.eq.1) then - xj=xj_temp-xmedi - yj=yj_temp-ymedi - zj=zj_temp-zmedi - else - xj=xj_safe-xmedi - yj=yj_safe-ymedi - zj=zj_safe-zmedi - endif -C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC -c 174 continue -c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize -c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize -C Condition for being inside the proper box -c if ((xj.gt.((0.5d0)*boxxsize)).or. -c & (xj.lt.((-0.5d0)*boxxsize))) then -c go to 174 -c endif -c 175 continue -c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize -c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize -C Condition for being inside the proper box -c if ((yj.gt.((0.5d0)*boxysize)).or. -c & (yj.lt.((-0.5d0)*boxysize))) then -c go to 175 -c endif -c 176 continue -c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize -c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize -C Condition for being inside the proper box -c if ((zj.gt.((0.5d0)*boxzsize)).or. -c & (zj.lt.((-0.5d0)*boxzsize))) then -c go to 176 -c endif -C endif !endPBC condintion -C xj=xj-xmedi -C yj=yj-ymedi -C zj=zj-zmedi + call to_box(xj,yj,zj) + xj=boxshift(xj-xmedi,boxxsize) + yj=boxshift(yj-ymedi,boxysize) + zj=boxshift(zj-zmedi,boxzsize) rij=xj*xj+yj*yj+zj*zj - sss=sscale(sqrt(rij)) if (sss.eq.0.0d0) return sssgrad=sscagrad(sqrt(rij)) @@ -4055,12 +3862,7 @@ c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) yi=0.5D0*(c(2,i)+c(2,i+1)) zi=0.5D0*(c(3,i)+c(3,i+1)) C Returning the ith atom to box - xi=mod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=mod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=mod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize + call to_box(xi,yi,zi) do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) @@ -4075,44 +3877,10 @@ C Uncomment following three lines for Ca-p interactions yj=c(2,j) zj=c(3,j) C returning the jth atom to box - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 -C Finding the closest jth atom - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - subchap=1 - endif - enddo - enddo - enddo - if (subchap.eq.1) then - xj=xj_temp-xi - yj=yj_temp-yi - zj=zj_temp-zi - else - xj=xj_safe-xi - yj=yj_safe-yi - zj=zj_safe-zi - endif + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) C sss is scaling function for smoothing the cutoff gradient otherwise C the gradient would not be continuouse @@ -10217,7 +9985,6 @@ c min_odl=minval(distancek) & min_odl=distancek(kk) enddo endif - c write (iout,* )"min_odl",min_odl #ifdef DEBUG write (iout,*) "ij dij",i,j,dij diff --git a/source/cluster/wham/src-HCD/include_unres/COMMON.CONTMAT b/source/cluster/wham/src-HCD/include_unres/COMMON.CONTMAT index f0b6122..6e5b5d5 100644 --- a/source/cluster/wham/src-HCD/include_unres/COMMON.CONTMAT +++ b/source/cluster/wham/src-HCD/include_unres/COMMON.CONTMAT @@ -17,8 +17,9 @@ C 12/26/95 - H-bonding contacts & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), & ees0m(maxconts,maxres),d_cont(maxconts,maxres), & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions + double precision a_chuj,a_chuj_der + common /dipmat/ a_chuj(2,2,maxconts,maxres), + & a_chuj_der(2,2,3,5,maxconts,maxres) c 7/25/08 Commented out; not needed when cumulants used C Interactions of pseudo-dipoles generated by loc-el interactions. c double precision dip,dipderg,dipderx diff --git a/source/cluster/wham/src-HCD/include_unres/COMMON.CORRMAT b/source/cluster/wham/src-HCD/include_unres/COMMON.CORRMAT index 5f154e0..ae25625 100644 --- a/source/cluster/wham/src-HCD/include_unres/COMMON.CORRMAT +++ b/source/cluster/wham/src-HCD/include_unres/COMMON.CORRMAT @@ -30,9 +30,6 @@ C consecutive amino-acid residues. & costab2(maxres),sintab2(maxres) C This common block contains dipole-interaction matrices and their C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, & AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont,EAEA,EAEAderg,EAEAderx, diff --git a/source/cluster/wham/src-HCD/include_unres/COMMON.DERIV b/source/cluster/wham/src-HCD/include_unres/COMMON.DERIV index f1f5db5..9b47a73 100644 --- a/source/cluster/wham/src-HCD/include_unres/COMMON.DERIV +++ b/source/cluster/wham/src-HCD/include_unres/COMMON.DERIV @@ -15,7 +15,9 @@ & gdfad,gdfat,gdfan,gdfab integer nfl,icg logical calc_grad - common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), +c common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), +c 3/12/20 Adam: Arrays dcdv, dxdv, and dxds removed following recoding of gradient. + common /derivat/ & gradx(3,-1:maxres,2),gradc(3,-1:maxres,2),gvdwx(3,-1:maxres), & gvdwc(3,-1:maxres),gelc(3,-1:maxres),gelc_long(3,-1:maxres), & gvdwpp(3,-1:maxres),gvdwc_scpp(3,-1:maxres), diff --git a/source/cluster/wham/src-HCD/initialize_p.F b/source/cluster/wham/src-HCD/initialize_p.F index 87e4dde..aa675e9 100644 --- a/source/cluster/wham/src-HCD/initialize_p.F +++ b/source/cluster/wham/src-HCD/initialize_p.F @@ -174,10 +174,10 @@ C Initialize the bridge arrays do i=1,maxss iss(i)=0 enddo - do i=1,maxss + do i=1,maxdim_cont dhpb(i)=0.0D0 enddo - do i=1,maxss + do i=1,maxdim_cont ihpb(i)=0 jhpb(i)=0 enddo diff --git a/source/cluster/wham/src-HCD/probabl.F b/source/cluster/wham/src-HCD/probabl.F index a3a664b..40791a3 100644 --- a/source/cluster/wham/src-HCD/probabl.F +++ b/source/cluster/wham/src-HCD/probabl.F @@ -152,6 +152,8 @@ c call pdbout(totfree(i),16,i) c call flush(iout) #ifdef DEBUG write (iout,*) "conformation", i + write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), + & ((c(l,k+nres),l=1,3),k=nnt,nct) call enerprint(energia(0),fT) #endif etot=energia(0) diff --git a/source/cluster/wham/src-HCD/readpdb.F b/source/cluster/wham/src-HCD/readpdb.F index 58c63e4..f7cfb86 100644 --- a/source/cluster/wham/src-HCD/readpdb.F +++ b/source/cluster/wham/src-HCD/readpdb.F @@ -77,7 +77,7 @@ c write (2,*) "UNRES_PDB",unres_pdb sccalc=.true. endif ! Read free energy - if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp +c if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp ! Fish out the ATOM cards. if (index(card(1:4),'ATOM').gt.0) then sccalc=.false. diff --git a/source/cluster/wham/src-HCD/readrtns.F b/source/cluster/wham/src-HCD/readrtns.F index a3229a6..057f1ac 100644 --- a/source/cluster/wham/src-HCD/readrtns.F +++ b/source/cluster/wham/src-HCD/readrtns.F @@ -242,8 +242,8 @@ C Read weights of the subsequent energy terms. do i=1,maxres dyn_ss_mask(i)=.false. enddo - do i=1,maxres-1 - do j=i+1,maxres + do i=1,max_cyst-1 + do j=i+1,max_cyst dyn_ssbond_ij(i,j)=1.0d300 enddo enddo @@ -716,6 +716,12 @@ C Read information about disulfide bridges. C Read bridging residues. read (inp,*) ns,(iss(i),i=1,ns) c print *,'ns=',ns +c 5/24/2020 Adam: Added a table to translate residue numbers to cysteine +c numbers + icys=0 + do i=1,ns + icys(iss(i))=i + enddo C Check whether the specified bridging residues are cystines. do i=1,ns if (itype(iss(i)).ne.1) then diff --git a/source/cluster/wham/src-HCD/ssMD.F b/source/cluster/wham/src-HCD/ssMD.F index 9c23fe0..9b2908f 100644 --- a/source/cluster/wham/src-HCD/ssMD.F +++ b/source/cluster/wham/src-HCD/ssMD.F @@ -3,7 +3,6 @@ c---------------------------------------------------------------------------- c implicit none c Includes - implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.CHAIN' include 'COMMON.VAR' @@ -83,12 +82,8 @@ ct rij=ran_number(rmin,rmax) end C----------------------------------------------------------------------------- - subroutine dyn_ssbond_ene(resi,resj,eij) -c implicit none - -c Includes - implicit real*8 (a-h,o-z) + implicit none include 'DIMENSIONS' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' @@ -98,9 +93,10 @@ c Includes include 'COMMON.VAR' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.NAMES' #ifndef CLUST #ifndef WHAM -C include 'COMMON.MD' + include 'COMMON.MD' #endif #endif @@ -130,7 +126,10 @@ c integer itypi,itypj,k,l double precision omega,delta_inv,deltasq_inv,fac1,fac2 c-------FIRST METHOD double precision xm,d_xm(1:3) - integer xshift,yshift,zshift + double precision sslipi,sslipj,ssgradlipi,ssgradlipj + integer ici,icj,itypi,itypj + double precision boxshift,sscale,sscagrad + double precision aa,bb c-------END FIRST METHOD c-------SECOND METHOD c$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3) @@ -141,129 +140,50 @@ c-------TESTING CODE common /sschecks/ checkstop,transgrad integer icheck,nicheck,jcheck,njcheck - double precision echeck(-1:1),deps,ssx0,ljx0 + double precision echeck(-1:1),deps,ssx0,ljx0,xi,yi,zi c-------END TESTING CODE i=resi j=resj - + ici=icys(i) + icj=icys(j) + if (ici.eq.0 .or. icj.eq.0) then + write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') + & "Attempt to create", + & " a disulfide link between non-cysteine residues ",restyp(i),i, + & restyp(j),j + stop + endif itypi=itype(i) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) dsci_inv=vbld_inv(i+nres) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - xi=dmod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=dmod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=dmod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + call to_box(xi,yi,zi) C define scaling factor for lipids C if (positi.le.0) positi=positi+boxzsize C print *,i C first for peptide groups c for each residue check if it is in lipid or lipid water border area - if ((zi.gt.bordlipbot) - &.and.(zi.lt.bordliptop)) then -C the energy transfer exist - if (zi.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((positi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipi=sscalelip(fracinbuf) - ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) - sslipi=sscalelip(fracinbuf) - ssgradlipi=sscagradlip(fracinbuf)/lipbufthick - else - sslipi=1.0d0 - ssgradlipi=0.0 - endif - else - sslipi=0.0d0 - ssgradlipi=0.0 - endif - + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) itypj=itype(j) - xj=c(1,nres+j) - yj=c(2,nres+j) - zj=c(3,nres+j) - xj=dmod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=dmod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=dmod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.gt.bordlipbot) - &.and.(zj.lt.bordliptop)) then -C the energy transfer exist - if (zj.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((positi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipj=sscalelip(fracinbuf) - ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) - sslipj=sscalelip(fracinbuf) - ssgradlipj=sscagradlip(fracinbuf)/lipbufthick - else - sslipj=1.0d0 - ssgradlipj=0.0 - endif - else - sslipj=0.0d0 - ssgradlipj=0.0 - endif + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 - - dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - subchap=1 - endif - enddo - enddo - enddo - if (subchap.eq.1) then - xj=xj_temp-xi - yj=yj_temp-yi - zj=zj_temp-zi - else - xj=xj_safe-xi - yj=yj_safe-yi - zj=zj_safe-zi - endif - + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -281,6 +201,8 @@ C lipbufthick is thickenes of lipid buffore rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse + sss=sscale((1.0d0/rij)/sigma(itypi,itypj)) + sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj)) c The following are set in sc_angular c erij(1)=xj*rij c erij(2)=yj*rij @@ -360,15 +282,15 @@ c-------END TESTING CODE e1=fac*fac*aa e2=fac*bb eij=eps1*eps2rt*eps3rt*(e1+e2) -C write(iout,*) eij,'TU?1' eps2der=eij*eps3rt eps3der=eij*eps2rt - eij=eij*eps2rt*eps3rt + eij=eij*eps2rt*eps3rt*sss sigder=-sig/sigsq e1=e1*eps1*eps2rt**2*eps3rt**2 ed=-expon*(e1+eij)/ljd sigder=ed*sigder + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 eom12=eij*eps1_om12+eps2der*eps2rt_om12 @@ -377,8 +299,9 @@ C write(iout,*) eij,'TU?1' havebond=.true. ssd=rij-ssXs eij=ssA*ssd*ssd+ssB*ssd+ssC -C write(iout,*) 'TU?2',ssc,ssd + eij=eij*sss ed=2*akcm*ssd+akct*deltat12 + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij pom1=akct*ssd pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi eom1=-2*akth*deltat1-pom1-om2*pom2 @@ -413,13 +336,14 @@ c-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE h1=h_base(f1,hd1) h2=h_base(f2,hd2) eij=ssm*h1+Ht*h2 -C write(iout,*) eij,'TU?3' delta_inv=1.0d0/(xm-ssxm) deltasq_inv=delta_inv*delta_inv fac=ssm*hd1-Ht*hd2 fac1=deltasq_inv*fac*(xm-rij) fac2=deltasq_inv*fac*(rij-ssxm) ed=delta_inv*(Ht*hd2-ssm*hd1) + eij=eij*sss + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1) eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2) eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3) @@ -436,13 +360,14 @@ C write(iout,*) eij,'TU?3' h1=h_base(f1,hd1) h2=h_base(f2,hd2) eij=Ht*h1+ljm*h2 -C write(iout,*) 'TU?4',ssA delta_inv=1.0d0/(ljxm-xm) deltasq_inv=delta_inv*delta_inv fac=Ht*hd1-ljm*hd2 fac1=deltasq_inv*fac*(ljxm-rij) fac2=deltasq_inv*fac*(rij-xm) ed=delta_inv*(ljm*hd2-Ht*hd1) + eij=eij*sss + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1) eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2) eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3) @@ -508,7 +433,7 @@ c$$$ if (ed.gt.0.0d0) havebond=.true. c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE endif -C write(iout,*) 'havebond',havebond + if (havebond) then #ifndef CLUST #ifndef WHAM @@ -518,9 +443,10 @@ c & "SSBOND_E_FORM",totT,t_bath,i,j c endif #endif #endif - dyn_ssbond_ij(i,j)=eij - else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then - dyn_ssbond_ij(i,j)=1.0d300 + dyn_ssbond_ij(ici,icj)=eij + else if (.not.havebond .and. dyn_ssbond_ij(ici,icj).lt.1.0d300) + &then + dyn_ssbond_ij(ici,icj)=1.0d300 #ifndef CLUST #ifndef WHAM c write(iout,'(a15,f12.2,f8.1,2i5)') @@ -545,6 +471,8 @@ c-------TESTING CODE checkstop=.false. endif c-------END TESTING CODE + gg_lipi(3)=ssgradlipi*eij + gg_lipj(3)=ssgradlipj*eij do k=1,3 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij @@ -554,10 +482,10 @@ c-------END TESTING CODE gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) enddo do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) + gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k) & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwx(k,j)=gvdwx(k,j)+gg(k) + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k) & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv enddo @@ -568,13 +496,12 @@ cgrad enddo cgrad enddo do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l) - gvdwc(l,j)=gvdwc(l,j)+gg(l) + gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(k) + gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(k) enddo return end - C----------------------------------------------------------------------------- double precision function h_base(x,deriv) @@ -615,15 +542,12 @@ c$$$ deriv=30.0d0*xsq*deriv return end - c---------------------------------------------------------------------------- - subroutine dyn_set_nss c Adjust nss and other relevant variables based on dyn_ssbond_ij c implicit none c Includes - implicit real*8 (a-h,o-z) include 'DIMENSIONS' #ifdef MPI include "mpif.h" @@ -641,16 +565,16 @@ C include 'COMMON.MD' c Local variables double precision emin integer i,j,imin - integer diff,allflag(maxdim),allnss, - & allihpb(maxdim),alljhpb(maxdim), - & newnss,newihpb(maxdim),newjhpb(maxdim) + integer diff,allflag(maxdim_cont),allnss, + & allihpb(maxdim_cont),alljhpb(maxdim_cont), + & newnss,newihpb(maxdim_cont),newjhpb(maxdim_cont) logical found integer i_newnss(1024),displ(0:1024) - integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss + integer g_newihpb(maxdim_cont),g_newjhpb(maxdim_cont),g_newnss allnss=0 - do i=1,nres-1 - do j=i+1,nres + do i=1,ns-1 + do j=i+1,ns if (dyn_ssbond_ij(i,j).lt.1.0d300) then allnss=allnss+1 allflag(allnss)=0 @@ -768,1268 +692,34 @@ c & "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i) return end +c---------------------------------------------------------------------------- -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ integer i,iretcode,nfun_sc -c$$$ logical scfail -c$$$ double precision var(maxvar),e_sc,etot -c$$$ -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$c Minimize the two selected side-chains -c$$$ call overlap_sc(scfail) ! Better not fail! -c$$$ call minimize_sc(e_sc,var,iretcode,nfun_sc) -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------------- -c$$$ -c$$$ subroutine minimize_sc(etot_sc,iretcode,nfun) -c$$$c Minimize side-chains only, starting from geom but without modifying -c$$$c bond lengths. -c$$$c If mask_r is already set, only the selected side-chains are minimized, -c$$$c otherwise all side-chains are minimized keeping the backbone frozen. -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ integer icall -c$$$ common /srutu/ icall -c$$$ -c$$$c Output arguments -c$$$ double precision etot_sc -c$$$ integer iretcode,nfun -c$$$ -c$$$c External functions/subroutines -c$$$ external func_sc,grad_sc,fdum -c$$$ -c$$$c Local variables -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -c$$$ integer iv(liv) -c$$$ double precision rdum(1) -c$$$ double precision d(maxvar),v(1:lv),x(maxvar),xx(maxvar) -c$$$ integer idum(1) -c$$$ integer i,nvar_restr -c$$$ -c$$$ -c$$$cmc start_minim=.true. -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=1 -c$$$* selects output unit -c$$$ iv(21)=0 -c$$$c iv(21)=iout ! DEBUG -c$$$c iv(21)=8 ! DEBUG -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$c iv(22)=1 ! DEBUG -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$c iv(23)=1 ! DEBUG -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$c iv(24)=1 ! DEBUG -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-1 -c$$$ v(32)=rtolf -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,nphi -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ do i=nphi+1,nvar -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ -c$$$ call geom_to_var(nvar,x) -c$$$ IF (mask_r) THEN -c$$$ do i=1,nres ! Just in case... -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ELSE -c$$$c When minimizing ALL side-chains, etotal_sc is a little -c$$$c faster if we don't set mask_r -c$$$ do i=1,nres -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ mask_side(i)=1 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ENDIF -c$$$ call var_to_geom(nvar,x) -c$$$ call chainbuild_sc -c$$$ etot_sc=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6) -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine chainbuild_sc -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Local variables -c$$$ integer i -c$$$ -c$$$ -c$$$ do i=nnt,nct -c$$$ if (.not.mask_r .or. mask_side(i).eq.1) then -c$$$ call locate_side_chain(i) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision f -c$$$ -c$$$c Local variables -c$$$ double precision energia(0:n_ene) -c$$$#ifdef OSF -c$$$c Variables used to intercept NaNs -c$$$ double precision x_sum -c$$$ integer i_NAN -c$$$#endif -c$$$ -c$$$ -c$$$ nfl=nf -c$$$ icg=mod(nf,2)+1 -c$$$ -c$$$#ifdef OSF -c$$$c Intercept NaNs in the coordinates, before calling etotal_sc -c$$$ x_sum=0.D0 -c$$$ do i_NAN=1,n -c$$$ x_sum=x_sum+x(i_NAN) -c$$$ enddo -c$$$c Calculate the energy only if the coordinates are ok -c$$$ if ((.not.(x_sum.lt.0.D0)) .and. (.not.(x_sum.ge.0.D0))) then -c$$$ write(iout,*)" *** func_restr_sc : Found NaN in coordinates" -c$$$ f=1.0D+77 -c$$$ nf=0 -c$$$ else -c$$$#endif -c$$$ -c$$$ call var_to_geom_restr(n,x) -c$$$ call zerograd -c$$$ call chainbuild_sc -c$$$ call etotal_sc(energia(0)) -c$$$ f=energia(0) -c$$$ if (energia(1).eq.1.0D20 .or. energia(0).eq.1.0D99) nf=0 -c$$$ -c$$$#ifdef OSF -c$$$ endif -c$$$#endif -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------- -c$$$ -c$$$ subroutine grad_sc(n,x,nf,g,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.MINIM' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision g(maxvar) -c$$$ -c$$$c Local variables -c$$$ double precision f,gphii,gthetai,galphai,gomegai -c$$$ integer ig,ind,i,j,k,igall,ij -c$$$ -c$$$ -c$$$ icg=mod(nf,2)+1 -c$$$ if (nf-nfl+1) 20,30,40 -c$$$ 20 call func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$c write (iout,*) 'grad 20' -c$$$ if (nf.eq.0) return -c$$$ goto 40 -c$$$ 30 call var_to_geom_restr(n,x) -c$$$ call chainbuild_sc -c$$$C -c$$$C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -c$$$C -c$$$ 40 call cartder -c$$$C -c$$$C Convert the Cartesian gradient into internal-coordinate gradient. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ ind=nres-2 -c$$$ do i=2,nres-2 -c$$$ IF (mask_phi(i+2).eq.1) THEN -c$$$ gphii=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) -c$$$ gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ ig=ig+1 -c$$$ g(ig)=gphii -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ -c$$$ ind=0 -c$$$ do i=1,nres-2 -c$$$ IF (mask_theta(i+2).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gthetai=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) -c$$$ gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ g(ig)=gthetai -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ galphai=0.0D0 -c$$$ do k=1,3 -c$$$ galphai=galphai+dxds(k,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=galphai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gomegai=0.0D0 -c$$$ do k=1,3 -c$$$ gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=gomegai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$C -c$$$C Add the components corresponding to local energy terms. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ igall=0 -c$$$ do i=4,nres -c$$$ igall=igall+1 -c$$$ if (mask_phi(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do i=3,nres -c$$$ igall=igall+1 -c$$$ if (mask_theta(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do ij=1,2 -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ igall=igall+1 -c$$$ if (mask_side(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ endif -c$$$ enddo -c$$$ enddo -c$$$ -c$$$cd do i=1,ig -c$$$cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -c$$$cd enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine etotal_sc(energy_sc) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.FFIELD' -c$$$ -c$$$c Output arguments -c$$$ double precision energy_sc(0:n_ene) -c$$$ -c$$$c Local variables -c$$$ double precision evdw,escloc -c$$$ integer i,j -c$$$ -c$$$ -c$$$ do i=1,n_ene -c$$$ energy_sc(i)=0.0D0 -c$$$ enddo -c$$$ -c$$$ if (mask_r) then -c$$$ call egb_sc(evdw) -c$$$ call esc_sc(escloc) -c$$$ else -c$$$ call egb(evdw) -c$$$ call esc(escloc) -c$$$ endif -c$$$ -c$$$ if (evdw.eq.1.0D20) then -c$$$ energy_sc(0)=evdw -c$$$ else -c$$$ energy_sc(0)=wsc*evdw+wscloc*escloc -c$$$ endif -c$$$ energy_sc(1)=evdw -c$$$ energy_sc(12)=escloc -c$$$ -c$$$C -c$$$C Sum up the components of the Cartesian gradient. -c$$$C -c$$$ do i=1,nct -c$$$ do j=1,3 -c$$$ gradx(j,i,icg)=wsc*gvdwx(j,i) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_sc(evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$c if (icall.eq.0) lprn=.false. -c$$$ ind=0 -c$$$ do i=iatsc_s,iatsc_e -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$ do iint=1,nint_gr(i) -c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$ ENDIF -c$$$ enddo ! j -c$$$ enddo ! iint -c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine esc_sc(escloc) -c$$$C Calculate the local energy of a side chain and its derivatives in the -c$$$C corresponding virtual-bond valence angles THETA and the spherical angles -c$$$C ALPHA and OMEGA. -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.FFIELD' -c$$$ include 'COMMON.CONTROL' -c$$$ double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), -c$$$ & ddersc0(3),ddummy(3),xtemp(3),temp(3) -c$$$ common /sccalc/ time11,time12,time112,theti,it,nlobit -c$$$ delta=0.02d0*pi -c$$$ escloc=0.0D0 -c$$$c write (iout,'(a)') 'ESC' -c$$$ do i=loc_start,loc_end -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ it=itype(i) -c$$$ if (it.eq.10) goto 1 -c$$$ nlobit=nlob(it) -c$$$c print *,'i=',i,' it=',it,' nlobit=',nlobit -c$$$c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad -c$$$ theti=theta(i+1)-pipol -c$$$ x(1)=dtan(theti) -c$$$ x(2)=alph(i) -c$$$ x(3)=omeg(i) -c$$$ -c$$$ if (x(2).gt.pi-delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=pi-delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=pi-delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c escloci=esclocbi -c$$$c write (iout,*) escloci -c$$$ else if (x(2).lt.delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c write (iout,*) escloci -c$$$ else -c$$$ call enesc(x,escloci,dersc,ddummy,.false.) -c$$$ endif -c$$$ -c$$$ escloc=escloc+escloci -c$$$ if (energy_dec) write (iout,'(a6,i,0pf7.3)') -c$$$ & 'escloc',i,escloci -c$$$c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc -c$$$ -c$$$ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ -c$$$ & wscloc*dersc(1) -c$$$ gloc(ialph(i,1),icg)=wscloc*dersc(2) -c$$$ gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) -c$$$ 1 continue -c$$$ ENDIF -c$$$ enddo -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_ij(i_sc,j_sc,evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$ ind=0 -c$$$c$$$ do i=iatsc_s,iatsc_e -c$$$ i=i_sc -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$c$$$ do iint=1,nint_gr(i) -c$$$c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ j=j_sc -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$c$$$ enddo ! j -c$$$c$$$ enddo ! iint -c$$$c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine perturb_side_chain(i,angle) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i -c$$$ double precision angle ! In degrees -c$$$ -c$$$c Local variables -c$$$ integer i_sc -c$$$ double precision rad_ang,rand_v(3),length,cost,sint -c$$$ -c$$$ -c$$$ i_sc=i+nres -c$$$ rad_ang=angle*deg2rad -c$$$ -c$$$ length=0.0 -c$$$ do while (length.lt.0.01) -c$$$ rand_v(1)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(2)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(3)=ran_number(0.01D0,1.0D0) -c$$$ length=rand_v(1)*rand_v(1)+rand_v(2)*rand_v(2)+ -c$$$ + rand_v(3)*rand_v(3) -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ cost=rand_v(1)*dc_norm(1,i_sc)+rand_v(2)*dc_norm(2,i_sc)+ -c$$$ + rand_v(3)*dc_norm(3,i_sc) -c$$$ length=1.0D0-cost*cost -c$$$ if (length.lt.0.0D0) length=0.0D0 -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)-cost*dc_norm(1,i_sc) -c$$$ rand_v(2)=rand_v(2)-cost*dc_norm(2,i_sc) -c$$$ rand_v(3)=rand_v(3)-cost*dc_norm(3,i_sc) -c$$$ enddo -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ -c$$$ cost=dcos(rad_ang) -c$$$ sint=dsin(rad_ang) -c$$$ dc(1,i_sc)=vbld(i_sc)*(dc_norm(1,i_sc)*cost+rand_v(1)*sint) -c$$$ dc(2,i_sc)=vbld(i_sc)*(dc_norm(2,i_sc)*cost+rand_v(2)*sint) -c$$$ dc(3,i_sc)=vbld(i_sc)*(dc_norm(3,i_sc)*cost+rand_v(3)*sint) -c$$$ dc_norm(1,i_sc)=dc(1,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(2,i_sc)=dc(2,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(3,i_sc)=dc(3,i_sc)*vbld_inv(i_sc) -c$$$ c(1,i_sc)=c(1,i)+dc(1,i_sc) -c$$$ c(2,i_sc)=c(2,i)+dc(2,i_sc) -c$$$ c(3,i_sc)=c(3,i)+dc(3,i_sc) -c$$$ -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax3(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ double precision energy_sc(0:n_ene),etot -c$$$ double precision org_dc(3),org_dc_norm(3),org_c(3) -c$$$ double precision ang_pert,rand_fact,exp_fact,beta -c$$$ integer n,i_pert,i -c$$$ logical notdone -c$$$ -c$$$ -c$$$ beta=1.0D0 -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$ call etotal_sc(energy_sc) -c$$$ etot=energy_sc(0) -c$$$c write(iout,'(a,3d15.5)')" SS_MC_START ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ -c$$$ notdone=.true. -c$$$ n=0 -c$$$ do while (notdone) -c$$$ if (mod(n,2).eq.0) then -c$$$ i_pert=i_in -c$$$ else -c$$$ i_pert=j_in -c$$$ endif -c$$$ n=n+1 -c$$$ -c$$$ do i=1,3 -c$$$ org_dc(i)=dc(i,i_pert+nres) -c$$$ org_dc_norm(i)=dc_norm(i,i_pert+nres) -c$$$ org_c(i)=c(i,i_pert+nres) -c$$$ enddo -c$$$ ang_pert=ran_number(0.0D0,3.0D0) -c$$$ call perturb_side_chain(i_pert,ang_pert) -c$$$ call etotal_sc(energy_sc) -c$$$ exp_fact=exp(beta*(etot-energy_sc(0))) -c$$$ rand_fact=ran_number(0.0D0,1.0D0) -c$$$ if (rand_fact.lt.exp_fact) then -c$$$c write(iout,'(a,3d15.5)')" SS_MC_ACCEPT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ etot=energy_sc(0) -c$$$ else -c$$$c write(iout,'(a,3d15.5)')" SS_MC_REJECT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ do i=1,3 -c$$$ dc(i,i_pert+nres)=org_dc(i) -c$$$ dc_norm(i,i_pert+nres)=org_dc_norm(i) -c$$$ c(i,i_pert+nres)=org_c(i) -c$$$ enddo -c$$$ endif -c$$$ -c$$$ if (n.eq.10000.or.etot.lt.30.0D0) notdone=.false. -c$$$ enddo -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax2(etot,iretcode,nfun,i_in,j_in) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxres6*(maxres6+17)/2)) -c$$$********************************************************************* -c$$$* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for * -c$$$* the calling subprogram. * -c$$$* when d(i)=1.0, then v(35) is the length of the initial step, * -c$$$* calculated in the usual pythagorean way. * -c$$$* absolute convergence occurs when the function is within v(31) of * -c$$$* zero. unless you know the minimum value in advance, abs convg * -c$$$* is probably not useful. * -c$$$* relative convergence is when the model predicts that the function * -c$$$* will decrease by less than v(32)*abs(fun). * -c$$$********************************************************************* -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.CHAIN' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ double precision etot -c$$$ integer iretcode,nfun,i_in,j_in -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ external ss_func,fdum -c$$$ double precision ss_func,fdum -c$$$ -c$$$ integer iv(liv),uiparm(2) -c$$$ double precision v(lv),x(maxres6),d(maxres6),rdum -c$$$ integer i,j,k -c$$$ -c$$$ -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=2 -c$$$* selects output unit -c$$$c iv(21)=iout -c$$$ iv(21)=0 -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$ v(31)=1.0D-1 -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-4 -c$$$ v(32)=rtolf -c$$$ v(32)=1.0D-1 -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,6*nres -c$$$ d(i)=1.0D0 -c$$$ enddo -c$$$ -c$$$ do i=0,2*nres -c$$$ do j=1,3 -c$$$ orig_ss_dc(j,i)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ call geom_to_var(nvar,orig_ss_var) -c$$$ -c$$$ do i=1,nres -c$$$ do j=i,nres -c$$$ orig_ss_dist(j,i)=dist(j,i) -c$$$ orig_ss_dist(j+nres,i)=dist(j+nres,i) -c$$$ orig_ss_dist(j,i+nres)=dist(j,i+nres) -c$$$ orig_ss_dist(j+nres,i+nres)=dist(j+nres,i+nres) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i+nres) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ -c$$$ uiparm(1)=i_in -c$$$ uiparm(2)=j_in -c$$$ call smsno(k,d,x,ss_func,iv,liv,lv,v,uiparm,rdum,fdum) -c$$$ etot=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6)+iv(30) -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_func(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.SBRIDGE' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ integer n -c$$$ double precision x(maxres6) -c$$$ integer nf -c$$$ double precision f -c$$$ integer uiparm(2) -c$$$ real*8 urparm(1) -c$$$ external ufparm -c$$$ double precision ufparm -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ -c$$$ integer i,j,k,ss_i,ss_j -c$$$ double precision tempf,var(maxvar) -c$$$ -c$$$ -c$$$ ss_i=uiparm(1) -c$$$ ss_j=uiparm(2) -c$$$ f=0.0D0 -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ call geom_to_var(nvar,var) -c$$$ -c$$$c Constraints on all angles -c$$$ do i=1,nvar -c$$$ tempf=var(i)-orig_ss_var(i) -c$$$ f=f+tempf*tempf -c$$$ enddo -c$$$ -c$$$c Constraints on all distances -c$$$ do i=1,nres-1 -c$$$ if (i.gt.1) then -c$$$ tempf=dist(i+nres,i)-orig_ss_dist(i+nres,i) -c$$$ f=f+tempf*tempf -c$$$ endif -c$$$ do j=i+1,nres -c$$$ tempf=dist(j,i)-orig_ss_dist(j,i) -c$$$ if (tempf.lt.0.0D0 .or. j.eq.i+1) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i)-orig_ss_dist(j+nres,i) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j,i+nres)-orig_ss_dist(j,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i+nres)-orig_ss_dist(j+nres,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ enddo -c$$$ enddo -c$$$ -c$$$c Constraints for the relevant CYS-CYS -c$$$ tempf=dist(nres+ss_i,nres+ss_j)-8.0D0 -c$$$ f=f+tempf*tempf -c$$$CCCCCCCCCCCCCCCCC ADD SOME ANGULAR STUFF -c$$$ -c$$$c$$$ if (nf.ne.nfl) then -c$$$c$$$ write(iout,'(a,i10,2d15.5)')"IN DIST_FUNC (NF,F,DIST)",nf, -c$$$c$$$ + f,dist(5+nres,14+nres) -c$$$c$$$ endif -c$$$ -c$$$ nfl=nf -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$C----------------------------------------------------------------------------- - subroutine triple_ssbond_ene(resi,resj,resk,eij) - implicit real*8 (a-h,o-z) +#ifdef SSREAD +#ifdef WHAM + subroutine read_ssHist + implicit none + +c Includes + include 'DIMENSIONS' + include "DIMENSIONS.FREE" + include 'COMMON.FREE' + +c Local variables + integer i,j + character*80 controlcard + + do i=1,dyn_nssHist + call card_concat(controlcard,.true.) + read(controlcard,*) + & dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0)) + enddo + + return + end +#endif +#endif +c$$$C---------------------------------------------------------------------------- + subroutine triple_ssbond_ene(resi,resj,resk,eij) include 'DIMENSIONS' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' diff --git a/source/cluster/wham/src-HCD/wrtclust.f b/source/cluster/wham/src-HCD/wrtclust.f index fa08111..91fc05e 100644 --- a/source/cluster/wham/src-HCD/wrtclust.f +++ b/source/cluster/wham/src-HCD/wrtclust.f @@ -24,7 +24,7 @@ DATA EXTEN /'.pdb'/,extmol /'.mol2'/,NUMM /'000'/,MUMM /'000'/ external ilen logical viol_nmr - integer ib,list_peak_viol(maxdim) + integer ib,list_peak_viol(maxdim_cont) double precision Esaxs_all(maxgr),Pcalc_all(maxsaxs,maxgr) do i=1,64 diff --git a/source/unres/src-HCD-5D/COMMON.CHAIN b/source/unres/src-HCD-5D/COMMON.CHAIN index ec15fdc..da83764 100644 --- a/source/unres/src-HCD-5D/COMMON.CHAIN +++ b/source/unres/src-HCD-5D/COMMON.CHAIN @@ -1,9 +1,11 @@ integer nres,nsup,nstart_sup,nz_start,nz_end,iz_sc, & nres0,nstart_seq,nchain,chain_length,chain_border,iprzes, - & chain_border1,ireschain,tabpermchain,npermchain,afmend,afmbeg + & chain_border1,ireschain,tabpermchain,npermchain,afmend,afmbeg, + & nres_chomo,nmodel_start double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm,t,r, & prod,rt,dc_work,cref,crefjlee,dc_norm2,velAFMconst, & totTafm,chomo + character*256 pdbfiles_chomo(max_template) common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2), & xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2), & dc_norm2(3,0:maxres2), @@ -30,4 +32,6 @@ & totTafm common /tube/ tubecenter(3),tubeR0, & buftubebot, buftubetop,bordtubebot,bordtubetop,tubebufthick - common /chomo_models/ chomo(3,maxres2+2,max_template) + common /chomo_models/ chomo(3,maxres2+2,max_template), + & nres_chomo(max_template),nmodel_start + common /chomo_files/ pdbfiles_chomo diff --git a/source/unres/src-HCD-5D/COMMON.CONTMAT b/source/unres/src-HCD-5D/COMMON.CONTMAT index d65e291..8e7e4ff 100644 --- a/source/unres/src-HCD-5D/COMMON.CONTMAT +++ b/source/unres/src-HCD-5D/COMMON.CONTMAT @@ -19,8 +19,9 @@ C 12/26/95 - H-bonding contacts & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), & ees0m(maxconts,maxres),d_cont(maxconts,maxres), & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions + double precision a_chuj,a_chuj_der + common /dipmat/ a_chuj(2,2,maxconts,maxres), + & a_chuj_der(2,2,3,5,maxconts,maxres) c 7/25/08 Commented out; not needed when cumulants used C Interactions of pseudo-dipoles generated by loc-el interactions. c double precision dip,dipderg,dipderx diff --git a/source/unres/src-HCD-5D/COMMON.CORRMAT b/source/unres/src-HCD-5D/COMMON.CORRMAT index 5f154e0..ae25625 100644 --- a/source/unres/src-HCD-5D/COMMON.CORRMAT +++ b/source/unres/src-HCD-5D/COMMON.CORRMAT @@ -30,9 +30,6 @@ C consecutive amino-acid residues. & costab2(maxres),sintab2(maxres) C This common block contains dipole-interaction matrices and their C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, & AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont,EAEA,EAEAderg,EAEAderx, diff --git a/source/unres/src-HCD-5D/COMMON.HOMOLOGY b/source/unres/src-HCD-5D/COMMON.HOMOLOGY index f19f0c6..e9b6320 100644 --- a/source/unres/src-HCD-5D/COMMON.HOMOLOGY +++ b/source/unres/src-HCD-5D/COMMON.HOMOLOGY @@ -4,9 +4,10 @@ common /homol/ waga_homology(maxprocs/20), & waga_dist,waga_angle,waga_theta,waga_d,dist_cut,dist2_cut ! Restraint parameters - double precision odl(max_template,maxdim), - & sigma_odl(max_template,maxdim),dih(max_template,maxres), - & sigma_dih(max_template,maxres),sigma_odlir(max_template,maxdim) + double precision odl(max_template,maxdim_cont), + & sigma_odl(max_template,maxdim_cont),dih(max_template,maxres), + & sigma_dih(max_template,maxres), + & sigma_odlir(max_template,maxdim_cont) ! ! Specification of new variables used in subroutine e_modeller ! modified by FP (Nov.,2014) @@ -15,10 +16,10 @@ & 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, diff --git a/source/unres/src-HCD-5D/COMMON.INTERACT b/source/unres/src-HCD-5D/COMMON.INTERACT index 8e4e063..8c4876d 100644 --- a/source/unres/src-HCD-5D/COMMON.INTERACT +++ b/source/unres/src-HCD-5D/COMMON.INTERACT @@ -22,10 +22,14 @@ & 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, diff --git a/source/unres/src-HCD-5D/COMMON.SBRIDGE b/source/unres/src-HCD-5D/COMMON.SBRIDGE index e5f9a33..a71e1de 100644 --- a/source/unres/src-HCD-5D/COMMON.SBRIDGE +++ b/source/unres/src-HCD-5D/COMMON.SBRIDGE @@ -1,21 +1,23 @@ double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss - integer ns,nss,nfree,iss + integer ns,nss,nfree,iss,icys common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, - & ns,nss,nfree,iss(maxss) + & ns,nss,nfree,iss(max_cyst),icys(maxres) double precision dhpb,dhpb1,forcon,fordepth,xlscore,wboltzd, & dhpb_peak,dhpb1_peak,forcon_peak,fordepth_peak,scal_peak,bfac integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb,ibecarb_peak,npeak, & ipeak, & irestr_type,irestr_type_peak,ihpb_peak,jhpb_peak,nhpb_peak logical restr_on_coord - common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), - & fordepth(maxdim),bfac(maxres),xlscore(maxdim),wboltzd, - & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),irestr_type(maxdim), - & nhpb,restr_on_coord - common /NMRpeaks/ dhpb_peak(maxdim),dhpb1_peak(maxdim), - & forcon_peak(maxdim),fordepth_peak(maxdim),scal_peak, - & ihpb_peak(maxdim),jhpb_peak(maxdim),ibecarb_peak(maxdim), - & irestr_type_peak(maxdim),ipeak(2,maxdim),npeak,nhpb_peak + common /links/ dhpb(maxdim_cont),dhpb1(maxdim_cont), + & forcon(maxdim_cont),fordepth(maxdim_cont),bfac(maxres), + & xlscore(maxdim_cont),wboltzd, + & ihpb(maxdim_cont),jhpb(maxdim_cont),ibecarb(maxdim_cont), + & irestr_type(maxdim_cont),nhpb,restr_on_coord + common /NMRpeaks/ dhpb_peak(maxdim_cont),dhpb1_peak(maxdim_cont), + & forcon_peak(maxdim_cont),fordepth_peak(maxdim_cont),scal_peak, + & ihpb_peak(maxdim_cont),jhpb_peak(maxdim_cont), + & ibecarb_peak(maxdim_cont),irestr_type_peak(maxdim_cont), + & ipeak(2,maxdim_cont),npeak,nhpb_peak double precision weidis common /restraints/ weidis integer link_start,link_end,link_start_peak,link_end_peak @@ -23,6 +25,6 @@ & link_end_peak double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss logical dyn_ss,dyn_ss_mask - common /dyn_ssbond/ dyn_ssbond_ij(maxres,maxres), + common /dyn_ssbond/ dyn_ssbond_ij(max_cyst,max_cyst), & Ht,dtriss,atriss,btriss,ctriss,dyn_ss,dyn_ss_mask(maxres), - & idssb(maxdim),jdssb(maxdim) + & idssb(maxss),jdssb(maxss) diff --git a/source/unres/src-HCD-5D/COMMON.SHIELD b/source/unres/src-HCD-5D/COMMON.SHIELD index aead071..eecd4c9 100644 --- a/source/unres/src-HCD-5D/COMMON.SHIELD +++ b/source/unres/src-HCD-5D/COMMON.SHIELD @@ -5,10 +5,11 @@ common /shield/ VSolvSphere,VSolvSphere_div,buff_shield, & long_r_sidechain(ntyp), & short_r_sidechain(ntyp),fac_shield(maxres),wshield, - & grad_shield_side(3,maxcont,-1:maxres),grad_shield(3,-1:maxres), - & grad_shield_loc(3,maxcont,-1:maxres), - & ishield_list(maxres),shield_list(maxcont,maxres), - & ees0plist(maxcont,maxres) + & grad_shield_side(3,maxint_res,-1:maxres), + & grad_shield(3,-1:maxres), + & grad_shield_loc(3,maxint_res,-1:maxres), + & ishield_list(maxres),shield_list(maxint_res,maxres), + & ees0plist(maxint_res,maxres) diff --git a/source/unres/src-HCD-5D/DIMENSIONS b/source/unres/src-HCD-5D/DIMENSIONS index 599bfa2..137b45d 100644 --- a/source/unres/src-HCD-5D/DIMENSIONS +++ b/source/unres/src-HCD-5D/DIMENSIONS @@ -16,14 +16,16 @@ C Max. number of coarse-grain processors parameter (max_cg_procs=maxprocs) C Max. number of AA residues integer maxres - parameter (maxres=5000) + parameter (maxres=10000) C Max. number of AA residues per chain integer maxres_chain parameter (maxres_chain=1200) +C Max. number of cysteines and other bridging residues + integer max_cyst + parameter (max_cyst=100) C Appr. max. number of interaction sites - integer maxres2,maxres6,maxres2_chain,mmaxres2,mmaxres2_chain + integer maxres2,maxres6,maxres2_chain,mmaxres2_chain parameter (maxres2=2*maxres,maxres6=6*maxres) - parameter (mmaxres2=(maxres2*(maxres2+1)/2)) parameter (maxres2_chain=2*maxres_chain, & mmaxres2_chain=maxres2_chain*(maxres2_chain+1)/2) C Max number of symetric chains @@ -49,6 +51,16 @@ C Max. number of contacts per residue integer maxconts parameter (maxconts=maxres) c parameter (maxconts=50) +C Max. number of interactions within cutoff per residue + integer maxint_res + parameter (maxint_res=200) +C Max. number od residues within distance cufoff from a given residue to +C include in template-based/contact distance restraints. + integer maxcont_res + parameter (maxcont_res=200) +C Max. number of distance/contact-distance restraints + integer maxdim_cont + parameter (maxdim_cont=maxres*maxcont_res) C Number of AA types (at present only natural AA's will be handled integer ntyp,ntyp1 parameter (ntyp=24,ntyp1=ntyp+1) @@ -74,9 +86,10 @@ c Max number of torsional terms in SCCOR C Max. number of lobes in SC distribution integer maxlob parameter (maxlob=4) -C Max. number of S-S bridges +C Max. number of S-S bridges and other links integer maxss - parameter (maxss=20) +c parameter (maxss=20) + parameter (maxss=max_cyst*(max_cyst-1)/2) C Max. number of dihedral angle constraints integer maxdih_constr parameter (maxdih_constr=maxres) diff --git a/source/unres/src-HCD-5D/MD_A-MTS.F b/source/unres/src-HCD-5D/MD_A-MTS.F index d82cf17..fcef69e 100644 --- a/source/unres/src-HCD-5D/MD_A-MTS.F +++ b/source/unres/src-HCD-5D/MD_A-MTS.F @@ -264,10 +264,10 @@ C call check_ecartint if (rstcount.eq.1000.or.itime.eq.n_timestep) then open(irest2,file=rest2name,status='unknown') write(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres + do i=0,2*nres-1 write (irest2,'(3e15.5)') (d_t(j,i),j=1,3) enddo - do i=1,2*nres + do i=0,2*nres-1 write (irest2,'(3e15.5)') (dc(j,i),j=1,3) enddo close(irest2) @@ -1671,6 +1671,7 @@ c Set up the initial conditions of a MD simulation integer iran_num double precision etot logical fail + integer i_start_models(0:nodes-1) write (iout,*) "init_MD INDPDB",indpdb d_time0=d_time c write(iout,*) "d_time", d_time @@ -1758,10 +1759,10 @@ c statname=statname(:ilen(statname)-5)//qstr(:ipos-1)//'.stat' if (me.eq.king) & inquire(file=mremd_rst_name,exist=file_exist) #ifdef MPI - write (*,*) me," Before broadcast: file_exist",file_exist +c write (*,*) me," Before broadcast: file_exist",file_exist call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM, & IERR) - write (*,*) me," After broadcast: file_exist",file_exist +c write (*,*) me," After broadcast: file_exist",file_exist c inquire(file=mremd_rst_name,exist=file_exist) #endif if(me.eq.king.or..not.out1file) @@ -1839,7 +1840,18 @@ c Removing the velocity of the center of mass call flush(iout) endif endif - write (iout,*) "init_MD before initial structure REST ",rest +c write (iout,*) "init_MD before initial structure REST ",rest + if(start_from_model .and. (me.eq.king .or. .not. out1file)) + & write(iout,*) 'START_FROM_MODELS is ON' + if(start_from_model .and. rest) then + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then + write(iout,*) + & 'START_FROM_MODELS is OFF because the run is restarted' + write(iout,*) 'Remove restart keyword from input' + endif + endif +c write (iout,*) "rest ",rest," start_from_model",start_from_model, +c & " nmodel_start",nmodel_start," preminim",preminim if (.not.rest) then 122 continue if (iranconf.ne.0) then @@ -1920,9 +1932,12 @@ c 8/22/17 AL Loop to produce a low-energy random conformation else if (preminim) then if (start_from_model) then n_model_try=0 - do while (fail .and. n_model_try.lt.constr_homology) + fail=.true. + list_model_try=0 + do while (fail .and. n_model_try.lt.nmodel_start) + write (iout,*) "n_model_try",n_model_try do - i_model=iran_num(1,constr_homology) + i_model=iran_num(1,nmodel_start) do k=1,n_model_try if (i_model.eq.list_model_try(k)) exit enddo @@ -1930,7 +1945,9 @@ c 8/22/17 AL Loop to produce a low-energy random conformation enddo n_model_try=n_model_try+1 list_model_try(n_model_try)=i_model - write (iout,*) 'starting from model ',i_model + if (me.eq.king .or. .not. out1file) + & write (iout,*) 'Trying to start from model ', + & pdbfiles_chomo(i_model)(:ilen(pdbfiles_chomo(i_model))) do i=1,2*nres do j=1,3 c(j,i)=chomo(j,i,i_model) @@ -1981,10 +1998,14 @@ c 8/22/17 AL Loop to produce a low-energy random conformation call etotal(energia(0)) #endif enddo - if (n_model_try.gt.constr_homology) then + call MPI_Gather(i_model,1,MPI_INTEGER,i_start_models(0), + & 1,MPI_INTEGER,king,CG_COMM,IERROR) + if (n_model_try.gt.nmodel_start .and. + & (me.eq.king .or. out1file)) then write (iout,*) & "All models have irreparable overlaps. Trying randoms starts." iranconf=1 + i_model=nmodel_start+1 goto 122 endif else @@ -2027,6 +2048,17 @@ C 8/22/17 AL Minimize initial structure #endif endif endif + if (nmodel_start.gt.0 .and. me.eq.king) then + write (iout,'(a)') "Task Starting model" + do i=0,nodes-1 + if (i_start_models(i).gt.nmodel_start) then + write (iout,'(i4,2x,a)') i,"RANDOM STRUCTURE" + else + write(iout,'(i4,2x,a)')i,pdbfiles_chomo(i_start_models(i)) + & (:ilen(pdbfiles_chomo(i_start_models(i)))) + endif + enddo + endif endif ! .not. rest call chainbuild_cart call kinetic(EK) @@ -2034,6 +2066,7 @@ C 8/22/17 AL Minimize initial structure call verlet_bath endif kinetic_T=2.0d0/(dimen3*Rb)*EK + write (iout,*) "Initial kinetic energy",EK," kinetic T",kinetic_T if(me.eq.king.or..not.out1file)then call cartprint call intout diff --git a/source/unres/src-HCD-5D/MP.F b/source/unres/src-HCD-5D/MP.F index debe2b1..d0b13b1 100644 --- a/source/unres/src-HCD-5D/MP.F +++ b/source/unres/src-HCD-5D/MP.F @@ -36,11 +36,11 @@ c determine # of nodes and current node MyRank=me C Determine the number of "fine-grain" tasks call getenv_loc("FGPROCS",cfgprocs) - print *,cfgprocs +c print *,cfgprocs read (cfgprocs,'(i3)') nfgtasks if (nfgtasks.eq.0) nfgtasks=1 call getenv_loc("MAXGSPROCS",cfgprocs) - print *,cfgprocs +c print *,cfgprocs read (cfgprocs,'(i3)') max_gs_size if (max_gs_size.eq.0) max_gs_size=2 if (lprn) diff --git a/source/unres/src-HCD-5D/MREMD.F b/source/unres/src-HCD-5D/MREMD.F index 9191402..f22e2f6 100644 --- a/source/unres/src-HCD-5D/MREMD.F +++ b/source/unres/src-HCD-5D/MREMD.F @@ -57,7 +57,7 @@ cold integer nup(0:maxprocs),ndown(0:maxprocs) integer rep2i(0:maxprocs),ireqi(maxprocs) integer icache_all(maxprocs) integer status(MPI_STATUS_SIZE),statusi(MPI_STATUS_SIZE,maxprocs) - logical synflag,end_of_run,file_exist /.false./,ovrtim + logical synflag,end_of_run,file_exist /.false./,ovrtim,first_pass double precision t_bath_temp,delta,ene_iex_iex,ene_i_i,ene_iex_i, & ene_i_iex,xxx,tmp,econstr_temp_iex,econstr_temp_i integer iran_num @@ -145,8 +145,8 @@ cold endif cd print '(i4,a6,100i4)',me,' ndown',(ndown(i),i=0,ndown(0)) - write (*,*) "Processor",me," rest",rest," - & restart1fie",restart1file +c write (*,*) "Processor",me," rest",rest," +c & restart1fie",restart1file if(rest.and.restart1file) then if (me.eq.king) & inquire(file=mremd_rst_name,exist=file_exist) @@ -424,6 +424,8 @@ c Entering the MD loop #endif itime=0 end_of_run=.false. + first_pass=.not.rest +c write (iout,*) "first_pass",first_pass do while(.not.end_of_run) itime=itime+1 if(itime.eq.n_timestep.and.me.eq.king) end_of_run=.true. @@ -942,7 +944,10 @@ c write (iout,*) "ene_i_i",remd_ene(0,i) c call flush(iout) c write (iout,*) "rescaling weights with temperature", c & remd_t_bath(iex) - if (real(ene_i_i).ne.real(remd_ene(0,i))) then +c write (iout,*) "first_pass",first_pass + if (.not.first_pass.and. + & real(ene_i_i).ne.real(remd_ene(0,i))) + & then write (iout,*) "ERROR: inconsistent energies:",i, & ene_i_i,remd_ene(0,i) endif @@ -960,7 +965,8 @@ c write (iout,*) "0,iex",remd_t_bath(iex) c call enerprint(remd_ene(0,iex)) call sum_energy(remd_ene(0,iex),.false.) - if (real(ene_iex_iex).ne.real(remd_ene(0,iex))) then + if (.not.first_pass.and. + & real(ene_iex_iex).ne.real(remd_ene(0,iex))) then write (iout,*) "ERROR: inconsistent energies:",iex, & ene_iex_iex,remd_ene(0,iex) endif @@ -1065,6 +1071,7 @@ c call flush(iout) endif enddo enddo + first_pass=.false. cd write (iout,*) "exchange completed" cd call flush(iout) ELSE @@ -1383,7 +1390,7 @@ c----------------------------------------------------------------------- include 'COMMON.SBRIDGE' include 'COMMON.INTERACT' - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), + real d_restart1(3,2*maxres*maxprocs),r_d(3,0:2*maxres-1), & d_restart2(3,2*maxres*maxprocs) real t5_restart1(5) integer iret,itmp @@ -1403,7 +1410,7 @@ c----------------------------------------------------------------------- & t_restart1,5,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres + do i=0,2*nres-1 do j=1,3 r_d(j,i)=d_t(j,i) enddo @@ -1413,7 +1420,7 @@ c----------------------------------------------------------------------- & CG_COMM,ierr) - do i=1,2*nres + do i=0,2*nres-1 do j=1,3 r_d(j,i)=dc(j,i) enddo @@ -1794,14 +1801,14 @@ c end debugging include 'COMMON.CHAIN' include 'COMMON.SBRIDGE' include 'COMMON.INTERACT' - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), + real d_restart1(3,2*maxres*maxprocs),r_d(3,0:2*maxres-1), & t5_restart1(5) integer*2 i_index & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) common /przechowalnia/ d_restart1 integer i,j,il,il1,ixdrf,iret,itmp integer ierr - write (*,*) "Processor",me," called read1restart" +c write (*,*) "Processor",me," called read1restart" if(me.eq.king)then open(irest2,file=mremd_rst_name,status='unknown') @@ -1888,7 +1895,7 @@ c & (d_restart1(j,i+2*nres*il),j=1,3) call mpi_scatter(d_restart1,3*2*nres,mpi_real, & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres + do i=0,2*nres-1 do j=1,3 d_t(j,i)=r_d(j,i) enddo @@ -1910,7 +1917,7 @@ c & (d_restart1(j,i+2*nres*il),j=1,3) endif call mpi_scatter(d_restart1,3*2*nres,mpi_real, & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres + do i=0,2*nres-1 do j=1,3 dc(j,i)=r_d(j,i) enddo @@ -1991,7 +1998,7 @@ c & CG_COMM,ierr) include 'COMMON.CHAIN' include 'COMMON.SBRIDGE' include 'COMMON.INTERACT' - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), + real d_restart1(3,2*maxres*maxprocs),r_d(3,0:2*maxres-1), & t5_restart1(5) common /przechowalnia/ d_restart1 integer i,j,il,itmp @@ -2027,7 +2034,7 @@ c & CG_COMM,ierr) call mpi_scatter(d_restart1,3*2*nres,mpi_real, & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres + do i=0,2*nres-1 do j=1,3 d_t(j,i)=r_d(j,i) enddo @@ -2042,7 +2049,7 @@ c & CG_COMM,ierr) endif call mpi_scatter(d_restart1,3*2*nres,mpi_real, & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres + do i=0,2*nres-1 do j=1,3 dc(j,i)=r_d(j,i) enddo diff --git a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton new file mode 100644 index 0000000..11b83dd --- /dev/null +++ b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton @@ -0,0 +1,200 @@ +################################################################### +#INSTALL_DIR = /opt/cray/mpt/7.3.2/gni/mpich-intel/15.0 + +FC = mpif90 -fc=ifort + +OPT = -O3 -ip -mcmodel=medium -shared-intel +#OPT = -g -CA -CB -mcmodel=medium -shared-intel + +FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include +FFLAGS1 = -c -g -CA -CB -mcmodel=medium -shared-intel +#FFLAGS1 = ${FFLAGS} +FFLAGS2 = -c -g -O0 -mcmodel=medium -shared-intel +#FFLAGSE = -c -O3 -ipo -mcmodel=medium -shared-intel +FFLAGSE = ${FFLAGS} + + +#LIBS = -L$(INSTALL_DIR)/lib -lmpi xdrf/libxdrf.a +LIBS = -lmpi xdrf/libxdrf.a +#/opt/cray/mpt/7.3.2/gni/mpich-intel/15.0/lib/libmpich.a + +ARCH = LINUX +PP = /lib/cpp -P + +all: no_option + @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR" + +.SUFFIXES: .F +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + + +object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ + matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ + pinorm.o randgens.o rescode.o intcor.o timing.o misc.o \ + cart2intgrad.o checkder_p.o contact_cp econstr_local.o econstr_qlike.o \ + econstrq-PMF.o PMFprocess.o energy_p_new_barrier.o make_xx_list.o \ + energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ + cored.o rmdd.o geomout.o readpdb-mult.o int_from_cart.o regularize.o \ + thread.o fitsq.o mcm.o \ + mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o \ + eigen.o blas.o add.o entmcm.o minim_mcmf.o \ + together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ + indexx.o MP.o compare_s1.o prng_32.o \ + banach.o rmsd.o rmscalc.o elecont.o dihed_cons.o \ + sc_move.o local_move.o djacob.o \ + intcartderiv.o lagrangian_lesyng.o\ + chain_symmetry.o permut.o seq2chains.o iperm.o\ + stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ + surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ + q_measure.o gnmr1.o mygauss.o ssMD.o + +object_lbfgs = inform.o iounit.o keys.o linmin.o math.o minima.o scales.o output.o lbfgs.o search.o optsave_dum.o + +no_option: + +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY +GAB: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD.exe +GAB: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY +4P: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD.exe +4P: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DFOURBODY +E0LL2Y: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD.exe +E0LL2Y: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DFOURBODY -DDFA +E0LL2Y_DFA: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD-DFA.exe +E0LL2Y_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD #-DFOURBODY #-DMYGAUSS #-DTIMING +NEWCORR: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD.exe +NEWCORR: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DFIVEDIAG -DLBFGS #-DMYGAUSS #-DTIMING +NEWCORR5D: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD5.exe +NEWCORR5D: ${object_lbfgs} ${object} fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} ${object_lbfgs} fdisy.o fdiag.o machpd.o kinetic_CASC.o cinfo.o ${LIBS} -o ${BIN} +#${FC} ${OPT} ${object} ${object_lbfgs} fdisy.o fdiag.o machpd.o kinetic_CASC.o cinfo.o ${LIBS} -Wl,-M -o ${BIN} + +NEWCORR_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DDFA #-DMYGAUSS #-DTIMING +NEWCORR_DFA: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD-DFA.exe +NEWCORR_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DFIVEDIAG -DLBFGS -DDFA #-DMYGAUSS #-DTIMING +NEWCORR5D_DFA: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD5-DFA.exe +NEWCORR5D_DFA: ${object_lbfgs} ${object} dfa.o fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object_lbfgs} ${object} fdisy.o fdiag.o machpd.o dfa.o kinetic_CASC.o cinfo.o ${LIBS} -o ${BIN} + +xdrf/libxdrf.a: + cd xdrf && make + + +clean: + /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean + +test.o: test.F + ${FC} ${FFLAGS} ${CPPFLAGS} test.F + +chainbuild.o: chainbuild.F + ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F + +djacob.o: djacob.f + ${FC} ${FFLAGS2} djacob.f + +matmult.o: matmult.f + ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f + +parmread.o : parmread.F + ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F + +intcor.o : intcor.f + ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f + +cartder.o : cartder.F + ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F + +readpdb.o : readpdb.F + ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F + +readpdb-mult.o : readpdb-mult.F + ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb-mult.F + +sumsld.o : sumsld.f + ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f + +cored.o : cored.f + ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f + +rmdd.o : rmdd.f + ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f + +energy_p_new_barrier.o : energy_p_new_barrier.F + ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F + +gradient_p.o : gradient_p.F + ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F + +energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F + ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F + +lagrangian_lesyng.o : lagrangian_lesyng.F + ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F + +MD_A-MTS.o : MD_A-MTS.F + ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F + +blas.o : blas.f + ${FC} ${FFLAGS1} blas.f + +add.o : add.f + ${FC} ${FFLAGS1} add.f + +eigen.o : eigen.f + ${FC} ${FFLAGS2} eigen.f + +dfa.o: dfa.F + ${FC} ${FFLAGS2} dfa.F + +proc_proc.o: proc_proc.c + ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src-HCD-5D/contact_cp2.F b/source/unres/src-HCD-5D/contact_cp2.F new file mode 100644 index 0000000..785c8cb --- /dev/null +++ b/source/unres/src-HCD-5D/contact_cp2.F @@ -0,0 +1,148 @@ + subroutine contact_cp2(var,var2,iff,ieval,in_pdb) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' +#ifdef MPI + include 'mpif.h' +#endif + include 'COMMON.SBRIDGE' + include 'COMMON.FFIELD' + include 'COMMON.IOUNITS' + include 'COMMON.DISTFIT' + include 'COMMON.VAR' + include 'COMMON.CHAIN' + include 'COMMON.MINIM' + + character*50 linia + integer nf,ij(4) + double precision var(maxvar),var2(maxvar) + double precision time0,time1 + integer iff(maxres),ieval + double precision theta1(maxres),phi1(maxres),alph1(maxres), + & omeg1(maxres) + + + call var_to_geom(nvar,var) + call chainbuild + nhpb0=nhpb + ind=0 + do i=1,nres-3 + do j=i+3,nres + ind=ind+1 + if ( iff(i).eq.1.and.iff(j).eq.1 ) then + d0(ind)=DIST(i,j) + w(ind)=10.0 + nhpb=nhpb+1 + ihpb(nhpb)=i + jhpb(nhpb)=j + forcon(nhpb)=10.0 + dhpb(nhpb)=d0(ind) + else + w(ind)=0.0 + endif + enddo + enddo + call hpb_partition + + do i=1,nres + theta1(i)=theta(i) + phi1(i)=phi(i) + alph1(i)=alph(i) + omeg1(i)=omeg(i) + enddo + + call var_to_geom(nvar,var2) + + do i=1,nres + if ( iff(i).eq.1 ) then + theta(i)=theta1(i) + phi(i)=phi1(i) + alph(i)=alph1(i) + omeg(i)=omeg1(i) + endif + enddo + + call chainbuild +cd call write_pdb(3,'combined structure',0d0) +cd time0=MPI_WTIME() + + NX=NRES-3 + NY=((NRES-4)*(NRES-5))/2 + call distfit(.true.,200) + +cd time1=MPI_WTIME() +cd write (iout,'(a,f6.2,a)') ' Time for distfit ',time1-time0,' sec' + + ipot0=ipot + maxmin0=maxmin + maxfun0=maxfun + wstrain0=wstrain + + ipot=6 + maxmin=2000 + maxfun=5000 + call geom_to_var(nvar,var) +cd time0=MPI_WTIME() + call minimize(etot,var,iretcode,nfun) + write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun + +cd time1=MPI_WTIME() +cd write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0, +cd & nfun/(time1-time0),' SOFT eval/s' + call var_to_geom(nvar,var) + call chainbuild + + + iwsk=0 + nf=0 + if (iff(1).eq.1) then + iwsk=1 + nf=nf+1 + ij(nf)=0 + endif + do i=2,nres + if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then + iwsk=1 + nf=nf+1 + ij(nf)=i + endif + if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then + iwsk=0 + nf=nf+1 + ij(nf)=i-1 + endif + enddo + if (iff(nres).eq.1) then + nf=nf+1 + ij(nf)=nres + endif + + +cd write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)') +cd & "select",ij(1),"-",ij(2), +cd & ",",ij(3),"-",ij(4) +cd call write_pdb(in_pdb,linia,etot) + + + ipot=ipot0 + maxmin=maxmin0 + maxfun=maxfun0 +cd time0=MPI_WTIME() + call minimize(etot,var,iretcode,nfun) +cd write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun + ieval=nfun + +cd time1=MPI_WTIME() +cd write (iout,'(a,f6.2,f8.2,a)')' Time for DIST min.',time1-time0, +cd & nfun/(time1-time0),' eval/s' +cd call var_to_geom(nvar,var) +cd call chainbuild +cd call write_pdb(6,'dist structure',etot) + + + nhpb= nhpb0 + link_start=1 + link_end=nhpb + wstrain=wstrain0 + + return + end diff --git a/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F b/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F index 96f7777..28ba1d1 100644 --- a/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F @@ -639,7 +639,6 @@ c double precision rrsave(maxdim) logical lprn evdw=0.0D0 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 c if (icall.eq.0) then c lprn=.true. c else @@ -1100,7 +1099,6 @@ C double precision sss1,sssgrad1 evdw=0.0D0 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 lprn=.false. c if (icall.eq.0) lprn=.true. ind=0 @@ -1254,7 +1252,6 @@ C double precision boxshift evdw=0.0D0 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 lprn=.false. c if (icall.eq.0) lprn=.true. ind=0 diff --git a/source/unres/src-HCD-5D/energy_p_new_barrier.F b/source/unres/src-HCD-5D/energy_p_new_barrier.F index 190574e..3f5429d 100644 --- a/source/unres/src-HCD-5D/energy_p_new_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new_barrier.F @@ -118,9 +118,17 @@ c call chainbuild_cart c write (iout,*) "itime_mat",itime_mat," imatupdate",imatupdate if (mod(itime_mat,imatupdate).eq.0) then call make_SCp_inter_list +c write (iout,*) "Finished make_SCp_inter_list" +c call flush(iout) call make_SCSC_inter_list +c write (iout,*) "Finished make_SCSC_inter_list" +c call flush(iout) call make_pp_inter_list +c write (iout,*) "Finished make_pp_inter_list" +c call flush(iout) call make_pp_vdw_inter_list +c write (iout,*) "Finished make_pp_vdw_inter_list" +c call flush(iout) endif c print *,'Processor',myrank,' calling etotal ipot=',ipot c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct @@ -366,7 +374,17 @@ c call flush(iout) c write (iout,*) "MULTIBODY_HB ecorr",ecorr,ecorr5,ecorr6,n_corr, c & n_corr1 c call flush(iout) + else + ecorr=0.0d0 + ecorr5=0.0d0 + ecorr6=0.0d0 + eturn6=0.0d0 endif +#else + ecorr=0.0d0 + ecorr5=0.0d0 + ecorr6=0.0d0 + eturn6=0.0d0 #endif c print *,"Processor",myrank," computed Ucorr" c write (iout,*) "nsaxs",nsaxs," saxs_mode",saxs_mode @@ -409,15 +427,17 @@ C print *,"za lipidami" call AFMforce(Eafmforce) else if (selfguide.gt.0) then call AFMvel(Eafmforce) + else + Eafmforce=0.0d0 endif if (TUBElog.eq.1) then C print *,"just before call" call calctube(Etube) - elseif (TUBElog.eq.2) then + elseif (TUBElog.eq.2) then call calctube2(Etube) - else - Etube=0.0d0 - endif + else + Etube=0.0d0 + endif #ifdef TIMING time_enecalc=time_enecalc+MPI_Wtime()-time00 diff --git a/source/unres/src-HCD-5D/energy_split-sep.F b/source/unres/src-HCD-5D/energy_split-sep.F index f16bc1b..11ea406 100644 --- a/source/unres/src-HCD-5D/energy_split-sep.F +++ b/source/unres/src-HCD-5D/energy_split-sep.F @@ -44,6 +44,13 @@ c if (fg_rank.eq.0) call int_from_cart1(.false.) #endif endif #ifdef MPI + edfadis=0.0d0 + edfator=0.0d0 + edfanei=0.0d0 + edfabet=0.0d0 + ehomology_constr=0.0d0 + Uconst=0.0d0 + Uconst_back=0.0d0 c write(iout,*) "ETOTAL_LONG Processor",fg_rank, c & " absolute rank",myrank," nfgtasks",nfgtasks c call flush(iout) @@ -137,7 +144,6 @@ c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct call make_pp_vdw_inter_list endif #endif - cd print *,'nnt=',nnt,' nct=',nct C C Compute the side-chain and electrostatic interaction energy @@ -231,7 +237,17 @@ c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 endif if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) + else + ecorr=0.0d0 + ecorr5=0.0d0 + ecorr6=0.0d0 + eturn6=0.0d0 endif +#else + ecorr=0.0d0 + ecorr5=0.0d0 + ecorr6=0.0d0 + eturn6=0.0d0 #endif C C If performing constraint dynamics, call the constraint energy @@ -340,6 +356,18 @@ c call flush(iout) edfanei=0.0d0 edfabet=0.0d0 #endif + evdw=0.0d0 + ees=0.0d0 + evdw1=0.0d0 + eel_loc=0.0d0 + eello_turn3=0.0d0 + eello_turn4=0.0d0 + evdw2=0 + evdw2_14=0 + ecorr=0.0d0 + ecorr5=0.0d0 + ecorr6=0.0d0 + eturn6=0.0d0 c write(iout,*) "ETOTAL_SHORT Processor",fg_rank, c & " absolute rank",myrank," nfgtasks",nfgtasks c call flush(iout) @@ -526,6 +554,21 @@ c Lipid transfer else eliptran=0.0d0 endif + if (AFMlog.gt.0) then + call AFMforce(Eafmforce) + else if (selfguide.gt.0) then + call AFMvel(Eafmforce) + else + Eafmforce=0.0d0 + endif + if (TUBElog.eq.1) then +C print *,"just before call" + call calctube(Etube) + elseif (TUBElog.eq.2) then + call calctube2(Etube) + else + Etube=0.0d0 + endif if (ndih_constr.gt.0) call etor_constr(edihcnstr) c print *,"Processor",myrank," computed Utor" diff --git a/source/unres/src-HCD-5D/gen_rand_conf.F b/source/unres/src-HCD-5D/gen_rand_conf.F index b5e5595..9f5567d 100644 --- a/source/unres/src-HCD-5D/gen_rand_conf.F +++ b/source/unres/src-HCD-5D/gen_rand_conf.F @@ -281,7 +281,7 @@ c------------------------------------------------------------------------- double precision eig_limit /1.0D-8/ double precision Big /10.0D0/ double precision vec(3,3) - logical lprint,fail,lcheck + logical lprint,fail,lcheck,lprn /.false./ lcheck=.false. lprint=.false. fail=.false. @@ -514,10 +514,12 @@ C endif if (box(1,2).lt.-MaxBoxLen .or. box(2,2).gt.MaxBoxLen) then #ifdef MPI + if (lprn) then write (iout,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.' write (*,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.' + endif #else -c write (iout,'(a)') 'Bad sampling box.' + if (lprn) write (iout,'(a)') 'Bad sampling box.' #endif fail=.true. return diff --git a/source/unres/src-HCD-5D/initialize_p.F b/source/unres/src-HCD-5D/initialize_p.F index 855c7a4..710f907 100644 --- a/source/unres/src-HCD-5D/initialize_p.F +++ b/source/unres/src-HCD-5D/initialize_p.F @@ -261,10 +261,10 @@ C Initialize the bridge arrays ns=0 nss=0 nhpb=0 - do i=1,maxss + do i=1,max_cyst iss(i)=0 enddo - do i=1,maxdim + do i=1,maxdim_cont dhpb(i)=0.0D0 enddo do i=1,maxres diff --git a/source/unres/src-HCD-5D/make_xx_list.F b/source/unres/src-HCD-5D/make_xx_list.F index a69ee13..480aeb2 100644 --- a/source/unres/src-HCD-5D/make_xx_list.F +++ b/source/unres/src-HCD-5D/make_xx_list.F @@ -5,6 +5,7 @@ include 'mpif.h' include "COMMON.SETUP" #endif + include "COMMON.CONTROL" include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.SPLITELE" @@ -12,14 +13,15 @@ double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe, & xj_temp,yj_temp,zj_temp double precision dist_init, dist_temp,r_buff_list - integer contlisti(2000*maxres),contlistj(2000*maxres) + integer contlisti(maxint_res*maxres),contlistj(maxint_res*maxres) ! integer :: newcontlisti(200*nres),newcontlistj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, & ilist_sc,g_ilist_sc integer displ(0:max_fg_procs),i_ilist_sc(0:max_fg_procs),ierr + logical lprn /.false./ ! print *,"START make_SC" #ifdef DEBUG - write (iout,*) "make_SCSC_inter_list" + write (iout,*) "make_SCSC_inter_list maxint_res",maxint_res #endif r_buff_list=5.0d0 ilist_sc=0 @@ -80,7 +82,7 @@ zj=zj_safe-zi endif ! r_buff_list is a read value for a buffer - if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then + if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then ! Here the list is created ilist_sc=ilist_sc+1 ! this can be substituted by cantor and anti-cantor @@ -106,9 +108,25 @@ call MPI_Reduce(ilist_sc,g_ilist_sc,1, & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +c write (iout,*) "SCSC after reduce ierr",ierr + if (fg_rank.eq.0.and.g_ilist_sc.gt.maxres*maxint_res) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many SCSC interactions", + & g_ilist_sc," only",maxres*maxint_res," allowed." + write (iout,*) "Reduce r_cut_int and resubmit" + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many SCSC interactions", + & g_ilist_sc," only",maxres*maxint_res," allowed." + write (iout,*) "Reduce r_cut_int and resubmit" + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif c write(iout,*) "before bcast",g_ilist_sc call MPI_Gather(ilist_sc,1,MPI_INTEGER, & i_ilist_sc,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "SCSC after gather ierr",ierr displ(0)=0 do i=1,nfgtasks-1,1 displ(i)=i_ilist_sc(i-1)+displ(i-1) @@ -117,16 +135,20 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER, & newcontlisti,i_ilist_sc,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "SCSC after gatherv ierr",ierr call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER, & newcontlistj,i_ilist_sc,displ,MPI_INTEGER, & king,FG_COMM,IERR) call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr ! write(iout,*) "before bcast",g_ilist_sc ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "SCSC after bcast ierr",ierr ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) else @@ -140,8 +162,11 @@ c write(iout,*) "before bcast",g_ilist_sc #ifdef MPI endif #endif + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + & write (iout,'(a30,i10,a,i4)') "Number of SC-SC interactions", + & g_ilist_sc," per residue on average",g_ilist_sc/nres #ifdef DEBUG - write (iout,*) "after GATHERV",g_ilist_sc + write (iout,*) "make_SCSC_inter_list: after GATHERV",g_ilist_sc do i=1,g_ilist_sc write (iout,*) i,newcontlisti(i),newcontlistj(i) enddo @@ -157,6 +182,7 @@ c write(iout,*) "before bcast",g_ilist_sc include 'mpif.h' include "COMMON.SETUP" #endif + include "COMMON.CONTROL" include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.SPLITELE" @@ -164,16 +190,18 @@ c write(iout,*) "before bcast",g_ilist_sc double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe, & xj_temp,yj_temp,zj_temp double precision dist_init, dist_temp,r_buff_list - integer contlistscpi(2000*maxres),contlistscpj(2000*maxres) + integer contlistscpi(2*maxint_res*maxres), + & contlistscpj(2*maxint_res*maxres) ! integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, & ilist_scp,g_ilist_scp integer displ(0:max_fg_procs),i_ilist_scp(0:max_fg_procs),ierr - integer contlistscpi_f(2000*maxres),contlistscpj_f(2000*maxres) +c integer contlistscpi_f(2*maxint_res*maxres), +c & contlistscpj_f(2*maxint_res*maxres) integer ilist_scp_first,ifirstrun,g_ilist_sc ! print *,"START make_SC" #ifdef DEBUG - write (iout,*) "make_SCp_inter_list" + write (iout,*) "make_SCp_inter_list maxint_res",maxint_res #endif r_buff_list=5.0 ilist_scp=0 @@ -245,7 +273,7 @@ c write(iout,*) "before bcast",g_ilist_sc endif #ifdef DEBUG ! r_buff_list is a read value for a buffer - if ((sqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0)) + if((dsqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0)) & then ! Here the list is created ilist_scp_first=ilist_scp_first+1 @@ -255,7 +283,7 @@ c write(iout,*) "before bcast",g_ilist_sc endif #endif ! r_buff_list is a read value for a buffer - if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then + if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then ! Here the list is created ilist_scp=ilist_scp+1 ! this can be substituted by cantor and anti-cantor @@ -276,9 +304,23 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Reduce(ilist_scp,g_ilist_scp,1, & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +c write (iout,*) "SCp after reduce ierr",ierr + if (fg_rank.eq.0.and.g_ilist_scp.gt.2*maxres*maxint_res) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many SCp interactions", + & g_ilist_scp," only",2*maxres*maxint_res," allowed." + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many SCp interactions", + & g_ilist_scp," only",2*maxres*maxint_res," allowed." + write (*,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif c write(iout,*) "before bcast",g_ilist_sc call MPI_Gather(ilist_scp,1,MPI_INTEGER, & i_ilist_scp,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "SCp after gather ierr",ierr displ(0)=0 do i=1,nfgtasks-1,1 displ(i)=i_ilist_scp(i-1)+displ(i-1) @@ -287,16 +329,21 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER, & newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER, & newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR) +c write (iout,*) "SCp after bcast ierr",ierr ! write(iout,*) "before bcast",g_ilist_sc ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) call MPI_Bcast(newcontlistscpi,g_ilist_scp,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "SCp after bcast ierr",ierr call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "SCp bcast reduce ierr",ierr ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) else #endif @@ -309,8 +356,11 @@ c write(iout,*) "before bcast",g_ilist_sc #ifdef MPI endif #endif + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + & write (iout,'(a30,i10,a,i4)') "Number of SC-p interactions", + & g_ilist_scp," per residue on average",g_ilist_scp/nres #ifdef DEBUG - write (iout,*) "after MPIREDUCE",g_ilist_scp + write (iout,*) "make_SCp_inter_list: after GATHERV",g_ilist_scp do i=1,g_ilist_scp write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i) enddo @@ -338,6 +388,7 @@ c write(iout,*) "before bcast",g_ilist_sc include 'mpif.h' include "COMMON.SETUP" #endif + include "COMMON.CONTROL" include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.SPLITELE" @@ -349,7 +400,8 @@ c write(iout,*) "before bcast",g_ilist_sc & xmedi,ymedi,zmedi double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj, & dx_normj,dy_normj,dz_normj - integer contlistpp_vdwi(2000*maxres),contlistpp_vdwj(2000*maxres) + integer contlistpp_vdwi(maxint_res*maxres), + & contlistpp_vdwj(maxint_res*maxres) ! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, & ilist_pp_vdw,g_ilist_pp_vdw @@ -422,7 +474,7 @@ c write(iout,*) "before bcast",g_ilist_sc enddo enddo - if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then + if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then ! Here the list is created ilist_pp_vdw=ilist_pp_vdw+1 ! this can be substituted by cantor and anti-cantor @@ -443,6 +495,18 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Reduce(ilist_pp_vdw,g_ilist_pp_vdw,1, & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) + if (fg_rank.eq.0.and.g_ilist_pp_vdw.gt.maxres*maxint_res) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many pp VDW interactions", + & g_ilist_pp_vdw," only",maxres*maxint_res," allowed." + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many pp VDW interactions", + & g_ilist_pp_vdw," only",maxres*maxint_res," allowed." + write (8,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif ! write(iout,*) "before bcast",g_ilist_sc call MPI_Gather(ilist_pp_vdw,1,MPI_INTEGER, & i_ilist_pp_vdw,1,MPI_INTEGER,king,FG_COMM,IERR) @@ -480,10 +544,14 @@ c write(iout,*) "before bcast",g_ilist_sc #endif call int_bounds(g_ilist_pp_vdw,g_listpp_vdw_start, & g_listpp_vdw_end) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &write (iout,'(a30,i10,a,i4)') "Number of p-p VDW interactions", + & g_ilist_pp_vdw," per residue on average",g_ilist_pp_vdw/nres #ifdef DEBUG write (iout,*) "g_listpp_vdw_start",g_listpp_vdw_start, & "g_listpp_vdw_end",g_listpp_vdw_end - write (iout,*) "after MPIREDUCE",g_ilist_pp_vdw + write (iout,*) "make_pp_vdw_inter_list: after GATHERV", + & g_ilist_pp_vdw do i=1,g_ilist_pp_vdw write (iout,*) i,newcontlistpp_vdwi(i),newcontlistpp_vdwj(i) enddo @@ -498,6 +566,7 @@ c write(iout,*) "before bcast",g_ilist_sc include 'mpif.h' include "COMMON.SETUP" #endif + include "COMMON.CONTROL" include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.SPLITELE" @@ -509,7 +578,8 @@ c write(iout,*) "before bcast",g_ilist_sc & xmedi,ymedi,zmedi double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj, & dx_normj,dy_normj,dz_normj - integer contlistppi(2000*maxres),contlistppj(2000*maxres) + integer contlistppi(maxint_res*maxres), + & contlistppj(maxint_res*maxres) ! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, & ilist_pp,g_ilist_pp @@ -582,7 +652,7 @@ c write(iout,*) "before bcast",g_ilist_sc enddo enddo - if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then + if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then ! Here the list is created ilist_pp=ilist_pp+1 ! this can be substituted by cantor and anti-cantor @@ -603,9 +673,23 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Reduce(ilist_pp,g_ilist_pp,1, & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +c write (iout,*) "After reduce ierr",ierr + if (fg_rank.eq.0.and.g_ilist_pp.gt.maxres*maxint_res) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many pp interactions", + & g_ilist_pp," only",maxres*maxint_res," allowed." + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many pp interactions", + & g_ilist_pp," only",maxres*maxint_res," allowed." + write (*,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif ! write(iout,*) "before bcast",g_ilist_sc call MPI_Gather(ilist_pp,1,MPI_INTEGER, & i_ilist_pp,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "After gather ierr",ierr displ(0)=0 do i=1,nfgtasks-1,1 displ(i)=i_ilist_pp(i-1)+displ(i-1) @@ -614,16 +698,21 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Gatherv(contlistppi,ilist_pp,MPI_INTEGER, & newcontlistppi,i_ilist_pp,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "After gatherb ierr",ierr call MPI_Gatherv(contlistppj,ilist_pp,MPI_INTEGER, & newcontlistppj,i_ilist_pp,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "After gatherb ierr",ierr call MPI_Bcast(g_ilist_pp,1,MPI_INT,king,FG_COMM,IERR) ! write(iout,*) "before bcast",g_ilist_sc ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) +c write (iout,*) "After bcast ierr",ierr call MPI_Bcast(newcontlistppi,g_ilist_pp,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "After bcast ierr",ierr call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "After bcast ierr",ierr ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) @@ -639,8 +728,11 @@ c write(iout,*) "before bcast",g_ilist_sc endif #endif call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + & write (iout,'(a30,i10,a,i4)') "Number of p-p interactions", + & g_ilist_pp," per residue on average",g_ilist_pp/nres #ifdef DEBUG - write (iout,*) "after MPIREDUCE",g_ilist_pp + write (iout,*) "make_pp_inter_list: after GATHERV",g_ilist_pp do i=1,g_ilist_pp write (iout,*) i,newcontlistppi(i),newcontlistppj(i) enddo diff --git a/source/unres/src-HCD-5D/minim_jlee.F b/source/unres/src-HCD-5D/minim_jlee.F index 7162afb..5551640 100644 --- a/source/unres/src-HCD-5D/minim_jlee.F +++ b/source/unres/src-HCD-5D/minim_jlee.F @@ -37,11 +37,11 @@ c controls minimization and sorting routines include 'COMMON.GEO' include 'COMMON.FFIELD' include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' include 'COMMON.CHAIN' dimension var(maxvar),erg(mxch*(mxch+1)/2+1) dimension var2(maxvar) - integer iffr(maxres),ihpbt(maxdim),jhpbt(maxdim) + integer iffr(maxres),ihpbt(maxdim_cont),jhpbt(maxdim_cont) double precision d(maxvar),garbage(maxvar),g(maxvar) double precision energia(0:n_ene),time0s,time1s dimension indx(9),info(12) diff --git a/source/unres/src-HCD-5D/minimize_p.F b/source/unres/src-HCD-5D/minimize_p.F index cea54c4..41a1a27 100644 --- a/source/unres/src-HCD-5D/minimize_p.F +++ b/source/unres/src-HCD-5D/minimize_p.F @@ -198,8 +198,8 @@ c---------------------------------------------------------------------------- include 'COMMON.TIME1' double precision z(maxres6),d_a_tmp(maxres6) double precision edum(0:n_ene),time_order(0:10) - double precision Gcopy(maxres2,maxres2) - common /przechowalnia/ Gcopy +c double precision Gcopy(maxres2,maxres2) +c common /przechowalnia/ Gcopy integer icall /0/ integer i,j,iorder C Workers wait for variables and NF, and NFL from the boss diff --git a/source/unres/src-HCD-5D/parmread.F b/source/unres/src-HCD-5D/parmread.F index 2da8851..4da2913 100644 --- a/source/unres/src-HCD-5D/parmread.F +++ b/source/unres/src-HCD-5D/parmread.F @@ -2096,11 +2096,12 @@ C 12/1/95 Added weight for the multi-body term WCORR do i=1,maxres dyn_ss_mask(i)=.false. enddo - do i=1,maxres-1 - do j=i+1,maxres + do i=1,max_cyst-1 + do j=i+1,max_cyst dyn_ssbond_ij(i,j)=1.0d300 enddo enddo + call flush(iout) call reada(weightcard,"HT",Ht,0.0D0) if (dyn_ss) then ss_depth=ebr/wsc-0.25*eps(1,1) @@ -2131,7 +2132,7 @@ C 12/1/95 Added weight for the multi-body term WCORR write (iout,*) "BTRISS=", btriss write (iout,*) "CTRISS=", ctriss write (iout,*) "DTRISS=", dtriss - print *,'indpdb=',indpdb,' pdbref=',pdbref +c print *,'indpdb=',indpdb,' pdbref=',pdbref endif return end diff --git a/source/unres/src-HCD-5D/read_constr_homology.F b/source/unres/src-HCD-5D/read_constr_homology.F new file mode 100644 index 0000000..3fd4ae5 --- /dev/null +++ b/source/unres/src-HCD-5D/read_constr_homology.F @@ -0,0 +1,717 @@ + subroutine read_constr_homology + implicit none + include 'DIMENSIONS' +#ifdef MPI + include 'mpif.h' +#endif + include 'COMMON.SETUP' + include 'COMMON.CONTROL' + include 'COMMON.HOMOLOGY' + include 'COMMON.CHAIN' + include 'COMMON.IOUNITS' + include 'COMMON.MD' + include 'COMMON.QRESTR' + include 'COMMON.GEO' + include 'COMMON.INTERACT' + include 'COMMON.NAMES' +c +c For new homol impl +c + include 'COMMON.VAR' +c + +c double precision odl_temp,sigma_odl_temp,waga_theta,waga_d, +c & dist_cut +c common /przechowalnia/ odl_temp(maxres,maxres,max_template), +c & sigma_odl_temp(maxres,maxres,max_template) + character*2 kic2 + character*24 model_ki_dist, model_ki_angle + character*500 controlcard + integer ki,i,ii,j,k,l,ii_in_use(maxdim),i_tmp,idomain_tmp,irec, + & ik,iistart,nres_temp + integer ilen + external ilen + logical liiflag,lfirst + integer i01,i10 +c +c FP - Nov. 2014 Temporary specifications for new vars +c + double precision rescore_tmp,x12,y12,z12,rescore2_tmp, + & rescore3_tmp + double precision, dimension (max_template,maxres) :: rescore + double precision, dimension (max_template,maxres) :: rescore2 + double precision, dimension (max_template,maxres) :: rescore3 + double precision distal + character*24 pdbfile,tpl_k_rescore +c ----------------------------------------------------------------- +c Reading multiple PDB ref structures and calculation of retraints +c not using pre-computed ones stored in files model_ki_{dist,angle} +c FP (Nov., 2014) +c ----------------------------------------------------------------- +c +c +c Alternative: reading from input + call card_concat(controlcard) + call reada(controlcard,"HOMOL_DIST",waga_dist,1.0d0) + call reada(controlcard,"HOMOL_ANGLE",waga_angle,1.0d0) + call reada(controlcard,"HOMOL_THETA",waga_theta,1.0d0) ! new + call reada(controlcard,"HOMOL_SCD",waga_d,1.0d0) ! new + call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) ! for diff ways of calc sigma + call reada(controlcard,'DIST2_CUT',dist2_cut,9999.0d0) + call readi(controlcard,"HOMOL_NSET",homol_nset,1) + read2sigma=(index(controlcard,'READ2SIGMA').gt.0) + start_from_model=(index(controlcard,'START_FROM_MODELS').gt.0) + if(.not.read2sigma.and.start_from_model) then + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) + & write(iout,*) 'START_FROM_MODELS works only with READ2SIGMA' + start_from_model=.false. + endif + if(start_from_model .and. (me.eq.king .or. .not. out1file)) + & write(iout,*) 'START_FROM_MODELS is ON' + if(start_from_model .and. rest) then + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then + write(iout,*) 'START_FROM_MODELS is OFF' + write(iout,*) 'remove restart keyword from input' + endif + endif + if (homol_nset.gt.1)then + call card_concat(controlcard) + read(controlcard,*) (waga_homology(i),i=1,homol_nset) + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then + write(iout,*) "iset homology_weight " + do i=1,homol_nset + write(iout,*) i,waga_homology(i) + enddo + endif + iset=mod(kolor,homol_nset)+1 + else + iset=1 + waga_homology(1)=1.0 + endif + +cd write (iout,*) "nnt",nnt," nct",nct +cd call flush(iout) + + + lim_odl=0 + lim_dih=0 +c +c write(iout,*) 'nnt=',nnt,'nct=',nct +c + do i = nnt,nct + do k=1,constr_homology + idomain(k,i)=0 + enddo + enddo + + ii=0 + do i = nnt,nct-2 + do j=i+2,nct + ii=ii+1 + ii_in_use(ii)=0 + enddo + enddo + + if (read_homol_frag) then + call read_klapaucjusz + else + + do k=1,constr_homology + + read(inp,'(a)') pdbfile + if(me.eq.king .or. .not. out1file) + & write (iout,'(a,5x,a)') 'HOMOL: Opening PDB file', + & pdbfile(:ilen(pdbfile)) + open(ipdbin,file=pdbfile,status='old',err=33) + goto 34 + 33 write (iout,'(a,5x,a)') 'Error opening PDB file', + & pdbfile(:ilen(pdbfile)) + stop + 34 continue +c print *,'Begin reading pdb data' +c +c Files containing res sim or local scores (former containing sigmas) +c + + write(kic2,'(bz,i2.2)') k + + tpl_k_rescore="template"//kic2//".sco" + + unres_pdb=.false. + nres_temp=nres + if (read2sigma) then + call readpdb_template(k) + else + call readpdb + endif + nres_chomo(k)=nres + nres=nres_temp +c +c Distance restraints +c +c ... --> odl(k,ii) +C Copy the coordinates from reference coordinates (?) + do i=1,2*nres_chomo(k) + do j=1,3 + c(j,i)=cref(j,i) +c write (iout,*) "c(",j,i,") =",c(j,i) + enddo + enddo +c +c From read_dist_constr (commented out 25/11/2014 <-> res sim) +c +c write(iout,*) "tpl_k_rescore - ",tpl_k_rescore + open (ientin,file=tpl_k_rescore,status='old') + if (nnt.gt.1) rescore(k,1)=0.0d0 + do irec=nnt,nct ! loop for reading res sim + if (read2sigma) then + read (ientin,*,end=1401) i_tmp,rescore2_tmp,rescore_tmp, + & rescore3_tmp,idomain_tmp + i_tmp=i_tmp+nnt-1 + idomain(k,i_tmp)=idomain_tmp + rescore(k,i_tmp)=rescore_tmp + rescore2(k,i_tmp)=rescore2_tmp + rescore3(k,i_tmp)=rescore3_tmp + if (.not. out1file .or. me.eq.king) + & write(iout,'(a7,i5,3f10.5,i5)') "rescore", + & i_tmp,rescore2_tmp,rescore_tmp, + & rescore3_tmp,idomain_tmp + else + idomain(k,irec)=1 + read (ientin,*,end=1401) rescore_tmp + +c rescore(k,irec)=rescore_tmp+1.0d0 ! to avoid 0 values + rescore(k,irec)=0.5d0*(rescore_tmp+0.5d0) ! alt transf to reduce scores +c write(iout,*) "rescore(",k,irec,") =",rescore(k,irec) + endif + enddo + 1401 continue + close (ientin) + if (waga_dist.ne.0.0d0) then + ii=0 + do i = nnt,nct-2 + do j=i+2,nct + + x12=c(1,i)-c(1,j) + y12=c(2,i)-c(2,j) + z12=c(3,i)-c(3,j) + distal=dsqrt(x12*x12+y12*y12+z12*z12) +c write (iout,*) k,i,j,distal,dist2_cut + + if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0 + & .and. distal.le.dist2_cut ) then + + ii=ii+1 + ii_in_use(ii)=1 + l_homo(k,ii)=.true. + +c write (iout,*) "k",k +c write (iout,*) "i",i," j",j," constr_homology", +c & constr_homology + ires_homo(ii)=i + jres_homo(ii)=j + odl(k,ii)=distal + if (read2sigma) then + sigma_odl(k,ii)=0 + do ik=i,j + sigma_odl(k,ii)=sigma_odl(k,ii)+rescore2(k,ik) + enddo + sigma_odl(k,ii)=sigma_odl(k,ii)/(j-i+1) + if (odl(k,ii).gt.dist_cut) sigma_odl(k,ii) = + & sigma_odl(k,ii)*dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0) + else + if (odl(k,ii).le.dist_cut) then + sigma_odl(k,ii)=rescore(k,i)+rescore(k,j) + else +#ifdef OLDSIGMA + sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* + & dexp(0.5d0*(odl(k,ii)/dist_cut)**2) +#else + sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* + & dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0) +#endif + endif + endif + sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii)) + else + ii=ii+1 + l_homo(k,ii)=.false. + endif + enddo + enddo + lim_odl=ii + endif +c write (iout,*) "Distance restraints set" +c call flush(iout) +c +c Theta, dihedral and SC retraints +c + if (waga_angle.gt.0.0d0) then +c open (ientin,file=tpl_k_sigma_dih,status='old') +c do irec=1,maxres-3 ! loop for reading sigma_dih +c read (ientin,*,end=1402) i,j,ki,l,sigma_dih(k,i+nnt-1) ! j,ki,l what for? +c if (i+nnt-1.gt.lim_dih) lim_dih=i+nnt-1 ! right? +c sigma_dih(k,i+nnt-1)=sigma_dih(k,i+nnt-1)* ! not inverse because of use of res. similarity +c & sigma_dih(k,i+nnt-1) +c enddo +c1402 continue +c close (ientin) + do i = nnt+3,nct + if (idomain(k,i).eq.0) then + sigma_dih(k,i)=0.0 + cycle + endif + dih(k,i)=phiref(i) ! right? +c read (ientin,*) sigma_dih(k,i) ! original variant +c write (iout,*) "dih(",k,i,") =",dih(k,i) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i), +c & "rescore(",k,i-1,") =",rescore(k,i-1), +c & "rescore(",k,i-2,") =",rescore(k,i-2), +c & "rescore(",k,i-3,") =",rescore(k,i-3) + + sigma_dih(k,i)=(rescore(k,i)+rescore(k,i-1)+ + & rescore(k,i-2)+rescore(k,i-3))/4.0 +c if (read2sigma) sigma_dih(k,i)=sigma_dih(k,i)/4.0 +c write (iout,*) "Raw sigmas for dihedral angle restraints" +c write (iout,'(i5,10(2f8.2,4x))') i,sigma_dih(k,i) +c sigma_dih(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)* +c rescore(k,i-2)*rescore(k,i-3) ! right expression ? +c Instead of res sim other local measure of b/b str reliability possible + if (sigma_dih(k,i).ne.0) + & sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i)) +c sigma_dih(k,i)=sigma_dih(k,i)*sigma_dih(k,i) + enddo + lim_dih=nct-nnt-2 + endif +c write (iout,*) "Dihedral angle restraints set" +c call flush(iout) + + if (waga_theta.gt.0.0d0) then +c open (ientin,file=tpl_k_sigma_theta,status='old') +c do irec=1,maxres-2 ! loop for reading sigma_theta, right bounds? +c read (ientin,*,end=1403) i,j,ki,sigma_theta(k,i+nnt-1) ! j,ki what for? +c sigma_theta(k,i+nnt-1)=sigma_theta(k,i+nnt-1)* ! not inverse because of use of res. similarity +c & sigma_theta(k,i+nnt-1) +c enddo +c1403 continue +c close (ientin) + + do i = nnt+2,nct ! right? without parallel. +c do i = i=1,nres ! alternative for bounds acc to readpdb? +c do i=ithet_start,ithet_end ! with FG parallel. + if (idomain(k,i).eq.0) then + sigma_theta(k,i)=0.0 + cycle + endif + thetatpl(k,i)=thetaref(i) +c write (iout,*) "thetatpl(",k,i,") =",thetatpl(k,i) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i), +c & "rescore(",k,i-1,") =",rescore(k,i-1), +c & "rescore(",k,i-2,") =",rescore(k,i-2) +c read (ientin,*) sigma_theta(k,i) ! 1st variant + sigma_theta(k,i)=(rescore(k,i)+rescore(k,i-1)+ + & rescore(k,i-2))/3.0 +c if (read2sigma) sigma_theta(k,i)=sigma_theta(k,i)/3.0 + if (sigma_theta(k,i).ne.0) + & sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i)) + +c sigma_theta(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)* +c rescore(k,i-2) ! right expression ? +c sigma_theta(k,i)=sigma_theta(k,i)*sigma_theta(k,i) + enddo + endif +c write (iout,*) "Angle restraints set" +c call flush(iout) + + if (waga_d.gt.0.0d0) then +c open (ientin,file=tpl_k_sigma_d,status='old') +c do irec=1,maxres-1 ! loop for reading sigma_theta, right bounds? +c read (ientin,*,end=1404) i,j,sigma_d(k,i+nnt-1) ! j,ki what for? +c sigma_d(k,i+nnt-1)=sigma_d(k,i+nnt-1)* ! not inverse because of use of res. similarity +c & sigma_d(k,i+nnt-1) +c enddo +c1404 continue + + do i = nnt,nct ! right? without parallel. +c do i=2,nres-1 ! alternative for bounds acc to readpdb? +c do i=loc_start,loc_end ! with FG parallel. + if (itype(i).eq.10) cycle + if (idomain(k,i).eq.0 ) then + sigma_d(k,i)=0.0 + cycle + endif + xxtpl(k,i)=xxref(i) + yytpl(k,i)=yyref(i) + zztpl(k,i)=zzref(i) +c write (iout,*) "xxtpl(",k,i,") =",xxtpl(k,i) +c write (iout,*) "yytpl(",k,i,") =",yytpl(k,i) +c write (iout,*) "zztpl(",k,i,") =",zztpl(k,i) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i) + sigma_d(k,i)=rescore3(k,i) ! right expression ? + if (sigma_d(k,i).ne.0) + & sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i)) + +c sigma_d(k,i)=hmscore(k)*rescore(k,i) ! right expression ? +c sigma_d(k,i)=sigma_d(k,i)*sigma_d(k,i) +c read (ientin,*) sigma_d(k,i) ! 1st variant + enddo + endif + enddo +c write (iout,*) "SC restraints set" +c call flush(iout) +c +c remove distance restraints not used in any model from the list +c shift data in all arrays +c +c write (iout,*) "waga_dist",waga_dist," nnt",nnt," nct",nct + if (waga_dist.ne.0.0d0) then + ii=0 + liiflag=.true. + lfirst=.true. + do i=nnt,nct-2 + do j=i+2,nct + ii=ii+1 +c if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0 +c & .and. distal.le.dist2_cut ) then +c write (iout,*) "i",i," j",j," ii",ii +c call flush(iout) + if (ii_in_use(ii).eq.0.and.liiflag.or. + & ii_in_use(ii).eq.1.and.liiflag.and.ii.eq.lim_odl) then + liiflag=.false. + i10=ii + if (lfirst) then + lfirst=.false. + iistart=ii + else + if(i10.eq.lim_odl) i10=i10+1 + do ki=0,i10-i01-1 + ires_homo(iistart+ki)=ires_homo(ki+i01) + jres_homo(iistart+ki)=jres_homo(ki+i01) + ii_in_use(iistart+ki)=ii_in_use(ki+i01) + do k=1,constr_homology + odl(k,iistart+ki)=odl(k,ki+i01) + sigma_odl(k,iistart+ki)=sigma_odl(k,ki+i01) + l_homo(k,iistart+ki)=l_homo(k,ki+i01) + enddo + enddo + iistart=iistart+i10-i01 + endif + endif + if (ii_in_use(ii).ne.0.and..not.liiflag) then + i01=ii + liiflag=.true. + endif + enddo + enddo + lim_odl=iistart-1 + endif +c write (iout,*) "Removing distances completed" +c call flush(iout) + endif ! .not. klapaucjusz + + if (constr_homology.gt.0) call homology_partition +c write (iout,*) "After homology_partition" +c call flush(iout) + if (constr_homology.gt.0) call init_int_table +c write (iout,*) "After init_int_table" +c call flush(iout) +c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end +c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end +c +c Print restraints +c + if (.not.out_template_restr) return +cd write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then + write (iout,*) "Distance restraints from templates" + do ii=1,lim_odl + write(iout,'(3i5,100(2f8.2,1x,l1,4x))') + & ii,ires_homo(ii),jres_homo(ii), + & (odl(ki,ii),1.0d0/dsqrt(sigma_odl(ki,ii)),l_homo(ki,ii), + & ki=1,constr_homology) + enddo + write (iout,*) "Dihedral angle restraints from templates" + do i=nnt+3,nct + write (iout,'(i5,a4,100(2f8.2,4x))') i,restyp(itype(i)), + & (rad2deg*dih(ki,i), + & rad2deg/dsqrt(sigma_dih(ki,i)),ki=1,constr_homology) + enddo + write (iout,*) "Virtual-bond angle restraints from templates" + do i=nnt+2,nct + write (iout,'(i5,a4,100(2f8.2,4x))') i,restyp(itype(i)), + & (rad2deg*thetatpl(ki,i), + & rad2deg/dsqrt(sigma_theta(ki,i)),ki=1,constr_homology) + enddo + write (iout,*) "SC restraints from templates" + do i=nnt,nct + write(iout,'(i5,100(4f8.2,4x))') i, + & (xxtpl(ki,i),yytpl(ki,i),zztpl(ki,i), + & 1.0d0/dsqrt(sigma_d(ki,i)),ki=1,constr_homology) + enddo + endif +c ----------------------------------------------------------------- + return + end +c---------------------------------------------------------------------- + subroutine read_klapaucjusz + implicit none + include 'DIMENSIONS' +#ifdef MPI + include 'mpif.h' +#endif + include 'COMMON.SETUP' + include 'COMMON.CONTROL' + include 'COMMON.HOMOLOGY' + include 'COMMON.CHAIN' + include 'COMMON.IOUNITS' + include 'COMMON.MD' + include 'COMMON.GEO' + include 'COMMON.INTERACT' + include 'COMMON.NAMES' + character*256 fragfile + integer ninclust(maxclust),inclust(max_template,maxclust), + & nresclust(maxclust),iresclust(maxres,maxclust),nclust + + character*2 kic2 + character*24 model_ki_dist, model_ki_angle + character*500 controlcard + integer ki, i, j, k, l, ii_in_use(maxdim),i_tmp,idomain_tmp, + & ik,ll,ii,kk,iistart,iishift,lim_xx + double precision distal + logical lprn /.true./ + integer nres_temp + integer ilen + external ilen + logical liiflag +c +c + double precision rescore_tmp,x12,y12,z12,rescore2_tmp + double precision, dimension (max_template,maxres) :: rescore + double precision, dimension (max_template,maxres) :: rescore2 + character*24 pdbfile,tpl_k_rescore + +c +c For new homol impl +c + include 'COMMON.VAR' +c + call getenv("FRAGFILE",fragfile) + open(ientin,file=fragfile,status="old",err=10) + read(ientin,*) constr_homology,nclust + l_homo = .false. + sigma_theta=0.0 + sigma_d=0.0 + sigma_dih=0.0 +c Read pdb files + do k=1,constr_homology + read(ientin,'(a)') pdbfile + write (iout,'(a,5x,a)') 'KLAPAUCJUSZ: Opening PDB file', + & pdbfile(:ilen(pdbfile)) + open(ipdbin,file=pdbfile,status='old',err=33) + goto 34 + 33 write (iout,'(a,5x,a)') 'Error opening PDB file', + & pdbfile(:ilen(pdbfile)) + stop + 34 continue + unres_pdb=.false. + nres_temp=nres + call readpdb_template(k) + nres_chomo(k)=nres + nres=nres_temp + do i=1,nres + rescore(k,i)=0.2d0 + rescore2(k,i)=1.0d0 + enddo + enddo +c Read clusters + do i=1,nclust + read(ientin,*) ninclust(i),nresclust(i) + read(ientin,*) (inclust(k,i),k=1,ninclust(i)) + read(ientin,*) (iresclust(k,i),k=1,nresclust(i)) + enddo +c +c Loop over clusters +c + do l=1,nclust + do ll = 1,ninclust(l) + + k = inclust(ll,l) + do i=1,nres + idomain(k,i)=0 + enddo + do i=1,nresclust(l) + if (nnt.gt.1) then + idomain(k,iresclust(i,l)+1) = 1 + else + idomain(k,iresclust(i,l)) = 1 + endif + enddo +c +c Distance restraints +c +c ... --> odl(k,ii) +C Copy the coordinates from reference coordinates (?) + nres_temp=nres + nres=nres_chomo(k) + do i=1,2*nres + do j=1,3 + c(j,i)=chomo(j,i,k) +c write (iout,*) "c(",j,i,") =",c(j,i) + enddo + enddo + call int_from_cart(.true.,.false.) + call sc_loc_geom(.false.) + do i=1,nres + thetaref(i)=theta(i) + phiref(i)=phi(i) + enddo + nres=nres_temp + if (waga_dist.ne.0.0d0) then + ii=0 + do i = nnt,nct-2 + do j=i+2,nct + + x12=c(1,i)-c(1,j) + y12=c(2,i)-c(2,j) + z12=c(3,i)-c(3,j) + distal=dsqrt(x12*x12+y12*y12+z12*z12) +c write (iout,*) k,i,j,distal,dist2_cut + + if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0 + & .and. distal.le.dist2_cut ) then + + ii=ii+1 + ii_in_use(ii)=1 + l_homo(k,ii)=.true. + +c write (iout,*) "k",k +c write (iout,*) "i",i," j",j," constr_homology", +c & constr_homology + ires_homo(ii)=i + jres_homo(ii)=j + odl(k,ii)=distal + if (read2sigma) then + sigma_odl(k,ii)=0 + do ik=i,j + sigma_odl(k,ii)=sigma_odl(k,ii)+rescore2(k,ik) + enddo + sigma_odl(k,ii)=sigma_odl(k,ii)/(j-i+1) + if (odl(k,ii).gt.dist_cut) sigma_odl(k,ii) = + & sigma_odl(k,ii)*dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0) + else + if (odl(k,ii).le.dist_cut) then + sigma_odl(k,ii)=rescore(k,i)+rescore(k,j) + else +#ifdef OLDSIGMA + sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* + & dexp(0.5d0*(odl(k,ii)/dist_cut)**2) +#else + sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* + & dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0) +#endif + endif + endif + sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii)) + else + ii=ii+1 +c l_homo(k,ii)=.false. + endif + enddo + enddo + lim_odl=ii + endif +c +c Theta, dihedral and SC retraints +c + if (waga_angle.gt.0.0d0) then + do i = nnt+3,nct + if (idomain(k,i).eq.0) then +c sigma_dih(k,i)=0.0 + cycle + endif + dih(k,i)=phiref(i) + sigma_dih(k,i)=(rescore(k,i)+rescore(k,i-1)+ + & rescore(k,i-2)+rescore(k,i-3))/4.0 +c write (iout,*) "k",k," l",l," i",i," rescore",rescore(k,i), +c & " sigma_dihed",sigma_dih(k,i) + if (sigma_dih(k,i).ne.0) + & sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i)) + enddo + lim_dih=nct-nnt-2 + endif + + if (waga_theta.gt.0.0d0) then + do i = nnt+2,nct + if (idomain(k,i).eq.0) then +c sigma_theta(k,i)=0.0 + cycle + endif + thetatpl(k,i)=thetaref(i) + sigma_theta(k,i)=(rescore(k,i)+rescore(k,i-1)+ + & rescore(k,i-2))/3.0 + if (sigma_theta(k,i).ne.0) + & sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i)) + enddo + endif + + if (waga_d.gt.0.0d0) then + do i = nnt,nct + if (itype(i).eq.10) cycle + if (idomain(k,i).eq.0 ) then +c sigma_d(k,i)=0.0 + cycle + endif + xxtpl(k,i)=xxref(i) + yytpl(k,i)=yyref(i) + zztpl(k,i)=zzref(i) + sigma_d(k,i)=rescore(k,i) + if (sigma_d(k,i).ne.0) + & sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i)) + if (i-nnt+1.gt.lim_xx) lim_xx=i-nnt+1 + enddo + endif + enddo ! l + enddo ! ll +c +c remove distance restraints not used in any model from the list +c shift data in all arrays +c + if (waga_dist.ne.0.0d0) then + ii=0 + liiflag=.true. + do i=nnt,nct-2 + do j=i+2,nct + ii=ii+1 + if (ii_in_use(ii).eq.0.and.liiflag) then + liiflag=.false. + iistart=ii + endif + if (ii_in_use(ii).ne.0.and..not.liiflag.or. + & .not.liiflag.and.ii.eq.lim_odl) then + if (ii.eq.lim_odl) then + iishift=ii-iistart+1 + else + iishift=ii-iistart + endif + liiflag=.true. + do ki=iistart,lim_odl-iishift + ires_homo(ki)=ires_homo(ki+iishift) + jres_homo(ki)=jres_homo(ki+iishift) + ii_in_use(ki)=ii_in_use(ki+iishift) + do k=1,constr_homology + odl(k,ki)=odl(k,ki+iishift) + sigma_odl(k,ki)=sigma_odl(k,ki+iishift) + l_homo(k,ki)=l_homo(k,ki+iishift) + enddo + enddo + ii=ii-iishift + lim_odl=lim_odl-iishift + endif + enddo + enddo + endif + + return + 10 stop "Error in fragment file" + end + diff --git a/source/unres/src-HCD-5D/readpdb-mult.F b/source/unres/src-HCD-5D/readpdb-mult.F index 40bf9ac..8346c4a 100644 --- a/source/unres/src-HCD-5D/readpdb-mult.F +++ b/source/unres/src-HCD-5D/readpdb-mult.F @@ -20,8 +20,9 @@ C geometry. double precision e1(3),e2(3),e3(3) integer rescode,iterter(maxres),cou logical fail,sccalc - integer i,j,iii,ires,ires_old,ishift,ishift1,ibeg - double precision dcj,efree_temp + integer i,j,iii,ires,ires_old,ishift,ishift1,ibeg,ifree + double precision dcj!,efree_temp + logical zero bfac=0.0d0 do i=1,maxres iterter(i)=0 @@ -36,6 +37,7 @@ C geometry. do read (ipdbin,'(a80)',end=10) card c write (iout,'(a)') card +c call flush(iout) if (card(:5).eq.'HELIX') then nhfrag=nhfrag+1 lsecondary=.true. @@ -76,7 +78,11 @@ c write (iout,'(a)') card sccalc=.true. endif ! Read free energy - if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp +c if (index(card,"FREE ENERGY").gt.0) then +c ifree=index(card,"FREE ENERGY")+12 +c read(card(ifree:),*,err=1115,end=1115) efree_temp +c 1115 continue +c endif ! Fish out the ATOM cards. if (index(card(1:4),'ATOM').gt.0) then sccalc=.false. @@ -96,9 +102,11 @@ c write (iout,*) "IRES",ires-ishift+ishift1,ires_old ! if (ibeg.eq.0) call sccenter(ires,iii,sccor) if (ibeg.eq.0) then c write (iout,*) "Calculating sidechain center iii",iii +c write (iout,*) "ires",ires if (unres_pdb) then +c write (iout,'(i5,3f10.5)') ires,(sccor(j,iii),j=1,3) do j=1,3 - dc(j,ires+nres)=sccor(j,iii) + dc(j,ires_old)=sccor(j,iii) enddo else call sccenter(ires_old,iii,sccor) @@ -153,7 +161,7 @@ c write (2,*) "ires",ires," res ",res!," ity"!,ity read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) ! write (iout,*) "backbone ",atom #ifdef DEBUG - write (iout,'(2i3,2x,a,3f8.3)') + write (iout,'(i6,i3,2x,a,3f8.3)') & ires,itype(ires),res,(c(j,ires),j=1,3) #endif iii=iii+1 @@ -178,6 +186,10 @@ c write (iout,*) "iii",iii C Calculate dummy residue coordinates inside the "chain" of a multichain C system nres=ires +c write (iout,*) "dc" +c do i=1,nres +c write (iout,'(i5,3f10.5)') i,(dc(j,i),j=1,3) +c enddo do i=2,nres-1 c write (iout,*) i,itype(i),itype(i+1),ntyp1,iterter(i) if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then @@ -187,14 +199,14 @@ C first is connected prevous chain (itype(i+1).eq.ntyp1)=true C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false if (unres_pdb) then C 2/15/2013 by Adam: corrected insertion of the last dummy residue - print *,i,'tu dochodze' +c print *,i,'tu dochodze' call refsys(i-3,i-2,i-1,e1,e2,e3,fail) if (fail) then e2(1)=0.0d0 e2(2)=1.0d0 e2(3)=0.0d0 endif !fail - print *,i,'a tu?' +c print *,i,'a tu?' do j=1,3 c(j,i)=c(j,i-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) enddo @@ -312,6 +324,18 @@ C Calculate internal coordinates. enddo call flush(iout) endif + zero=.false. + do ires=1,nres + zero=zero.or.itype(ires).eq.0 + enddo + if (zero) then + write (iout,'(2a)') "Gaps in PDB coordinates detected;", + & " look for ZERO in the control output above." + write (iout,'(2a)') "Repair the PDB file using MODELLER", + & " or other softwared and resubmit." + call flush(iout) + stop + endif c write(iout,*)"before int_from_cart nres",nres call int_from_cart(.true.,.false.) do i=1,nres @@ -439,7 +463,7 @@ C Calculate the CM of the preceding residue. if (ibeg.eq.0) then if (unres_pdb) then do j=1,3 - dc(j,ires)=sccor(j,iii) + dc(j,ires_old)=sccor(j,iii) enddo else call sccenter(ires_old,iii,sccor) @@ -652,7 +676,7 @@ C Calculate internal coordinates. enddo endif C Calculate internal coordinates. - call int_from_cart(.true.,.true.) + call int_from_cart(.true.,out_template_coord) call sc_loc_geom(.false.) do i=1,nres thetaref(i)=theta(i) diff --git a/source/unres/src-HCD-5D/readrtns_CSA.F b/source/unres/src-HCD-5D/readrtns_CSA.F index 16c0f37..d76b29e 100644 --- a/source/unres/src-HCD-5D/readrtns_CSA.F +++ b/source/unres/src-HCD-5D/readrtns_CSA.F @@ -187,7 +187,6 @@ c call readi(controlcard,'IZ_SC',iz_sc,0) pdbref=(index(controlcard,'PDBREF').gt.0) refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0) indpdb=index(controlcard,'PDBSTART') - extconf=(index(controlcard,'EXTCONF').gt.0) AFMlog=(index(controlcard,'AFM')) selfguide=(index(controlcard,'SELFGUIDE')) c print *,'AFMlog',AFMlog,selfguide,"KUPA" @@ -296,6 +295,12 @@ cfmc modecalc=10 indphi=index(controlcard,'PHI') indback=index(controlcard,'BACK') iranconf=index(controlcard,'RAND_CONF') + start_from_model=(index(controlcard,'START_FROM_MODELS').gt.0) + extconf=(index(controlcard,'EXTCONF').gt.0) + if (start_from_model) then + iranconf=0 + extconf=.false. + endif i2ndstr=index(controlcard,'USE_SEC_PRED') gradout=index(controlcard,'GRADOUT').gt.0 gnorm_check=index(controlcard,'GNORM_CHECK').gt.0 @@ -736,7 +741,7 @@ C integer ilen external ilen integer iperm,tperm - integer i,j,ii,k,l,itrial,itmp,i1,i2,it1,it2 + integer i,j,ii,k,l,itrial,itmp,i1,i2,it1,it2,nres_temp double precision sumv C C Read PDB structure if applicable @@ -831,7 +836,7 @@ c print '(20i4)',(itype(i),i=1,nres) do i=1,nres-1 write (iout,*) i,itype(i),itel(i) enddo - print *,'Call Read_Bridge.' +c print *,'Call Read_Bridge.' endif nnt=1 nct=nres @@ -844,7 +849,7 @@ cd print *,'NNT=',NNT,' NCT=',NCT chain_border1(1,i)=chain_border(1,i)-1 chain_border1(2,i)=chain_border(2,i)+1 enddo - chain_border1(1,nchain)=chain_border(1,nchain)-1 + if (nchain.gt.1) chain_border1(1,nchain)=chain_border(1,nchain)-1 chain_border1(2,nchain)=nres write(iout,*) "nres",nres," nchain",nchain do i=1,nchain @@ -870,9 +875,9 @@ c enddo if (.not. (wdfa_dist.eq.0.0 .and. wdfa_tor.eq.0.0 .and. & wdfa_nei.eq.0.0 .and. wdfa_beta.eq.0.0)) then call init_dfa_vars - print*, 'init_dfa_vars finished!' +c print*, 'init_dfa_vars finished!' call read_dfa_info - print*, 'read_dfa_info finished!' +c print*, 'read_dfa_info finished!' endif #endif if (pdbref) then @@ -1097,10 +1102,10 @@ czscore call geom_to_var(nvar,coord_exp_zs(1,1)) endif endif c print *, "A TU" - write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup +c write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup call flush(iout) if (constr_dist.gt.0) call read_dist_constr - write (iout,*) "After read_dist_constr nhpb",nhpb +c write (iout,*) "After read_dist_constr nhpb",nhpb if ((AFMlog.gt.0).or.(selfguide.gt.0)) call read_afminp call hpb_partition call NMRpeak_partition @@ -1163,6 +1168,49 @@ c print *, "A TU" enddo else homol_nset=0 + if (start_from_model) then + nmodel_start=0 + do + read(inp,'(a)',end=332,err=332) pdbfile + if (me.eq.king .or. .not. out1file) + & write (iout,'(a,5x,a)') 'Opening PDB file', + & pdbfile(:ilen(pdbfile)) + open(ipdbin,file=pdbfile,status='old',err=336) + goto 335 + 336 write (iout,'(a,5x,a)') 'Error opening PDB file', + & pdbfile(:ilen(pdbfile)) + call flush(iout) + stop + 335 continue + unres_pdb=.false. + nres_temp=nres + call readpdb + close(ipdbin) + if (nres.ge.nres_temp) then + nmodel_start=nmodel_start+1 + pdbfiles_chomo(nmodel_start)=pdbfile + do i=1,2*nres + do j=1,3 + chomo(j,i,nmodel_start)=c(j,i) + enddo + enddo + else + if (me.eq.king .or. .not. out1file) + & write (iout,'(a,2i5,1x,a)') + & "Different number of residues",nres_temp,nres, + & " model skipped." + endif + nres=nres_temp + enddo + 332 continue + if (nmodel_start.eq.0) then + if (me.eq.king .or. .not. out1file) + & write (iout,'(a)') + & "No valid starting model found START_FROM_MODELS is OFF" + start_from_model=.false. + endif + write (iout,*) "nmodel_start",nmodel_start + endif endif @@ -1172,14 +1220,15 @@ C endif & modecalc.ne.10) then C If input structure hasn't been supplied from the PDB file read or generate C initial geometry. - if (iranconf.eq.0 .and. .not. extconf) then + if (iranconf.eq.0 .and. .not. extconf .and. .not. + & start_from_model) then if(me.eq.king.or..not.out1file .and.fg_rank.eq.0) & write (iout,'(a)') 'Initial geometry will be read in.' if (read_cart) then read(inp,'(8f10.5)',end=36,err=36) & ((c(l,k),l=1,3),k=1,nres), & ((c(l,k+nres),l=1,3),k=nnt,nct) - write (iout,*) "Exit READ_CART" +c write (iout,*) "Exit READ_CART" c write (iout,'(8f10.5)') c & ((c(l,k),l=1,3),k=1,nres), c & ((c(l,k+nres),l=1,3),k=nnt,nct) @@ -1405,7 +1454,13 @@ C Read information about disulfide bridges. integer i,j C Read bridging residues. read (inp,*) ns,(iss(i),i=1,ns) - print *,'ns=',ns +c 5/24/2020 Adam: Added a table to translate residue numbers to cysteine +c numbers + icys=0 + do i=1,ns + icys(iss(i))=i + enddo +c print *,'ns=',ns if(me.eq.king.or..not.out1file) & write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns) C Check whether the specified bridging residues are cystines. @@ -1614,9 +1669,11 @@ C Generate CA distance constraints. include 'COMMON.CONTROL' include 'COMMON.DBASE' include 'COMMON.THREAD' + include 'COMMON.SPLITELE' include 'COMMON.TIME1' integer i,j,itype_pdb(maxres) common /pizda/ itype_pdb + double precision dd double precision dist character*2 iden cd print *,'gen_dist_constr: nnt=',nnt,' nct=',nct @@ -1627,11 +1684,14 @@ cd & ' nsup',nsup cd write (2,*) 'i',i,' seq ',restyp(itype(i+nstart_seq-nstart_sup)), cd & ' seq_pdb', restyp(itype_pdb(i)) do j=i+2,nstart_sup+nsup-1 +c 5/24/2020 Adam: Cutoff included to reduce array size + dd = dist(i,j) + if (dd.gt.r_cut_int) cycle nhpb=nhpb+1 ihpb(nhpb)=i+nstart_seq-nstart_sup jhpb(nhpb)=j+nstart_seq-nstart_sup forcon(nhpb)=weidis - dhpb(nhpb)=dist(i,j) + dhpb(nhpb)=dd enddo enddo cd write (iout,'(a)') 'Distance constraints:' @@ -2375,10 +2435,10 @@ c------------------------------------------------------------------------------ open(irest2,file=rest2name,status='unknown') read(irest2,*) totT,EK,potE,totE,t_bath totTafm=totT - do i=1,2*nres + do i=0,2*nres-1 read(irest2,'(3e15.5)') (d_t(j,i),j=1,3) enddo - do i=1,2*nres + do i=0,2*nres-1 read(irest2,'(3e15.5)') (dc(j,i),j=1,3) enddo if(usampl) then @@ -2468,7 +2528,7 @@ c print *, "wchodze" call readi(afmcard,"END",afmend,0) call reada(afmcard,"FORCE",forceAFMconst,0.0d0) call reada(afmcard,"VEL",velAFMconst,0.0d0) - print *,'FORCE=' ,forceAFMconst +c print *,'FORCE=' ,forceAFMconst CCCC NOW PROPERTIES FOR AFM distafminit=0.0d0 do i=1,3 @@ -2979,7 +3039,7 @@ c & sigma_odl_temp(maxres,maxres,max_template) character*24 model_ki_dist, model_ki_angle character*500 controlcard integer ki,i,ii,j,k,l,ii_in_use(maxdim),i_tmp,idomain_tmp,irec, - & ik,iistart + & ik,iistart,nres_temp integer ilen external ilen logical liiflag,lfirst @@ -3016,15 +3076,17 @@ c Alternative: reading from input if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) & write(iout,*) 'START_FROM_MODELS works only with READ2SIGMA' start_from_model=.false. + iranconf=(indpdb.le.0) endif if(start_from_model .and. (me.eq.king .or. .not. out1file)) & write(iout,*) 'START_FROM_MODELS is ON' - if(start_from_model .and. rest) then - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then - write(iout,*) 'START_FROM_MODELS is OFF' - write(iout,*) 'remove restart keyword from input' - endif - endif +c if(start_from_model .and. rest) then +c if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then +c write(iout,*) 'START_FROM_MODELS is OFF' +c write(iout,*) 'remove restart keyword from input' +c endif +c endif + if (start_from_model) nmodel_start=constr_homology if (homol_nset.gt.1)then call card_concat(controlcard) read(controlcard,*) (waga_homology(i),i=1,homol_nset) @@ -3089,17 +3151,20 @@ c tpl_k_rescore="template"//kic2//".sco" unres_pdb=.false. + nres_temp=nres if (read2sigma) then call readpdb_template(k) else call readpdb endif + nres_chomo(k)=nres + nres=nres_temp c c Distance restraints c c ... --> odl(k,ii) C Copy the coordinates from reference coordinates (?) - do i=1,2*nres + do i=1,2*nres_chomo(k) do j=1,3 c(j,i)=cref(j,i) c write (iout,*) "c(",j,i,") =",c(j,i) @@ -3562,6 +3627,7 @@ c---------------------------------------------------------------------- & ik,ll,ii,kk,iistart,iishift,lim_xx double precision distal logical lprn /.true./ + integer nres_temp integer ilen external ilen logical liiflag @@ -3596,7 +3662,10 @@ c Read pdb files stop 34 continue unres_pdb=.false. + nres_temp=nres call readpdb_template(k) + nres_chomo(k)=nres + nres=nres_temp do i=1,nres rescore(k,i)=0.2d0 rescore2(k,i)=1.0d0 @@ -3630,6 +3699,8 @@ c Distance restraints c c ... --> odl(k,ii) C Copy the coordinates from reference coordinates (?) + nres_temp=nres + nres=nres_chomo(k) do i=1,2*nres do j=1,3 c(j,i)=chomo(j,i,k) @@ -3642,6 +3713,7 @@ c write (iout,*) "c(",j,i,") =",c(j,i) thetaref(i)=theta(i) phiref(i)=phi(i) enddo + nres=nres_temp if (waga_dist.ne.0.0d0) then ii=0 do i = nnt,nct-2 diff --git a/source/unres/src-HCD-5D/regularize.F b/source/unres/src-HCD-5D/regularize.F index c506b8a..72d92da 100644 --- a/source/unres/src-HCD-5D/regularize.F +++ b/source/unres/src-HCD-5D/regularize.F @@ -7,7 +7,8 @@ include 'COMMON.HEADER' include 'COMMON.IOUNITS' include 'COMMON.MINIM' - double precision przes(3),obrot(3,3),fhpb0(maxdim),varia(maxvar) + double precision przes(3),obrot(3,3),fhpb0(maxdim_cont), + & varia(maxvar) double precision cref0(3,ncart) double precision energia(0:n_ene) logical non_conv diff --git a/source/unres/src-HCD-5D/ssMD.F b/source/unres/src-HCD-5D/ssMD.F index aa938b5..26807a0 100644 --- a/source/unres/src-HCD-5D/ssMD.F +++ b/source/unres/src-HCD-5D/ssMD.F @@ -84,10 +84,13 @@ ct rij=ran_number(rmin,rmax) C----------------------------------------------------------------------------- subroutine dyn_ssbond_ene(resi,resj,eij) -c implicit none - -c Includes + implicit none include 'DIMENSIONS' +#ifdef MPI + include 'mpif.h' + include 'COMMON.SETUP' + integer ierr +#endif include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -96,6 +99,7 @@ c Includes include 'COMMON.VAR' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.NAMES' #ifndef CLUST #ifndef WHAM include 'COMMON.MD' @@ -128,6 +132,9 @@ c integer itypi,itypj,k,l double precision omega,delta_inv,deltasq_inv,fac1,fac2 c-------FIRST METHOD double precision xm,d_xm(1:3) + double precision sslipi,sslipj,ssgradlipi,ssgradlipj + integer ici,icj,itypi,itypj + double precision boxshift,sscale,sscagrad c-------END FIRST METHOD c-------SECOND METHOD c$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3) @@ -144,125 +151,52 @@ c-------END TESTING CODE i=resi j=resj - + ici=icys(i) + icj=icys(j) + if (ici.eq.0 .or. icj.eq.0) then +#ifdef MPI + write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') + & "Processor",me," attempt to create", + & " a disulfide link between non-cysteine residues ",restyp(i),i, + & restyp(j),j + call MPI_Abort(MPI_COMM_WORLD,ierr) +#else + write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') + & "Processor",me," attempt to create", + & " a disulfide link between non-cysteine residues ",restyp(i),i, + & restyp(j),j + stop +#endif + endif itypi=itype(i) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) dsci_inv=vbld_inv(i+nres) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - xi=dmod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=dmod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=dmod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + call to_box(xi,yi,zi) C define scaling factor for lipids C if (positi.le.0) positi=positi+boxzsize C print *,i C first for peptide groups c for each residue check if it is in lipid or lipid water border area - if ((zi.gt.bordlipbot) - &.and.(zi.lt.bordliptop)) then -C the energy transfer exist - if (zi.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((positi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipi=sscalelip(fracinbuf) - ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) - sslipi=sscalelip(fracinbuf) - ssgradlipi=sscagradlip(fracinbuf)/lipbufthick - else - sslipi=1.0d0 - ssgradlipi=0.0 - endif - else - sslipi=0.0d0 - ssgradlipi=0.0 - endif + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) itypj=itype(j) - xj=c(1,nres+j) - yj=c(2,nres+j) - zj=c(3,nres+j) - xj=dmod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=dmod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=dmod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.gt.bordlipbot) - &.and.(zj.lt.bordliptop)) then -C the energy transfer exist - if (zj.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((positi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipj=sscalelip(fracinbuf) - ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) - sslipj=sscalelip(fracinbuf) - ssgradlipj=sscagradlip(fracinbuf)/lipbufthick - else - sslipj=1.0d0 - ssgradlipj=0.0 - endif - else - sslipj=0.0d0 - ssgradlipj=0.0 - endif + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 - - dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - subchap=1 - endif - enddo - enddo - enddo - if (subchap.eq.1) then - xj=xj_temp-xi - yj=yj_temp-yi - zj=zj_temp-zi - else - xj=xj_safe-xi - yj=yj_safe-yi - zj=zj_safe-zi - endif - -C xj=c(1,nres+j)-c(1,nres+i) -C yj=c(2,nres+j)-c(2,nres+i) -C zj=c(3,nres+j)-c(3,nres+i) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -522,9 +456,10 @@ c & "SSBOND_E_FORM",totT,t_bath,i,j c endif #endif #endif - dyn_ssbond_ij(i,j)=eij - else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then - dyn_ssbond_ij(i,j)=1.0d300 + dyn_ssbond_ij(ici,icj)=eij + else if (.not.havebond .and. dyn_ssbond_ij(ici,icj).lt.1.0d300) + &then + dyn_ssbond_ij(ici,icj)=1.0d300 #ifndef CLUST #ifndef WHAM c write(iout,'(a15,f12.2,f8.1,2i5)') @@ -646,16 +581,16 @@ c Includes c Local variables double precision emin integer i,j,imin - integer diff,allflag(maxdim),allnss, - & allihpb(maxdim),alljhpb(maxdim), - & newnss,newihpb(maxdim),newjhpb(maxdim) + integer diff,allflag(maxss),allnss, + & allihpb(maxss),alljhpb(maxss), + & newnss,newihpb(maxss),newjhpb(maxss) logical found integer i_newnss(max_fg_procs),displ(0:max_fg_procs) - integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss + integer g_newihpb(maxss),g_newjhpb(maxss),g_newnss allnss=0 - do i=1,nres-1 - do j=i+1,nres + do i=1,ns-1 + do j=i+1,ns if (dyn_ssbond_ij(i,j).lt.1.0d300) then allnss=allnss+1 allflag(allnss)=0 @@ -2037,7 +1972,7 @@ c$$$ end c$$$ c$$$C----------------------------------------------------------------------------- c$$$C----------------------------------------------------------------------------- - subroutine triple_ssbond_ene(resi,resj,resk,eij) + subroutine triple_ssbond_ene(resi,resj,resk,eij) include 'DIMENSIONS' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' diff --git a/source/unres/src-HCD-5D/stochfric.F b/source/unres/src-HCD-5D/stochfric.F index 368cf97..c83e9ce 100644 --- a/source/unres/src-HCD-5D/stochfric.F +++ b/source/unres/src-HCD-5D/stochfric.F @@ -496,6 +496,10 @@ c------------------------------------------------------------------ double precision time00 #endif include 'DIMENSIONS' +#ifndef FIVEDIAG + integer mmaxres2 + parameter (mmaxres2=(maxres2*(maxres2+1)/2)) +#endif include 'COMMON.VAR' include 'COMMON.CHAIN' include 'COMMON.DERIV' diff --git a/source/unres/src-HCD-5D/test.F b/source/unres/src-HCD-5D/test.F index ac867d9..1ea11ab 100644 --- a/source/unres/src-HCD-5D/test.F +++ b/source/unres/src-HCD-5D/test.F @@ -8,7 +8,7 @@ include 'COMMON.VAR' include 'COMMON.INTERACT' include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' include 'COMMON.SBRIDGE' include 'COMMON.CONTROL' include 'COMMON.FFIELD' @@ -129,7 +129,7 @@ c call write_pdb(999,'full min',etot) include 'COMMON.VAR' include 'COMMON.INTERACT' include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' include 'COMMON.SBRIDGE' include 'COMMON.CONTROL' include 'COMMON.FFIELD' @@ -324,7 +324,7 @@ c------------------------------------------ include 'COMMON.FFIELD' include 'COMMON.MINIM' c - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' integer if(20,maxres),nif,ifa(20) integer ibc(0:maxres,0:maxres),istrand(20) integer ibd(maxres),ifb(10,2),nifb,lifb(10),lifb0 @@ -1032,7 +1032,7 @@ c-------------------------------------------------------- include 'COMMON.FFIELD' include 'COMMON.MINIM' c - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' integer if(3,maxres),nif integer ibc(maxres,maxres),istrand(20) integer ibd(maxres),ifb(10,2),nifb,lifb(10),lifb0 @@ -1225,7 +1225,7 @@ c include 'COMMON.FFIELD' include 'COMMON.MINIM' c - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' integer if(2,2),ind integer iff(maxres) double precision time0,time1 @@ -1359,11 +1359,11 @@ c------------------------------------------------- include 'DIMENSIONS' include 'COMMON.CHAIN' include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' - integer ncont,icont(2,maxres*maxres/2),isec(maxres,3) + integer ncont,icont(2,maxres*maxint_res),isec(maxres,3) logical lprint,not_done - real dcont(maxres*maxres/2),d + real dcont(maxres*maxint_res),d real rcomp /7.0/ real rbeta /5.2/ real ralfa /5.2/ @@ -1709,152 +1709,3 @@ c---------------------------------------------------------------------------- end c----------------------------------------------------------- - subroutine contact_cp2(var,var2,iff,ieval,in_pdb) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.MINIM' - - character*50 linia - integer nf,ij(4) - double precision var(maxvar),var2(maxvar) - double precision time0,time1 - integer iff(maxres),ieval - double precision theta1(maxres),phi1(maxres),alph1(maxres), - & omeg1(maxres) - - - call var_to_geom(nvar,var) - call chainbuild - nhpb0=nhpb - ind=0 - do i=1,nres-3 - do j=i+3,nres - ind=ind+1 - if ( iff(i).eq.1.and.iff(j).eq.1 ) then - d0(ind)=DIST(i,j) - w(ind)=10.0 - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=10.0 - dhpb(nhpb)=d0(ind) - else - w(ind)=0.0 - endif - enddo - enddo - call hpb_partition - - do i=1,nres - theta1(i)=theta(i) - phi1(i)=phi(i) - alph1(i)=alph(i) - omeg1(i)=omeg(i) - enddo - - call var_to_geom(nvar,var2) - - do i=1,nres - if ( iff(i).eq.1 ) then - theta(i)=theta1(i) - phi(i)=phi1(i) - alph(i)=alph1(i) - omeg(i)=omeg1(i) - endif - enddo - - call chainbuild -cd call write_pdb(3,'combined structure',0d0) -cd time0=MPI_WTIME() - - NX=NRES-3 - NY=((NRES-4)*(NRES-5))/2 - call distfit(.true.,200) - -cd time1=MPI_WTIME() -cd write (iout,'(a,f6.2,a)') ' Time for distfit ',time1-time0,' sec' - - ipot0=ipot - maxmin0=maxmin - maxfun0=maxfun - wstrain0=wstrain - - ipot=6 - maxmin=2000 - maxfun=5000 - call geom_to_var(nvar,var) -cd time0=MPI_WTIME() - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun - -cd time1=MPI_WTIME() -cd write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0, -cd & nfun/(time1-time0),' SOFT eval/s' - call var_to_geom(nvar,var) - call chainbuild - - - iwsk=0 - nf=0 - if (iff(1).eq.1) then - iwsk=1 - nf=nf+1 - ij(nf)=0 - endif - do i=2,nres - if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then - iwsk=1 - nf=nf+1 - ij(nf)=i - endif - if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then - iwsk=0 - nf=nf+1 - ij(nf)=i-1 - endif - enddo - if (iff(nres).eq.1) then - nf=nf+1 - ij(nf)=nres - endif - - -cd write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)') -cd & "select",ij(1),"-",ij(2), -cd & ",",ij(3),"-",ij(4) -cd call write_pdb(in_pdb,linia,etot) - - - ipot=ipot0 - maxmin=maxmin0 - maxfun=maxfun0 -cd time0=MPI_WTIME() - call minimize(etot,var,iretcode,nfun) -cd write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun - ieval=nfun - -cd time1=MPI_WTIME() -cd write (iout,'(a,f6.2,f8.2,a)')' Time for DIST min.',time1-time0, -cd & nfun/(time1-time0),' eval/s' -cd call var_to_geom(nvar,var) -cd call chainbuild -cd call write_pdb(6,'dist structure',etot) - - - nhpb= nhpb0 - link_start=1 - link_end=nhpb - wstrain=wstrain0 - - return - end -c----------------------------------------------------------- diff --git a/source/wham/src-HCD/COMMON.HOMOLOGY b/source/wham/src-HCD/COMMON.HOMOLOGY index 03740bf..ea57f19 100644 --- a/source/wham/src-HCD/COMMON.HOMOLOGY +++ b/source/wham/src-HCD/COMMON.HOMOLOGY @@ -5,4 +5,4 @@ & dist2_cut common /homol/ waga_homology(maxR), & waga_dist,waga_angle,waga_theta,waga_d,dist_cut,dist2_cut, - & iset,ihset,l_homo(max_template,maxdim) + & iset,ihset,l_homo(max_template,maxdim_cont) diff --git a/source/wham/src-HCD/COMMON.HOMRESTR b/source/wham/src-HCD/COMMON.HOMRESTR index 95ea932..0e558f1 100644 --- a/source/wham/src-HCD/COMMON.HOMRESTR +++ b/source/wham/src-HCD/COMMON.HOMRESTR @@ -1,6 +1,7 @@ - real*8 odl(max_template,maxdim),sigma_odl(max_template,maxdim), + real*8 odl(max_template,maxdim_cont), + & sigma_odl(max_template,maxdim_cont), & dih(max_template,maxres),sigma_dih(max_template,maxres), - & sigma_odlir(max_template,maxdim) + & sigma_odlir(max_template,maxdim_cont) c c Specification of new variables used in subroutine e_modeller c modified by FP (Nov.,2014) @@ -10,7 +11,7 @@ c modified by FP (Nov.,2014) & sigma_d(max_template,maxres) c - integer ires_homo(maxdim),jres_homo(maxdim) + integer ires_homo(maxdim_cont),jres_homo(maxdim_cont) double precision & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst, diff --git a/source/wham/src-HCD/COMMON.SHIELD b/source/wham/src-HCD/COMMON.SHIELD index 1f96c94..8d89f0b 100644 --- a/source/wham/src-HCD/COMMON.SHIELD +++ b/source/wham/src-HCD/COMMON.SHIELD @@ -5,10 +5,11 @@ common /shield/ VSolvSphere,VSolvSphere_div,buff_shield, & long_r_sidechain(ntyp), & short_r_sidechain(ntyp),fac_shield(maxres),wshield, - & grad_shield_side(3,maxcont,-1:maxres),grad_shield(3,-1:maxres), - & grad_shield_loc(3,maxcont,-1:maxres), - & ishield_list(maxres),shield_list(maxcont,maxres), - & ees0plist(maxcont,maxres) + & grad_shield_side(3,maxint_res,-1:maxres), + & grad_shield(3,-1:maxres), + & grad_shield_loc(3,maxint_res,-1:maxres), + & ishield_list(maxres),shield_list(maxint_res,maxres), + & ees0plist(maxint_res,maxres) diff --git a/source/wham/src-HCD/DIMENSIONS b/source/wham/src-HCD/DIMENSIONS index 4d690f3..65b3e75 100644 --- a/source/wham/src-HCD/DIMENSIONS +++ b/source/wham/src-HCD/DIMENSIONS @@ -15,16 +15,19 @@ C Max. number of AA residues integer maxres c parameter (maxres=250) c parameter (maxres=1200) - parameter (maxres=5000) + parameter (maxres=10000) +C Max. number of cysteines and other bridging residues + integer max_cyst + parameter (max_cyst=100) C Appr. max. number of interaction sites integer maxres2 parameter (maxres2=2*maxres) c Max. number of chains integer maxchain - parameter (maxchain=6) + parameter (maxchain=50) C Max number of symetries integer maxsym,maxperm - parameter (maxsym=maxchain,maxperm=720) + parameter (maxsym=maxchain,maxperm=120) C Max. number of variables integer maxvar parameter (maxvar=4*maxres) @@ -42,6 +45,16 @@ C Max. number of SC contacts C Max. number of contacts per residue integer maxconts parameter (maxconts=maxres) +C Max. number of interactions within cutoff per residue + integer maxint_res + parameter (maxint_res=200) +C Max. number od residues within distance cufoff from a given residue to +C include in template-based/contact distance restraints. + integer maxcont_res + parameter (maxcont_res=200) +C Max. number of distance/contact-distance restraints + integer maxdim_cont + parameter (maxdim_cont=maxres*maxcont_res) C Number of AA types (at present only natural AA's will be handled integer ntyp,ntyp1 parameter (ntyp=24,ntyp1=ntyp+1) @@ -71,7 +84,7 @@ C Max. number of lobes in SC distribution parameter (maxlob=4) C Max. number of S-S bridges integer maxss - parameter (maxss=20) + parameter (maxss=max_cyst*(max_cyst-1)/2) C Max. number of dihedral angle constraints integer maxdih_constr parameter (maxdih_constr=maxres) diff --git a/source/wham/src-HCD/Makefile-tryton b/source/wham/src-HCD/Makefile-tryton new file mode 100644 index 0000000..b595c21 --- /dev/null +++ b/source/wham/src-HCD/Makefile-tryton @@ -0,0 +1,162 @@ +BIN = ~/unres/bin +FC = mpif90 -fc=ifort +OPT = -mcmodel=medium -shared-intel -O3 +#OPT = -O3 -intel-static -mcmodel=medium +#OPT = -O3 -ip -w +#OPT = -g -CB -mcmodel=medium -shared-intel +FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include +LIBS = -L$(INSTALL_DIR)/lib -lmpi xdrf/libxdrf.a + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + +objects = \ + wham_multparm.o \ + bxread.o \ + xread.o \ + cxread.o \ + enecalc1.o \ + energy_p_new.o \ + boxshift.o \ + gnmr1.o \ + initialize_p.o \ + molread_zs.o \ + openunits.o \ + readrtns.o \ + read_constr_homology.o \ + arcos.o \ + cartprint.o \ + chainbuild.o \ + geomout.o \ + icant.o \ + intcor.o \ + int_from_cart.o \ + refsys.o \ + make_ensemble1.o \ + matmult.o \ + misc.o \ + mygetenv.o \ + parmread.o \ + permut.o \ + seq2chains.o \ + chain_symmetry.o \ + iperm.o \ + pinorm.o \ + printmat.o \ + proc_proc.o \ + rescode.o \ + setup_var.o \ + slices.o \ + store_parm.o \ + timing.o \ + wham_calc1.o \ + PMFprocess.o \ + ssMD.o \ + oligomer.o + +objects_compar = \ + readrtns_compar.o \ + readpdb.o fitsq.o contact.o \ + elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ + angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ + rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o + +all: no_option + @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR" + +no_option: + +GAB: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM +GAB: ${objects} ${objects_compar} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD.exe + +GAB_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM -DDFA +GAB_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD-DFA.exe + +4P: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM +4P: ${objects} ${objects_compar} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD.exe + +4P_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM -DDFA +4P_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD-DFA.exe + +E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DFOURBODY -DAMD64 -DWHAM +E0LL2Y: ${objects} ${objects_compar} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD.exe + +E0LL2Y_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DFOURBODY -DAMD64 -DWHAM -DDFA +E0LL2Y_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD-DFA.exe + +NEWCORR: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DPGI -DISNAN -DAMD64 -DWHAM +NEWCORR: ${objects} ${objects_compar} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD.exe + +NEWCORR5D: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DPGI -DISNAN -DAMD64 -DWHAM -DFIVEDIAG +NEWCORR5D: ${objects} ${objects_compar} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -Wl,-M -o ${BIN}/wham_ifort_MPICH-tryton-HCD5-D.exe + +NEWCORR_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DDFA -DPGI -DISNAN -DAMD64 -DWHAM -DDFA +NEWCORR_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD-DFA-D.exe + +NEWCORR5D_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DDFA -DPGI -DISNAN -DAMD64 -DWHAM -DFIVEDIAG -DDFA +NEWCORR5D_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD5-DFA.exe + +xdrf/libxdrf.a: + cd xdrf && make + + +clean: + /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean + diff --git a/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos b/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos index e667382..b04295c 100644 --- a/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos +++ b/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos @@ -20,6 +20,7 @@ objects = \ cxread.o \ enecalc1.o \ energy_p_new.o \ + boxshift.o \ gnmr1.o \ initialize_p.o \ molread_zs.o \ @@ -27,7 +28,6 @@ objects = \ readrtns.o \ read_constr_homology.o \ arcos.o \ - cartder.o \ cartprint.o \ chainbuild.o \ geomout.o \ diff --git a/source/wham/src-HCD/boxshift.f b/source/wham/src-HCD/boxshift.f new file mode 100644 index 0000000..29d3406 --- /dev/null +++ b/source/wham/src-HCD/boxshift.f @@ -0,0 +1,101 @@ + +c------------------------------------------------------------------------ + double precision function boxshift(x,boxsize) + implicit none + double precision x,boxsize + double precision xtemp + xtemp=dmod(x,boxsize) + if (dabs(xtemp-boxsize).lt.dabs(xtemp)) then + boxshift=xtemp-boxsize + else if (dabs(xtemp+boxsize).lt.dabs(xtemp)) then + boxshift=xtemp+boxsize + else + boxshift=xtemp + endif + return + end +c-------------------------------------------------------------------------- + subroutine closest_img(xi,yi,zi,xj,yj,zj) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + integer xshift,yshift,zshift,subchap + double precision dist_init,xj_safe,yj_safe,zj_safe, + & xj_temp,yj_temp,zj_temp,dist_temp + xj_safe=xj + yj_safe=yj + zj_safe=zj + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + return + end +c-------------------------------------------------------------------------- + subroutine to_box(xi,yi,zi) + implicit none + include 'DIMENSIONS' + include 'COMMON.CHAIN' + double precision xi,yi,zi + xi=dmod(xi,boxxsize) + if (xi.lt.0.0d0) xi=xi+boxxsize + yi=dmod(yi,boxysize) + if (yi.lt.0.0d0) yi=yi+boxysize + zi=dmod(zi,boxzsize) + if (zi.lt.0.0d0) zi=zi+boxzsize + return + end +c-------------------------------------------------------------------------- + subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi) + implicit none + include 'DIMENSIONS' + include 'COMMON.CHAIN' + double precision xi,yi,zi,sslipi,ssgradlipi + double precision fracinbuf + double precision sscalelip,sscagradlip + + if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then +C the energy transfer exist + if (zi.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + return + end diff --git a/source/wham/src-HCD/cxread.F b/source/wham/src-HCD/cxread.F index cd29176..36ef6e6 100644 --- a/source/wham/src-HCD/cxread.F +++ b/source/wham/src-HCD/cxread.F @@ -171,8 +171,12 @@ c call flush(iout) c(j,i+nres+nnt-1)=xoord(j,i+nres) enddo enddo +c write (iout,*) "Before boxshift" +c call flush(iout) c Box shift call oligomer +c write (iout,*) "After oligomer" +c call flush(iout) do i=1,nres do j=1,3 xoord(j,i)=c(j,i) @@ -184,7 +188,8 @@ c Box shift enddo enddo c end change - +c write (iout,*) "Before islice" +c call flush(iout) if (islice.gt.0 .and. islice.le.nslice .and. (.not.separate_parset & .or. iset.eq.myparm)) then ii=ii+1 diff --git a/source/wham/src-HCD/enecalc1.F b/source/wham/src-HCD/enecalc1.F index 0040e37..60addc7 100644 --- a/source/wham/src-HCD/enecalc1.F +++ b/source/wham/src-HCD/enecalc1.F @@ -163,8 +163,8 @@ C write (iout,*) "tuz przed energia" C write (iout,*) "tuz za energia" #ifdef DEBUG write (iout,*) "Conformation",i -c write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), -c & ((c(l,k+nres),l=1,3),k=nnt,nct) + write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), + & ((c(l,k+nres),l=1,3),k=nnt,nct) call enerprint(energia(0),fT) c write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21) c write (iout,*) "ftors(1)",ftors(1) @@ -200,6 +200,8 @@ c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) if (ipar.eq.iparm) write (iout,*) i,iparm, & 1.0d0/(beta_h(ib,ipar)*1.987D-3),eini,energia(0) #endif +c write (iout,*) "eini",eini,"energia(0)",energia(0)," diff", +c & eini-energia(0) if (ipar.eq.iparm .and. einicheck.gt.0 .and. ! & dabs(eini-energia(0)-energia(27)).gt.tole) then & dabs(eini-energia(0)).gt.tole) then @@ -213,8 +215,8 @@ c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), & ((c(l,k+nres),l=1,3),k=nnt,nct) c call intout -c call pdbout(indstart(me1)+iii, -c & 1.0d0/(1.987D-3*beta_h(ib,ipar)),energia(0),eini,0.0d0,0.0d0) + call pdbout(indstart(me1)+iii, + & 1.0d0/(1.987D-3*beta_h(ib,ipar)),energia(0),eini,0.0d0,0.0d0) call enerprint(energia(0),fT) errmsg_count=errmsg_count+1 if (errmsg_count.gt.maxerrmsg_count) @@ -262,6 +264,7 @@ c call enerprint(energia(0),fT) iii=iii+1 if (q(1,iii).le.0.0d0 .and. indpdb.gt.0) & q(1,iii)=qwolynes(0,0,ipermin) +c write (iout,*) "iii",iii," q",q(1,iii) write (ientout,rec=iii) & ((csingle(l,k),l=1,3),k=1,nres), & ((csingle(l,k+nres),l=1,3),k=nnt,nct), diff --git a/source/wham/src-HCD/energy_p_new.F b/source/wham/src-HCD/energy_p_new.F index 6105156..ce7a6a7 100644 --- a/source/wham/src-HCD/energy_p_new.F +++ b/source/wham/src-HCD/energy_p_new.F @@ -159,6 +159,7 @@ c write (iout,*) "Calling multibody_hbond" call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) endif #endif +c write (iout,*) "nsaxs",nsaxs c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr if (nsaxs.gt.0 .and. saxs_mode.eq.0) then call e_saxs(Esaxs_constr) @@ -192,8 +193,12 @@ c write(iout,*)'edfan is finished!', wdfa_nei,edfanei edfabet=0.0d0 if (wdfa_beta.gt.0) call edfab(edfabet) c write(iout,*)'edfab is finished!', wdfa_beta,edfabet +#else + edfadis=0.0d0 + edfator=0.0d0 + edfanei=0.0d0 + edfabet=0.0d0 #endif - c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t #ifdef SPLITELE if (shield_mode.gt.0) then @@ -515,6 +520,9 @@ C Bartek edfator = energia(29) edfanei = energia(30) edfabet = energia(31) + Eafmforc=0.0d0 + etube=0.0d0 + Uconst=0.0d0 #ifdef SPLITELE write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp, & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1), @@ -680,6 +688,7 @@ cROZNICA xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) C Change 12/1/95 num_conti=0 C @@ -694,6 +703,10 @@ cd & 'iend=',iend(i,iint) xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) C Change 12/1/95 to calculate four-body interactions rij=xj*xj+yj*yj+zj*zj rrij=1.0D0/rij @@ -865,6 +878,7 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) C C Calculate SC interaction energy. C @@ -875,6 +889,10 @@ C xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) fac_augm=rrij**expon e_augm=augm(itypi,itypj)*fac_augm @@ -982,6 +1000,7 @@ c endif xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1014,9 +1033,13 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -1128,35 +1151,8 @@ c if (icall.gt.0) lprn=.true. yi=c(2,nres+i) zi=c(3,nres+i) C returning the ith atom to box - xi=mod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=mod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=mod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize - if ((zi.gt.bordlipbot) - &.and.(zi.lt.bordliptop)) then -C the energy transfer exist - if (zi.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((zi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipi=sscalelip(fracinbuf) - ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) - sslipi=sscalelip(fracinbuf) - ssgradlipi=sscagradlip(fracinbuf)/lipbufthick - else - sslipi=1.0d0 - ssgradlipi=0.0 - endif - else - sslipi=0.0d0 - ssgradlipi=0.0 - endif - + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1214,80 +1210,15 @@ c alf12=0.0D0 yj=c(2,nres+j) zj=c(3,nres+j) C returning jth atom to box - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.gt.bordlipbot) - &.and.(zj.lt.bordliptop)) then -C the energy transfer exist - if (zj.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((zj-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipj=sscalelip(fracinbuf) - ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick - elseif (zj.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) - sslipj=sscalelip(fracinbuf) - ssgradlipj=sscagradlip(fracinbuf)/lipbufthick - else - sslipj=1.0d0 - ssgradlipj=0.0 - endif - else - sslipj=0.0d0 - ssgradlipj=0.0 - endif - aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 - bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 -C if (aa.ne.aa_aq(itypi,itypj)) then - -C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa, -C & bb_aq(itypi,itypj)-bb, -C & sslipi,sslipj -C endif - -C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj) -C checking the distance - dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 -C finding the closest - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - subchap=1 - endif - enddo - enddo - enddo - if (subchap.eq.1) then - xj=xj_temp-xi - yj=yj_temp-yi - zj=zj_temp-zi - else - xj=xj_safe-xi - yj=yj_safe-yi - zj=zj_safe-zi - endif - + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -1413,6 +1344,8 @@ c if (icall.gt.0) lprn=.true. xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1447,9 +1380,21 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 +C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5') +C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj)) +C write(iout,*) "tu,", i,j,aa,bb,aa_lip(itypi,itypj),sslipi,sslipj + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -2271,12 +2216,7 @@ c end if xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi - xmedi=mod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=mod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=mod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize + call to_box(xmedi,ymedi,zmedi) num_conti=0 call eelecij(i,i+2,ees,evdw1,eel_loc) if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) @@ -2306,37 +2246,7 @@ c & .or. itype(i-1).eq.ntyp1 xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi -C Return atom into box, boxxsize is size of box in x dimension -c 194 continue -c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize -c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize -C Condition for being inside the proper box -c if ((xmedi.gt.((0.5d0)*boxxsize)).or. -c & (xmedi.lt.((-0.5d0)*boxxsize))) then -c go to 194 -c endif -c 195 continue -c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize -c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize -C Condition for being inside the proper box -c if ((ymedi.gt.((0.5d0)*boxysize)).or. -c & (ymedi.lt.((-0.5d0)*boxysize))) then -c go to 195 -c endif -c 196 continue -c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize -c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize -C Condition for being inside the proper box -c if ((zmedi.gt.((0.5d0)*boxzsize)).or. -c & (zmedi.lt.((-0.5d0)*boxzsize))) then -c go to 196 -c endif - xmedi=mod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=mod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=mod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize + call to_box(xmedi,ymedi,zmedi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -2376,43 +2286,7 @@ c & .or. itype(i-1).eq.ntyp1 xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi - xmedi=mod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=mod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=mod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize -C xmedi=xmedi+xshift*boxxsize -C ymedi=ymedi+yshift*boxysize -C zmedi=zmedi+zshift*boxzsize - -C Return tom into box, boxxsize is size of box in x dimension -c 164 continue -c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize -c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize -C Condition for being inside the proper box -c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or. -c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then -c go to 164 -c endif -c 165 continue -c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize -c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize -C Condition for being inside the proper box -c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or. -c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then -c go to 165 -c endif -c 166 continue -c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize -c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize -cC Condition for being inside the proper box -c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or. -c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then -c go to 166 -c endif - -c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) + call to_box(xmedi,ymedi,zmedi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -2518,73 +2392,10 @@ C zj=c(3,j)+0.5D0*dzj-zmedi xj=c(1,j)+0.5D0*dxj yj=c(2,j)+0.5D0*dyj zj=c(3,j)+0.5D0*dzj - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ" - dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - isubchap=0 - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - isubchap=1 - endif - enddo - enddo - enddo - if (isubchap.eq.1) then - xj=xj_temp-xmedi - yj=yj_temp-ymedi - zj=zj_temp-zmedi - else - xj=xj_safe-xmedi - yj=yj_safe-ymedi - zj=zj_safe-zmedi - endif -C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC -c 174 continue -c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize -c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize -C Condition for being inside the proper box -c if ((xj.gt.((0.5d0)*boxxsize)).or. -c & (xj.lt.((-0.5d0)*boxxsize))) then -c go to 174 -c endif -c 175 continue -c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize -c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize -C Condition for being inside the proper box -c if ((yj.gt.((0.5d0)*boxysize)).or. -c & (yj.lt.((-0.5d0)*boxysize))) then -c go to 175 -c endif -c 176 continue -c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize -c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize -C Condition for being inside the proper box -c if ((zj.gt.((0.5d0)*boxzsize)).or. -c & (zj.lt.((-0.5d0)*boxzsize))) then -c go to 176 -c endif -C endif !endPBC condintion -C xj=xj-xmedi -C yj=yj-ymedi -C zj=zj-zmedi + call to_box(xj,yj,zj) + xj=boxshift(xj-xmedi,boxxsize) + yj=boxshift(yj-ymedi,boxysize) + zj=boxshift(zj-zmedi,boxzsize) rij=xj*xj+yj*yj+zj*zj sss=sscale(sqrt(rij)) @@ -4075,13 +3886,7 @@ c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) zi=0.5D0*(c(3,i)+c(3,i+1)) -C Returning the ith atom to box - xi=mod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=mod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=mod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize + call to_box(xi,yi,zi) do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) @@ -4096,44 +3901,10 @@ C Uncomment following three lines for Ca-p interactions yj=c(2,j) zj=c(3,j) C returning the jth atom to box - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 -C Finding the closest jth atom - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - subchap=1 - endif - enddo - enddo - enddo - if (subchap.eq.1) then - xj=xj_temp-xi - yj=yj_temp-yi - zj=zj_temp-zi - else - xj=xj_safe-xi - yj=yj_safe-yi - zj=zj_safe-zi - endif + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) C sss is scaling function for smoothing the cutoff gradient otherwise C the gradient would not be continuouse diff --git a/source/wham/src-HCD/include_unres/COMMON.CALC b/source/wham/src-HCD/include_unres/COMMON.CALC index 67b4bb9..bf255c9 100644 --- a/source/wham/src-HCD/include_unres/COMMON.CALC +++ b/source/wham/src-HCD/include_unres/COMMON.CALC @@ -5,11 +5,11 @@ & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg + & dsci_inv,dscj_inv,gg,gg_lipi,gg_lipj common /calc/ erij(3),rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj, & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12, & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1, & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg(3),i,j + & dsci_inv,dscj_inv,gg(3),gg_lipi(3),gg_lipj(3),i,j diff --git a/source/wham/src-HCD/include_unres/COMMON.CONTMAT b/source/wham/src-HCD/include_unres/COMMON.CONTMAT index f0b6122..6e5b5d5 100644 --- a/source/wham/src-HCD/include_unres/COMMON.CONTMAT +++ b/source/wham/src-HCD/include_unres/COMMON.CONTMAT @@ -17,8 +17,9 @@ C 12/26/95 - H-bonding contacts & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), & ees0m(maxconts,maxres),d_cont(maxconts,maxres), & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions + double precision a_chuj,a_chuj_der + common /dipmat/ a_chuj(2,2,maxconts,maxres), + & a_chuj_der(2,2,3,5,maxconts,maxres) c 7/25/08 Commented out; not needed when cumulants used C Interactions of pseudo-dipoles generated by loc-el interactions. c double precision dip,dipderg,dipderx diff --git a/source/wham/src-HCD/include_unres/COMMON.CORRMAT b/source/wham/src-HCD/include_unres/COMMON.CORRMAT index 5f154e0..ae25625 100644 --- a/source/wham/src-HCD/include_unres/COMMON.CORRMAT +++ b/source/wham/src-HCD/include_unres/COMMON.CORRMAT @@ -30,9 +30,6 @@ C consecutive amino-acid residues. & costab2(maxres),sintab2(maxres) C This common block contains dipole-interaction matrices and their C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, & AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont,EAEA,EAEAderg,EAEAderx, diff --git a/source/wham/src-HCD/include_unres/COMMON.DERIV b/source/wham/src-HCD/include_unres/COMMON.DERIV index b694524..07bafe4 100644 --- a/source/wham/src-HCD/include_unres/COMMON.DERIV +++ b/source/wham/src-HCD/include_unres/COMMON.DERIV @@ -15,7 +15,9 @@ & gdfad,gdfat,gdfan,gdfab integer nfl,icg logical calc_grad - common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), +c common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), +c 3/12/20 Adam: Arrays dcdv, dxdv, and dxds removed following recoding of gradient. + common /derivat/ & gradx(3,-1:maxres,2),gradc(3,-1:maxres,2),gvdwx(3,-1:maxres), & gvdwc(3,-1:maxres),gelc(3,-1:maxres),gelc_long(3,-1:maxres), & gvdwpp(3,-1:maxres),gvdwc_scpp(3,-1:maxres), diff --git a/source/wham/src-HCD/include_unres/COMMON.SBRIDGE b/source/wham/src-HCD/include_unres/COMMON.SBRIDGE index 7facbfe..a313d8f 100644 --- a/source/wham/src-HCD/include_unres/COMMON.SBRIDGE +++ b/source/wham/src-HCD/include_unres/COMMON.SBRIDGE @@ -1,20 +1,22 @@ double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss - integer ns,nss,nfree,iss + integer ns,nss,nfree,iss,icys common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, - & ns,nss,nfree,iss(maxss) + & ns,nss,nfree,iss(maxss),icys(maxres) double precision dhpb,dhpb1,forcon,fordepth,xlscore,wboltzd, & dhpb_peak,dhpb1_peak,forcon_peak,fordepth_peak,scal_peak,bfac integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb,ibecarb_peak,npeak, & ipeak,irestr_type,irestr_type_peak,ihpb_peak,jhpb_peak,nhpb_peak logical restr_on_coord - common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), - & fordepth(maxdim),bfac(maxres),xlscore(maxdim),wboltzd, - & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),irestr_type(maxdim), + common /links/ dhpb(maxdim_cont),dhpb1(maxdim_cont), + & forcon(maxdim_cont),fordepth(maxdim_cont),bfac(maxres), + & xlscore(maxdim_cont),wboltzd,ihpb(maxdim_cont),jhpb(maxdim_cont), + & ibecarb(maxdim_cont),irestr_type(maxdim_cont), & nhpb,restr_on_coord - common /NMRpeaks/ dhpb_peak(maxdim),dhpb1_peak(maxdim), - & forcon_peak(maxdim),fordepth_peak(maxdim),scal_peak, - & ihpb_peak(maxdim),jhpb_peak(maxdim),ibecarb_peak(maxdim), - & irestr_type_peak(maxdim),ipeak(2,maxdim),npeak,nhpb_peak + common /NMRpeaks/ dhpb_peak(maxdim_cont),dhpb1_peak(maxdim_cont), + & forcon_peak(maxdim_cont),fordepth_peak(maxdim_cont),scal_peak, + & ihpb_peak(maxdim_cont),jhpb_peak(maxdim_cont), + & ibecarb_peak(maxdim_cont),irestr_type_peak(maxdim_cont), + & ipeak(2,maxdim_cont),npeak,nhpb_peak double precision weidis common /restraints/ weidis integer link_start,link_end,link_start_peak,link_end_peak @@ -23,7 +25,7 @@ double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss logical dyn_ss,dyn_ss_mask common /dyn_ssbond/ dtriss,atriss,btriss,ctriss,Ht, - & dyn_ssbond_ij(maxres,maxres), - & idssb(maxdim),jdssb(maxdim) + & dyn_ssbond_ij(max_cyst,max_cyst), + & idssb(maxss),jdssb(maxss) common /dyn_ss_logic/ & dyn_ss,dyn_ss_mask(maxres) diff --git a/source/wham/src-HCD/initialize_p.F b/source/wham/src-HCD/initialize_p.F index baf3aa2..a2281e5 100644 --- a/source/wham/src-HCD/initialize_p.F +++ b/source/wham/src-HCD/initialize_p.F @@ -183,7 +183,7 @@ C Initialize the bridge arrays do i=1,maxss iss(i)=0 enddo - do i=1,maxdim + do i=1,maxdim_cont dhpb(i)=0.0D0 enddo do i=1,maxres @@ -396,7 +396,7 @@ c--------------------------------------------------------------------------- include 'COMMON.IOUNITS' include "COMMON.TORCNSTR" logical scheck,lprint - lprint=.false. + lprint=.true. do i=1,maxres nint_gr(i)=0 nscp_gr(i)=0 diff --git a/source/wham/src-HCD/molread_zs.F b/source/wham/src-HCD/molread_zs.F index 878e4dd..e1a64f3 100644 --- a/source/wham/src-HCD/molread_zs.F +++ b/source/wham/src-HCD/molread_zs.F @@ -79,7 +79,7 @@ C Convert sequence to numeric code chain_border1(1,i)=chain_border(1,i)-1 chain_border1(2,i)=chain_border(2,i)+1 enddo - chain_border1(1,nchain)=chain_border(1,nchain)-1 + if (nchain.gt.1) chain_border1(1,nchain)=chain_border(1,nchain)-1 chain_border1(2,nchain)=nres write(iout,*) "nres",nres," nchain",nchain do i=1,nchain @@ -260,6 +260,7 @@ c call flush(iout) endif call setup_var + write (iout,*) "Calling init_int_table" call init_int_table if (ns.gt.0) then write (iout,'(/a,i3,a)') 'The chain contains',ns, @@ -332,6 +333,12 @@ C Read bridging residues. read (inp,*) ns,(iss(i),i=1,ns) print *,'ns=',ns write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns) +c 5/24/2020 Adam: Added a table to translate residue numbers to cysteine +c numbers + icys=0 + do i=1,ns + icys(iss(i))=i + enddo C Check whether the specified bridging residues are cystines. do i=1,ns if (itype(iss(i)).ne.1) then diff --git a/source/wham/src-HCD/parmread.F b/source/wham/src-HCD/parmread.F index ecf40a7..b21acb2 100644 --- a/source/wham/src-HCD/parmread.F +++ b/source/wham/src-HCD/parmread.F @@ -102,8 +102,8 @@ c V2SS = 7.61d0 V3SS = 13.7d0 - do i=1,maxres-1 - do j=i+1,maxres + do i=1,max_cyst-1 + do j=i+1,max_cyst dyn_ssbond_ij(i,j)=1.0d300 enddo enddo diff --git a/source/wham/src-HCD/readpdb.F b/source/wham/src-HCD/readpdb.F index 6f4ba5f..9efc6db 100644 --- a/source/wham/src-HCD/readpdb.F +++ b/source/wham/src-HCD/readpdb.F @@ -70,7 +70,7 @@ C geometry. sccalc=.true. endif ! Read free energy - if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp +c if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp ! Fish out the ATOM cards. if (index(card(1:4),'ATOM').gt.0) then sccalc=.false. diff --git a/source/wham/src-HCD/readrtns.F b/source/wham/src-HCD/readrtns.F index e7effcd..bca3771 100644 --- a/source/wham/src-HCD/readrtns.F +++ b/source/wham/src-HCD/readrtns.F @@ -95,6 +95,8 @@ c Cutoff range for interactions call reada(controlcard,"R_CUT",r_cut,25.0d0) call reada(controlcard,"LAMBDA",rlamb,0.3d0) + write (iout,*) "Cutoff on interactions",r_cut + write (iout,*) "lambda",rlamb call reada(controlcard,"LIPTHICK",lipthick,0.0d0) call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0) unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0 diff --git a/source/wham/src-HCD/ssMD.F b/source/wham/src-HCD/ssMD.F index ba32ff0..4ce1b3d 100644 --- a/source/wham/src-HCD/ssMD.F +++ b/source/wham/src-HCD/ssMD.F @@ -82,12 +82,10 @@ ct rij=ran_number(rmin,rmax) end C----------------------------------------------------------------------------- - subroutine dyn_ssbond_ene(resi,resj,eij) -c implicit none - -c Includes + implicit none include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -96,9 +94,10 @@ c Includes include 'COMMON.VAR' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.NAMES' #ifndef CLUST #ifndef WHAM -C include 'COMMON.MD' + include 'COMMON.MD' #endif #endif @@ -128,6 +127,10 @@ c integer itypi,itypj,k,l double precision omega,delta_inv,deltasq_inv,fac1,fac2 c-------FIRST METHOD double precision xm,d_xm(1:3) + double precision sslipi,sslipj,ssgradlipi,ssgradlipj + integer ici,icj,itypi,itypj + double precision boxshift,sscale,sscagrad + double precision aa,bb c-------END FIRST METHOD c-------SECOND METHOD c$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3) @@ -138,13 +141,21 @@ c-------TESTING CODE common /sschecks/ checkstop,transgrad integer icheck,nicheck,jcheck,njcheck - double precision echeck(-1:1),deps,ssx0,ljx0 + double precision echeck(-1:1),deps,ssx0,ljx0,xi,yi,zi c-------END TESTING CODE i=resi j=resj - + ici=icys(i) + icj=icys(j) + if (ici.eq.0 .or. icj.eq.0) then + write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') + & "Attempt to create", + & " a disulfide link between non-cysteine residues ",restyp(i),i, + & restyp(j),j + stop + endif itypi=itype(i) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) @@ -153,73 +164,27 @@ c-------END TESTING CODE xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) - xi=mod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=mod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=mod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize - if ((zi.gt.bordlipbot) - &.and.(zi.lt.bordliptop)) then -C the energy transfer exist - if (zi.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((zi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipi=sscalelip(fracinbuf) - ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) - sslipi=sscalelip(fracinbuf) - ssgradlipi=sscagradlip(fracinbuf)/lipbufthick - else - sslipi=1.0d0 - ssgradlipi=0.0 - endif - else - sslipi=0.0d0 - ssgradlipi=0.0 - endif + call to_box(xi,yi,zi) +C define scaling factor for lipids + +C if (positi.le.0) positi=positi+boxzsize +C print *,i +C first for peptide groups +c for each residue check if it is in lipid or lipid water border area + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) itypj=itype(j) xj=c(1,nres+j) yj=c(2,nres+j) zj=c(3,nres+j) - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.gt.bordlipbot) - &.and.(zj.lt.bordliptop)) then -C the energy transfer exist - if (zj.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((zj-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipj=sscalelip(fracinbuf) - ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick - elseif (zj.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) - sslipj=sscalelip(fracinbuf) - ssgradlipj=sscagradlip(fracinbuf)/lipbufthick - else - sslipj=1.0d0 - ssgradlipj=0.0 - endif - else - sslipj=0.0d0 - ssgradlipj=0.0 - endif + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 - xj=xj-xi - yj=yj-yi - zj=zj-zi + & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -237,6 +202,8 @@ C lipbufthick is thickenes of lipid buffore rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse + sss=sscale((1.0d0/rij)/sigma(itypi,itypj)) + sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj)) c The following are set in sc_angular c erij(1)=xj*rij c erij(2)=yj*rij @@ -316,15 +283,15 @@ c-------END TESTING CODE e1=fac*fac*aa e2=fac*bb eij=eps1*eps2rt*eps3rt*(e1+e2) -C write(iout,*) eij,'TU?1' eps2der=eij*eps3rt eps3der=eij*eps2rt - eij=eij*eps2rt*eps3rt + eij=eij*eps2rt*eps3rt*sss sigder=-sig/sigsq e1=e1*eps1*eps2rt**2*eps3rt**2 ed=-expon*(e1+eij)/ljd sigder=ed*sigder + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 eom12=eij*eps1_om12+eps2der*eps2rt_om12 @@ -333,8 +300,9 @@ C write(iout,*) eij,'TU?1' havebond=.true. ssd=rij-ssXs eij=ssA*ssd*ssd+ssB*ssd+ssC -C write(iout,*) 'TU?2',ssc,ssd + eij=eij*sss ed=2*akcm*ssd+akct*deltat12 + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij pom1=akct*ssd pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi eom1=-2*akth*deltat1-pom1-om2*pom2 @@ -369,13 +337,14 @@ c-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE h1=h_base(f1,hd1) h2=h_base(f2,hd2) eij=ssm*h1+Ht*h2 -C write(iout,*) eij,'TU?3' delta_inv=1.0d0/(xm-ssxm) deltasq_inv=delta_inv*delta_inv fac=ssm*hd1-Ht*hd2 fac1=deltasq_inv*fac*(xm-rij) fac2=deltasq_inv*fac*(rij-ssxm) ed=delta_inv*(Ht*hd2-ssm*hd1) + eij=eij*sss + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1) eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2) eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3) @@ -392,13 +361,14 @@ C write(iout,*) eij,'TU?3' h1=h_base(f1,hd1) h2=h_base(f2,hd2) eij=Ht*h1+ljm*h2 -C write(iout,*) 'TU?4',ssA delta_inv=1.0d0/(ljxm-xm) deltasq_inv=delta_inv*delta_inv fac=Ht*hd1-ljm*hd2 fac1=deltasq_inv*fac*(ljxm-rij) fac2=deltasq_inv*fac*(rij-xm) ed=delta_inv*(ljm*hd2-Ht*hd1) + eij=eij*sss + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1) eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2) eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3) @@ -464,7 +434,7 @@ c$$$ if (ed.gt.0.0d0) havebond=.true. c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE endif - write(iout,*) 'havebond',havebond + if (havebond) then #ifndef CLUST #ifndef WHAM @@ -474,9 +444,10 @@ c & "SSBOND_E_FORM",totT,t_bath,i,j c endif #endif #endif - dyn_ssbond_ij(i,j)=eij - else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then - dyn_ssbond_ij(i,j)=1.0d300 + dyn_ssbond_ij(ici,icj)=eij + else if (.not.havebond .and. dyn_ssbond_ij(ici,icj).lt.1.0d300) + &then + dyn_ssbond_ij(ici,icj)=1.0d300 #ifndef CLUST #ifndef WHAM c write(iout,'(a15,f12.2,f8.1,2i5)') @@ -501,6 +472,8 @@ c-------TESTING CODE checkstop=.false. endif c-------END TESTING CODE + gg_lipi(3)=ssgradlipi*eij + gg_lipj(3)=ssgradlipj*eij do k=1,3 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij @@ -510,10 +483,10 @@ c-------END TESTING CODE gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) enddo do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) + gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k) & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwx(k,j)=gvdwx(k,j)+gg(k) + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k) & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv enddo @@ -524,13 +497,12 @@ cgrad enddo cgrad enddo do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l) - gvdwc(l,j)=gvdwc(l,j)+gg(l) + gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(k) + gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(k) enddo return end - C----------------------------------------------------------------------------- double precision function h_base(x,deriv) @@ -571,9 +543,7 @@ c$$$ deriv=30.0d0*xsq*deriv return end - c---------------------------------------------------------------------------- - subroutine dyn_set_nss c Adjust nss and other relevant variables based on dyn_ssbond_ij c implicit none @@ -596,16 +566,16 @@ C include 'COMMON.MD' c Local variables double precision emin integer i,j,imin - integer diff,allflag(maxdim),allnss, - & allihpb(maxdim),alljhpb(maxdim), - & newnss,newihpb(maxdim),newjhpb(maxdim) + integer diff,allflag(maxdim_cont),allnss, + & allihpb(maxdim_cont),alljhpb(maxdim_cont), + & newnss,newihpb(maxdim_cont),newjhpb(maxdim_cont) logical found integer i_newnss(1024),displ(0:1024) - integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss + integer g_newihpb(maxdim_cont),g_newjhpb(maxdim_cont),g_newnss allnss=0 - do i=1,nres-1 - do j=i+1,nres + do i=1,ns-1 + do j=i+1,ns if (dyn_ssbond_ij(i,j).lt.1.0d300) then allnss=allnss+1 allflag(allnss)=0 @@ -749,1277 +719,8 @@ c Local variables end #endif #endif -c---------------------------------------------------------------------------- - - -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- - -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ integer i,iretcode,nfun_sc -c$$$ logical scfail -c$$$ double precision var(maxvar),e_sc,etot -c$$$ -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$c Minimize the two selected side-chains -c$$$ call overlap_sc(scfail) ! Better not fail! -c$$$ call minimize_sc(e_sc,var,iretcode,nfun_sc) -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------------- -c$$$ -c$$$ subroutine minimize_sc(etot_sc,iretcode,nfun) -c$$$c Minimize side-chains only, starting from geom but without modifying -c$$$c bond lengths. -c$$$c If mask_r is already set, only the selected side-chains are minimized, -c$$$c otherwise all side-chains are minimized keeping the backbone frozen. -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ integer icall -c$$$ common /srutu/ icall -c$$$ -c$$$c Output arguments -c$$$ double precision etot_sc -c$$$ integer iretcode,nfun -c$$$ -c$$$c External functions/subroutines -c$$$ external func_sc,grad_sc,fdum -c$$$ -c$$$c Local variables -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -c$$$ integer iv(liv) -c$$$ double precision rdum(1) -c$$$ double precision d(maxvar),v(1:lv),x(maxvar),xx(maxvar) -c$$$ integer idum(1) -c$$$ integer i,nvar_restr -c$$$ -c$$$ -c$$$cmc start_minim=.true. -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=1 -c$$$* selects output unit -c$$$ iv(21)=0 -c$$$c iv(21)=iout ! DEBUG -c$$$c iv(21)=8 ! DEBUG -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$c iv(22)=1 ! DEBUG -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$c iv(23)=1 ! DEBUG -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$c iv(24)=1 ! DEBUG -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-1 -c$$$ v(32)=rtolf -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,nphi -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ do i=nphi+1,nvar -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ -c$$$ call geom_to_var(nvar,x) -c$$$ IF (mask_r) THEN -c$$$ do i=1,nres ! Just in case... -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ELSE -c$$$c When minimizing ALL side-chains, etotal_sc is a little -c$$$c faster if we don't set mask_r -c$$$ do i=1,nres -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ mask_side(i)=1 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ENDIF -c$$$ call var_to_geom(nvar,x) -c$$$ call chainbuild_sc -c$$$ etot_sc=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6) -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine chainbuild_sc -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Local variables -c$$$ integer i -c$$$ -c$$$ -c$$$ do i=nnt,nct -c$$$ if (.not.mask_r .or. mask_side(i).eq.1) then -c$$$ call locate_side_chain(i) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision f -c$$$ -c$$$c Local variables -c$$$ double precision energia(0:n_ene) -c$$$#ifdef OSF -c$$$c Variables used to intercept NaNs -c$$$ double precision x_sum -c$$$ integer i_NAN -c$$$#endif -c$$$ -c$$$ -c$$$ nfl=nf -c$$$ icg=mod(nf,2)+1 -c$$$ -c$$$#ifdef OSF -c$$$c Intercept NaNs in the coordinates, before calling etotal_sc -c$$$ x_sum=0.D0 -c$$$ do i_NAN=1,n -c$$$ x_sum=x_sum+x(i_NAN) -c$$$ enddo -c$$$c Calculate the energy only if the coordinates are ok -c$$$ if ((.not.(x_sum.lt.0.D0)) .and. (.not.(x_sum.ge.0.D0))) then -c$$$ write(iout,*)" *** func_restr_sc : Found NaN in coordinates" -c$$$ f=1.0D+77 -c$$$ nf=0 -c$$$ else -c$$$#endif -c$$$ -c$$$ call var_to_geom_restr(n,x) -c$$$ call zerograd -c$$$ call chainbuild_sc -c$$$ call etotal_sc(energia(0)) -c$$$ f=energia(0) -c$$$ if (energia(1).eq.1.0D20 .or. energia(0).eq.1.0D99) nf=0 -c$$$ -c$$$#ifdef OSF -c$$$ endif -c$$$#endif -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------- -c$$$ -c$$$ subroutine grad_sc(n,x,nf,g,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.MINIM' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision g(maxvar) -c$$$ -c$$$c Local variables -c$$$ double precision f,gphii,gthetai,galphai,gomegai -c$$$ integer ig,ind,i,j,k,igall,ij -c$$$ -c$$$ -c$$$ icg=mod(nf,2)+1 -c$$$ if (nf-nfl+1) 20,30,40 -c$$$ 20 call func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$c write (iout,*) 'grad 20' -c$$$ if (nf.eq.0) return -c$$$ goto 40 -c$$$ 30 call var_to_geom_restr(n,x) -c$$$ call chainbuild_sc -c$$$C -c$$$C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -c$$$C -c$$$ 40 call cartder -c$$$C -c$$$C Convert the Cartesian gradient into internal-coordinate gradient. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ ind=nres-2 -c$$$ do i=2,nres-2 -c$$$ IF (mask_phi(i+2).eq.1) THEN -c$$$ gphii=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) -c$$$ gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ ig=ig+1 -c$$$ g(ig)=gphii -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ -c$$$ ind=0 -c$$$ do i=1,nres-2 -c$$$ IF (mask_theta(i+2).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gthetai=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) -c$$$ gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ g(ig)=gthetai -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ galphai=0.0D0 -c$$$ do k=1,3 -c$$$ galphai=galphai+dxds(k,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=galphai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gomegai=0.0D0 -c$$$ do k=1,3 -c$$$ gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=gomegai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$C -c$$$C Add the components corresponding to local energy terms. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ igall=0 -c$$$ do i=4,nres -c$$$ igall=igall+1 -c$$$ if (mask_phi(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do i=3,nres -c$$$ igall=igall+1 -c$$$ if (mask_theta(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do ij=1,2 -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ igall=igall+1 -c$$$ if (mask_side(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ endif -c$$$ enddo -c$$$ enddo -c$$$ -c$$$cd do i=1,ig -c$$$cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -c$$$cd enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine etotal_sc(energy_sc) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.FFIELD' -c$$$ -c$$$c Output arguments -c$$$ double precision energy_sc(0:n_ene) -c$$$ -c$$$c Local variables -c$$$ double precision evdw,escloc -c$$$ integer i,j -c$$$ -c$$$ -c$$$ do i=1,n_ene -c$$$ energy_sc(i)=0.0D0 -c$$$ enddo -c$$$ -c$$$ if (mask_r) then -c$$$ call egb_sc(evdw) -c$$$ call esc_sc(escloc) -c$$$ else -c$$$ call egb(evdw) -c$$$ call esc(escloc) -c$$$ endif -c$$$ -c$$$ if (evdw.eq.1.0D20) then -c$$$ energy_sc(0)=evdw -c$$$ else -c$$$ energy_sc(0)=wsc*evdw+wscloc*escloc -c$$$ endif -c$$$ energy_sc(1)=evdw -c$$$ energy_sc(12)=escloc -c$$$ -c$$$C -c$$$C Sum up the components of the Cartesian gradient. -c$$$C -c$$$ do i=1,nct -c$$$ do j=1,3 -c$$$ gradx(j,i,icg)=wsc*gvdwx(j,i) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_sc(evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$c if (icall.eq.0) lprn=.false. -c$$$ ind=0 -c$$$ do i=iatsc_s,iatsc_e -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$ do iint=1,nint_gr(i) -c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$ ENDIF -c$$$ enddo ! j -c$$$ enddo ! iint -c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine esc_sc(escloc) -c$$$C Calculate the local energy of a side chain and its derivatives in the -c$$$C corresponding virtual-bond valence angles THETA and the spherical angles -c$$$C ALPHA and OMEGA. -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.FFIELD' -c$$$ include 'COMMON.CONTROL' -c$$$ double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), -c$$$ & ddersc0(3),ddummy(3),xtemp(3),temp(3) -c$$$ common /sccalc/ time11,time12,time112,theti,it,nlobit -c$$$ delta=0.02d0*pi -c$$$ escloc=0.0D0 -c$$$c write (iout,'(a)') 'ESC' -c$$$ do i=loc_start,loc_end -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ it=itype(i) -c$$$ if (it.eq.10) goto 1 -c$$$ nlobit=nlob(it) -c$$$c print *,'i=',i,' it=',it,' nlobit=',nlobit -c$$$c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad -c$$$ theti=theta(i+1)-pipol -c$$$ x(1)=dtan(theti) -c$$$ x(2)=alph(i) -c$$$ x(3)=omeg(i) -c$$$ -c$$$ if (x(2).gt.pi-delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=pi-delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=pi-delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c escloci=esclocbi -c$$$c write (iout,*) escloci -c$$$ else if (x(2).lt.delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c write (iout,*) escloci -c$$$ else -c$$$ call enesc(x,escloci,dersc,ddummy,.false.) -c$$$ endif -c$$$ -c$$$ escloc=escloc+escloci -c$$$ if (energy_dec) write (iout,'(a6,i,0pf7.3)') -c$$$ & 'escloc',i,escloci -c$$$c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc -c$$$ -c$$$ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ -c$$$ & wscloc*dersc(1) -c$$$ gloc(ialph(i,1),icg)=wscloc*dersc(2) -c$$$ gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) -c$$$ 1 continue -c$$$ ENDIF -c$$$ enddo -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_ij(i_sc,j_sc,evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$ ind=0 -c$$$c$$$ do i=iatsc_s,iatsc_e -c$$$ i=i_sc -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$c$$$ do iint=1,nint_gr(i) -c$$$c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ j=j_sc -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$c$$$ enddo ! j -c$$$c$$$ enddo ! iint -c$$$c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine perturb_side_chain(i,angle) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i -c$$$ double precision angle ! In degrees -c$$$ -c$$$c Local variables -c$$$ integer i_sc -c$$$ double precision rad_ang,rand_v(3),length,cost,sint -c$$$ -c$$$ -c$$$ i_sc=i+nres -c$$$ rad_ang=angle*deg2rad -c$$$ -c$$$ length=0.0 -c$$$ do while (length.lt.0.01) -c$$$ rand_v(1)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(2)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(3)=ran_number(0.01D0,1.0D0) -c$$$ length=rand_v(1)*rand_v(1)+rand_v(2)*rand_v(2)+ -c$$$ + rand_v(3)*rand_v(3) -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ cost=rand_v(1)*dc_norm(1,i_sc)+rand_v(2)*dc_norm(2,i_sc)+ -c$$$ + rand_v(3)*dc_norm(3,i_sc) -c$$$ length=1.0D0-cost*cost -c$$$ if (length.lt.0.0D0) length=0.0D0 -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)-cost*dc_norm(1,i_sc) -c$$$ rand_v(2)=rand_v(2)-cost*dc_norm(2,i_sc) -c$$$ rand_v(3)=rand_v(3)-cost*dc_norm(3,i_sc) -c$$$ enddo -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ -c$$$ cost=dcos(rad_ang) -c$$$ sint=dsin(rad_ang) -c$$$ dc(1,i_sc)=vbld(i_sc)*(dc_norm(1,i_sc)*cost+rand_v(1)*sint) -c$$$ dc(2,i_sc)=vbld(i_sc)*(dc_norm(2,i_sc)*cost+rand_v(2)*sint) -c$$$ dc(3,i_sc)=vbld(i_sc)*(dc_norm(3,i_sc)*cost+rand_v(3)*sint) -c$$$ dc_norm(1,i_sc)=dc(1,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(2,i_sc)=dc(2,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(3,i_sc)=dc(3,i_sc)*vbld_inv(i_sc) -c$$$ c(1,i_sc)=c(1,i)+dc(1,i_sc) -c$$$ c(2,i_sc)=c(2,i)+dc(2,i_sc) -c$$$ c(3,i_sc)=c(3,i)+dc(3,i_sc) -c$$$ -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax3(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ double precision energy_sc(0:n_ene),etot -c$$$ double precision org_dc(3),org_dc_norm(3),org_c(3) -c$$$ double precision ang_pert,rand_fact,exp_fact,beta -c$$$ integer n,i_pert,i -c$$$ logical notdone -c$$$ -c$$$ -c$$$ beta=1.0D0 -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$ call etotal_sc(energy_sc) -c$$$ etot=energy_sc(0) -c$$$c write(iout,'(a,3d15.5)')" SS_MC_START ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ -c$$$ notdone=.true. -c$$$ n=0 -c$$$ do while (notdone) -c$$$ if (mod(n,2).eq.0) then -c$$$ i_pert=i_in -c$$$ else -c$$$ i_pert=j_in -c$$$ endif -c$$$ n=n+1 -c$$$ -c$$$ do i=1,3 -c$$$ org_dc(i)=dc(i,i_pert+nres) -c$$$ org_dc_norm(i)=dc_norm(i,i_pert+nres) -c$$$ org_c(i)=c(i,i_pert+nres) -c$$$ enddo -c$$$ ang_pert=ran_number(0.0D0,3.0D0) -c$$$ call perturb_side_chain(i_pert,ang_pert) -c$$$ call etotal_sc(energy_sc) -c$$$ exp_fact=exp(beta*(etot-energy_sc(0))) -c$$$ rand_fact=ran_number(0.0D0,1.0D0) -c$$$ if (rand_fact.lt.exp_fact) then -c$$$c write(iout,'(a,3d15.5)')" SS_MC_ACCEPT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ etot=energy_sc(0) -c$$$ else -c$$$c write(iout,'(a,3d15.5)')" SS_MC_REJECT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ do i=1,3 -c$$$ dc(i,i_pert+nres)=org_dc(i) -c$$$ dc_norm(i,i_pert+nres)=org_dc_norm(i) -c$$$ c(i,i_pert+nres)=org_c(i) -c$$$ enddo -c$$$ endif -c$$$ -c$$$ if (n.eq.10000.or.etot.lt.30.0D0) notdone=.false. -c$$$ enddo -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax2(etot,iretcode,nfun,i_in,j_in) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxres6*(maxres6+17)/2)) -c$$$********************************************************************* -c$$$* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for * -c$$$* the calling subprogram. * -c$$$* when d(i)=1.0, then v(35) is the length of the initial step, * -c$$$* calculated in the usual pythagorean way. * -c$$$* absolute convergence occurs when the function is within v(31) of * -c$$$* zero. unless you know the minimum value in advance, abs convg * -c$$$* is probably not useful. * -c$$$* relative convergence is when the model predicts that the function * -c$$$* will decrease by less than v(32)*abs(fun). * -c$$$********************************************************************* -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.CHAIN' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ double precision etot -c$$$ integer iretcode,nfun,i_in,j_in -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ external ss_func,fdum -c$$$ double precision ss_func,fdum -c$$$ -c$$$ integer iv(liv),uiparm(2) -c$$$ double precision v(lv),x(maxres6),d(maxres6),rdum -c$$$ integer i,j,k -c$$$ -c$$$ -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=2 -c$$$* selects output unit -c$$$c iv(21)=iout -c$$$ iv(21)=0 -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$ v(31)=1.0D-1 -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-4 -c$$$ v(32)=rtolf -c$$$ v(32)=1.0D-1 -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,6*nres -c$$$ d(i)=1.0D0 -c$$$ enddo -c$$$ -c$$$ do i=0,2*nres -c$$$ do j=1,3 -c$$$ orig_ss_dc(j,i)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ call geom_to_var(nvar,orig_ss_var) -c$$$ -c$$$ do i=1,nres -c$$$ do j=i,nres -c$$$ orig_ss_dist(j,i)=dist(j,i) -c$$$ orig_ss_dist(j+nres,i)=dist(j+nres,i) -c$$$ orig_ss_dist(j,i+nres)=dist(j,i+nres) -c$$$ orig_ss_dist(j+nres,i+nres)=dist(j+nres,i+nres) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i+nres) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ -c$$$ uiparm(1)=i_in -c$$$ uiparm(2)=j_in -c$$$ call smsno(k,d,x,ss_func,iv,liv,lv,v,uiparm,rdum,fdum) -c$$$ etot=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6)+iv(30) -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_func(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.SBRIDGE' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ integer n -c$$$ double precision x(maxres6) -c$$$ integer nf -c$$$ double precision f -c$$$ integer uiparm(2) -c$$$ real*8 urparm(1) -c$$$ external ufparm -c$$$ double precision ufparm -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ -c$$$ integer i,j,k,ss_i,ss_j -c$$$ double precision tempf,var(maxvar) -c$$$ -c$$$ -c$$$ ss_i=uiparm(1) -c$$$ ss_j=uiparm(2) -c$$$ f=0.0D0 -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ call geom_to_var(nvar,var) -c$$$ -c$$$c Constraints on all angles -c$$$ do i=1,nvar -c$$$ tempf=var(i)-orig_ss_var(i) -c$$$ f=f+tempf*tempf -c$$$ enddo -c$$$ -c$$$c Constraints on all distances -c$$$ do i=1,nres-1 -c$$$ if (i.gt.1) then -c$$$ tempf=dist(i+nres,i)-orig_ss_dist(i+nres,i) -c$$$ f=f+tempf*tempf -c$$$ endif -c$$$ do j=i+1,nres -c$$$ tempf=dist(j,i)-orig_ss_dist(j,i) -c$$$ if (tempf.lt.0.0D0 .or. j.eq.i+1) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i)-orig_ss_dist(j+nres,i) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j,i+nres)-orig_ss_dist(j,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i+nres)-orig_ss_dist(j+nres,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ enddo -c$$$ enddo -c$$$ -c$$$c Constraints for the relevant CYS-CYS -c$$$ tempf=dist(nres+ss_i,nres+ss_j)-8.0D0 -c$$$ f=f+tempf*tempf -c$$$CCCCCCCCCCCCCCCCC ADD SOME ANGULAR STUFF -c$$$ -c$$$c$$$ if (nf.ne.nfl) then -c$$$c$$$ write(iout,'(a,i10,2d15.5)')"IN DIST_FUNC (NF,F,DIST)",nf, -c$$$c$$$ + f,dist(5+nres,14+nres) -c$$$c$$$ endif -c$$$ -c$$$ nfl=nf -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$C----------------------------------------------------------------------------- - subroutine triple_ssbond_ene(resi,resj,resk,eij) +c$$$C---------------------------------------------------------------------------- + subroutine triple_ssbond_ene(resi,resj,resk,eij) include 'DIMENSIONS' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' diff --git a/source/wham/src-HCD/wham_calc1.F b/source/wham/src-HCD/wham_calc1.F index 31de33e..7e4512d 100644 --- a/source/wham/src-HCD/wham_calc1.F +++ b/source/wham/src-HCD/wham_calc1.F @@ -235,8 +235,8 @@ c potEmin=potEmin_t/2 c write (9,'(3i5,f10.5)') i,(iparm,potE(i,iparm),iparm=1,nParmSet) do iparm=1,nParmSet #ifdef DEBUG - write (iout,'(2i5,21f8.2)') i,iparm, - & (enetb(k,i,iparm),k=1,22) + write (iout,'(2i5,31f8.2)') i,iparm, + & (enetb(k,i,iparm),k=1,n_ene) #endif call restore_parm(iparm) #ifdef DEBUG -- 1.7.9.5