From a3ef63eda7d771657cc2df1d275e0a03a5cc1966 Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Wed, 28 Mar 2012 23:36:06 +0200 Subject: [PATCH] removal of CSA from MD version of code backup *~ files deleted other minor changes in the code --- source/unres/src_MD/COMMON.BANK | 29 - source/unres/src_MD/COMMON.CSA | 11 - source/unres/src_MD/COMMON.DERIV~ | 35 - source/unres/src_MD/COMMON.DISTFIT | 6 +- source/unres/src_MD/COMMON.FFIELD~ | 25 - source/unres/src_MD/COMMON.INTERACT~ | 29 - source/unres/src_MD/COMMON.IOUNITS | 10 +- source/unres/src_MD/COMMON.LANGEVIN.lang0_ | 11 - source/unres/src_MD/COMMON.MD | 7 +- source/unres/src_MD/COMMON.MD~ | 74 - source/unres/src_MD/COMMON.REMD~ | 35 - source/unres/src_MD/DIMENSIONS | 24 +- source/unres/src_MD/DIMENSIONS~ | 140 - source/unres/src_MD/MD_A-MTS.F | 84 +- source/unres/src_MD/MREMD.F | 6 + source/unres/src_MD/Makefile | 2 +- source/unres/src_MD/TAU | 6 - source/unres/src_MD/TAU_setup.sh | 15 - source/unres/src_MD/bank.F | 1086 --- source/unres/src_MD/cartder.F | 2 +- source/unres/src_MD/cinfo.f | 32 +- source/unres/src_MD/common.size | 130 - source/unres/src_MD/common.size.orig | 130 - source/unres/src_MD/compinfo | Bin 10291 -> 0 bytes source/unres/src_MD/csa.f | 363 - source/unres/src_MD/diff12.f | 27 - source/unres/src_MD/distfit.f | 207 - source/unres/src_MD/energy_p_new-sep_barrier.F.org | 2234 ----- source/unres/src_MD/energy_p_new_barrier.F | 69 +- source/unres/src_MD/energy_p_new_barrier.F.org | 8812 -------------------- source/unres/src_MD/energy_split-sep.F.org | 472 -- source/unres/src_MD/geomout.F | 14 + source/unres/src_MD/indexx.f | 81 - source/unres/src_MD/initialize_p.F | 2 + source/unres/src_MD/minim_jlee.F | 436 - source/unres/src_MD/minimize_p.F | 4 +- source/unres/src_MD/newconf.F | 2456 ------ source/unres/src_MD/newconf.f | Bin 1243 -> 0 bytes source/unres/src_MD/objects.sizes | 168 - source/unres/src_MD/parmread.F | 53 + source/unres/src_MD/ran.f | 128 - source/unres/src_MD/readrtns_CSA.F | 2585 ------ source/unres/src_MD/shift.F | 105 - source/unres/src_MD/test.F | 2534 +----- source/unres/src_MD/tmptmp | 2 +- source/unres/src_MD/together.F | 1223 --- source/unres/src_MD/unres | Bin 36040 -> 0 bytes source/unres/src_MD/unres.F | 8 +- 48 files changed, 563 insertions(+), 23349 deletions(-) delete mode 100644 source/unres/src_MD/COMMON.BANK delete mode 100644 source/unres/src_MD/COMMON.CSA delete mode 100644 source/unres/src_MD/COMMON.DERIV~ delete mode 100644 source/unres/src_MD/COMMON.FFIELD~ delete mode 100644 source/unres/src_MD/COMMON.INTERACT~ delete mode 100644 source/unres/src_MD/COMMON.LANGEVIN.lang0_ delete mode 100644 source/unres/src_MD/COMMON.MD~ delete mode 100644 source/unres/src_MD/COMMON.REMD~ delete mode 100644 source/unres/src_MD/DIMENSIONS~ delete mode 100644 source/unres/src_MD/TAU delete mode 100755 source/unres/src_MD/TAU_setup.sh delete mode 100644 source/unres/src_MD/bank.F delete mode 100644 source/unres/src_MD/common.size delete mode 100644 source/unres/src_MD/common.size.orig delete mode 100755 source/unres/src_MD/compinfo delete mode 100644 source/unres/src_MD/csa.f delete mode 100644 source/unres/src_MD/diff12.f delete mode 100644 source/unres/src_MD/distfit.f delete mode 100644 source/unres/src_MD/energy_p_new-sep_barrier.F.org delete mode 100644 source/unres/src_MD/energy_p_new_barrier.F.org delete mode 100644 source/unres/src_MD/energy_split-sep.F.org delete mode 100644 source/unres/src_MD/indexx.f delete mode 100644 source/unres/src_MD/minim_jlee.F delete mode 100644 source/unres/src_MD/newconf.F delete mode 100644 source/unres/src_MD/newconf.f delete mode 100644 source/unres/src_MD/objects.sizes delete mode 100644 source/unres/src_MD/ran.f delete mode 100644 source/unres/src_MD/readrtns_CSA.F delete mode 100644 source/unres/src_MD/shift.F delete mode 100644 source/unres/src_MD/together.F delete mode 100644 source/unres/src_MD/unres diff --git a/source/unres/src_MD/COMMON.BANK b/source/unres/src_MD/COMMON.BANK deleted file mode 100644 index 5b0fb34..0000000 --- a/source/unres/src_MD/COMMON.BANK +++ /dev/null @@ -1,29 +0,0 @@ - real*8 dihang,etot,bvar,bene,rene,rvar,avedif,difmin, - & ebmin,ebmax,ebmaxt,cutdif,dij,dihang_in - integer ibank,is,jbank,ibmin,ibmax,nbank,nconf,iuse,nstep,icycle, - & iseed,ntbank,ntbankm,iref,nconf_in,indb,ilastnstep, - & bvar_nss,bvar_ss,bvar_ns,bvar_s, - & nss_in,iss_in,jss_in,nadd - common/varin/dihang_in(mxang,maxres,mxch,mxio),nss_in(mxio), - & iss_in(maxss,mxio),jss_in(maxss,mxio) - common/minvar/dihang(mxang,maxres,mxch,mxio),etot(mxio),rmsn(mxio) - & ,pncn(mxio),nss_out(mxio), - & iss_out(maxss,mxio),jss_out(maxss,mxio) - common/bank/ - * bvar(mxang,maxres,mxch,mxio),bene(mxio),rene(mxio), - * brmsn(mxio),rrmsn(mxio), - * bpncn(mxio),rpncn(mxio), - * rvar(mxang,maxres,mxch,mxio),ibank(mxio),is(mxio), - * avedif,difmin,ebmin,ebmax,ebmaxt,dele,difcut,cutdif, - * rmscut,pnccut, - * jbank(mxio),dij(mxio,mxio),ibmin,ibmax, - * nbank,ntbank,ntbankm,nconf,iuse,nstep,icycle,iseed,iref, - * nconf_in,ilastnstep,nadd - common/bank_disulfid/ bvar_nss(mxio),bvar_ss(2,maxss,mxio), - * bvar_ns(mxio),bvar_s(maxss,mxio) - common/mvstat/ movenx(mxio),movernx(mxio), - & nstatnx(0:mxmv,3),nstatnx_tot(0:mxmv,3),indb(mxio,9), - & parent(3,mxio) - common/send2/isend2(mxio),iff_in(maxres,mxio2), - & dihang_in2(mxang,maxres,mxch,mxio2), - & idata(5,mxio) diff --git a/source/unres/src_MD/COMMON.CSA b/source/unres/src_MD/COMMON.CSA deleted file mode 100644 index 273a268..0000000 --- a/source/unres/src_MD/COMMON.CSA +++ /dev/null @@ -1,11 +0,0 @@ - integer ngroup,igroup,ntotgr,numch,irestart,ndiff - double precision diffcut - common/alphaa/ ngroup(mxgr),igroup(3,mxang,mxgr),ntotgr,numch - common/csa_input/cut1,cut2,eglob_csa,estop,jstart,jend, - & n1,n2,n3,n4,n5,n6,n7,n8,n9,n14,n15,n16,n17,n18,n0, - & is1,is2,nseed,ntotal,icmax,nstmax,irestart,nran0,nran1,irr, - & nglob_csa,nmin_csa,ndiff - logical ldih_bias - common/dih_control/rdih_bias,ldih_bias - common/diffcuta/ diffcut - diff --git a/source/unres/src_MD/COMMON.DERIV~ b/source/unres/src_MD/COMMON.DERIV~ deleted file mode 100644 index 524d72a..0000000 --- a/source/unres/src_MD/COMMON.DERIV~ +++ /dev/null @@ -1,35 +0,0 @@ - double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gelc_long, - & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp, - & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gloc_x,dtheta,dphi,dalpha, - & domega,gscloc,gsclocx,gradcorr,gradcorr_long,gradcorr5_long, - & gradcorr6_long,gcorr6_turn_long - integer nfl,icg - common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), - & gradx(3,maxres,2),gradc(3,maxres,2),gvdwx(3,maxres), - & gvdwc(3,maxres),gelc(3,maxres),gelc_long(3,maxres), - & gvdwpp(3,maxres),gvdwc_scpp(3,maxres), - & gradx_scp(3,maxres),gvdwc_scp(3,maxres),ghpbx(3,maxres), - & ghpbc(3,maxres),gloc(maxvar,2),gradcorr(3,maxres), - & gradcorr_long(3,maxres),gradcorr5_long(3,maxres), - & gradcorr6_long(3,maxres),gcorr6_turn_long(3,maxres), - & gradxorr(3,maxres),gradcorr5(3,maxres),gradcorr6(3,maxres), - & gloc_x(maxvar,2),gel_loc(3,maxres),gel_loc_long(3,maxres), - & gcorr3_turn(3,maxres), - & gcorr4_turn(3,maxres),gcorr6_turn(3,maxres),gradb(3,maxres), - & gradbx(3,maxres),gel_loc_loc(maxvar),gel_loc_turn3(maxvar), - & gel_loc_turn4(maxvar),gel_loc_turn6(maxvar),gcorr_loc(maxvar), - & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres), - & gsccorx(3,maxres),gsccor_loc(maxres),dtheta(3,2,maxres), - & gscloc(3,maxres),gsclocx(3,maxres), - & dphi(3,3,maxres),dalpha(3,3,maxres),domega(3,3,maxres),nfl,icg - double precision derx,derx_turn - common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2) - double precision dXX_C1tab(3,maxres),dYY_C1tab(3,maxres), - & dZZ_C1tab(3,maxres),dXX_Ctab(3,maxres),dYY_Ctab(3,maxres), - & dZZ_Ctab(3,maxres),dXX_XYZtab(3,maxres),dYY_XYZtab(3,maxres), - & dZZ_XYZtab(3,maxres) - common /deriv_scloc/ dXX_C1tab,dYY_C1tab,dZZ_C1tab,dXX_Ctab, - & dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,dZZ_XYZtab - integer igrad_start,igrad_end,jgrad_start(maxres), - & jgrad_end(maxres) - common /mpgrad/ igrad_start,igrad_end,jgrad_start,jgrad_end diff --git a/source/unres/src_MD/COMMON.DISTFIT b/source/unres/src_MD/COMMON.DISTFIT index 044225b..683228a 100644 --- a/source/unres/src_MD/COMMON.DISTFIT +++ b/source/unres/src_MD/COMMON.DISTFIT @@ -4,9 +4,9 @@ c parameter (maxres22=maxres*(maxres+1)/2) integer nbfrag,bfrag,nhfrag,hfrag,bvar_frag,hvar_frag,nhpb0, 1 lvar_frag,svar_frag,avar_frag COMMON /c_frag/ nbfrag,bfrag(4,maxres/3),nhfrag,hfrag(2,maxres/3) - COMMON /frag/ bvar_frag(mxio,6),hvar_frag(mxio,3), - 1 lvar_frag(mxio,3),svar_frag(mxio,3), - 2 avar_frag(mxio,5) +csa COMMON /frag/ bvar_frag(mxio,6),hvar_frag(mxio,3), +csa 1 lvar_frag(mxio,3),svar_frag(mxio,3), +csa 2 avar_frag(mxio,5) COMMON /WAGI/ w(MAXRES22),d0(MAXRES22) COMMON /POCHODNE/ NX,NY,DRDG(MAXRES22,MAXRES),DD(MAXRES22), 1 H(MAXRES,MAXRES),XX(MAXRES) diff --git a/source/unres/src_MD/COMMON.FFIELD~ b/source/unres/src_MD/COMMON.FFIELD~ deleted file mode 100644 index d7d8cde..0000000 --- a/source/unres/src_MD/COMMON.FFIELD~ +++ /dev/null @@ -1,25 +0,0 @@ -C----------------------------------------------------------------------- -C The following COMMON block selects the type of the force field used in -C calculations and defines weights of various energy terms. -C 12/1/95 wcorr added -C----------------------------------------------------------------------- - integer n_ene_comp,rescale_mode - common /ffield/ wsc,wscp,welec,wbond,wstrain,wtor,wtor_d,wang, - & wscloc,wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4, - & wturn6,wvdwpp,weights(n_ene),temp0, - & scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp, - & rescale_mode - common /potentials/ potname(5) - character*3 potname -C----------------------------------------------------------------------- -C wlong,welec,wtor,wang,wscloc are the weight of the energy terms -C corresponding to side-chain, electrostatic, torsional, valence-angle, -C and local side-chain terms. -C -C IPOT determines which SC...SC interaction potential will be used: -C 1 - LJ: 2n-n Lennard-Jones -C 2 - LJK: 2n-n Kihara type (shifted Lennard-Jones) -C 3 - BP; Berne-Pechukas (angular dependence) -C 4 - GB; Gay-Berne (angular dependence) -C 5 - GBV; Gay-Berne-Vorobjev; angularly-dependent Kihara potential -C------------------------------------------------------------------------ diff --git a/source/unres/src_MD/COMMON.INTERACT~ b/source/unres/src_MD/COMMON.INTERACT~ deleted file mode 100644 index f06d76f..0000000 --- a/source/unres/src_MD/COMMON.INTERACT~ +++ /dev/null @@ -1,29 +0,0 @@ - double precision aa,bb,augm,aad,bad,app,bpp,ale6,ael3,ael6 - integer expon,expon2 - integer nnt,nct,nint_gr,istart,iend,itype,itel,itypro, - & ielstart,ielend,ielstart_vdw,ielend_vdw,nscp_gr,iscpstart, - & iscpend,iatsc_s,iatsc_e, - & iatel_s,iatel_e,iatscp_s,iatscp_e,iatel_s_vdw,iatel_e_vdw, - & ispp,iscp - common /interact/aa(ntyp,ntyp),bb(ntyp,ntyp),augm(ntyp,ntyp), - & aad(ntyp,2),bad(ntyp,2),app(2,2),bpp(2,2),ael6(2,2),ael3(2,2), - & expon,expon2,nnt,nct,nint_gr(maxres),istart(maxres,maxint_gr), - & iend(maxres,maxint_gr),itype(maxres),itel(maxres),itypro, - & ielstart(maxres),ielend(maxres),ielstart_vdw(maxres), - & ielend_vdw(maxres),nscp_gr(maxres), - & iscpstart(maxres,maxint_gr),iscpend(maxres,maxint_gr), - & iatsc_s,iatsc_e,iatel_s,iatel_e,iatel_s_vdw,iatel_e_vdw, - & iatscp_s,iatscp_e,ispp,iscp -C 12/1/95 Array EPS included in the COMMON block. - double precision eps,sigma,sigmaii,rs0,chi,chip,alp,sigma0,sigii, - & rr0,r0,r0e,r0d,rpp,epp,elpp6,elpp3,eps_scp,rscp - common /body/eps(ntyp,ntyp),sigma(0:ntyp1,0:ntyp1), - & sigmaii(ntyp,ntyp), - & rs0(ntyp,ntyp),chi(ntyp,ntyp),chip(ntyp),alp(ntyp),sigma0(ntyp), - & sigii(ntyp),rr0(ntyp),r0(ntyp,ntyp),r0e(ntyp,ntyp),r0d(ntyp,2), - & rpp(2,2),epp(2,2),elpp6(2,2),elpp3(2,2),eps_scp(20,2),rscp(20,2) -c 12/5/03 modified 09/18/03 Bond stretching parameters. - double precision vbldp0,vbldsc0,akp,aksc,abond0 - integer nbondterm - common /stretch/ vbldp0,vbldsc0(maxbondterm,ntyp),akp, - & aksc(maxbondterm,ntyp),abond0(maxbondterm,ntyp),nbondterm(ntyp) diff --git a/source/unres/src_MD/COMMON.IOUNITS b/source/unres/src_MD/COMMON.IOUNITS index a9ace0b..49b6db3 100644 --- a/source/unres/src_MD/COMMON.IOUNITS +++ b/source/unres/src_MD/COMMON.IOUNITS @@ -11,11 +11,11 @@ C General I/O units & files integer inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep,irotam, & itorp,itordp,ifourier,ielep,isidep,iscpp,icbase,istat, & ientin,ientout,izs1,isecpred,ibond,irest2,iifrag,icart, - & irest1,isccor + & irest1,isccor,ithep_pdb,irotam_pdb common /iounits/ inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep, & irotam,itorp,itordp,ifourier,ielep,isidep,iscpp,icbase, & istat,ientin,ientout,izs1,isecpred,ibond,irest2,iifrag, - & icart,irest1,isccor + & icart,irest1,isccor,ithep_pdb,irotam_pdb character*256 outname,intname,pdbname,mol2name,statname,intinname, & entname,prefix,secpred,rest2name,qname,cartname,tmpdir, & mremd_rst_name,curdir,pref_orig @@ -38,9 +38,11 @@ C CSA I/O units & files & icsa_bank_reminimized,icsa_native_int,icsa_in,icsa_pdb C Parameter files character*256 bondname,thetname,rotname,torname,tordname, - & fouriername,elename,sidename,scpname,sccorname,patname + & fouriername,elename,sidename,scpname,sccorname,patname, + & thetname_pdb,rotname_pdb common /parfiles/ bondname,thetname,rotname,torname,tordname, - & fouriername,elename,sidename,scpname,sccorname,patname + & fouriername,elename,sidename,scpname,sccorname,patname, + & thetname_pdb,rotname_pdb character*3 pot C----------------------------------------------------------------------- C INP - main input file diff --git a/source/unres/src_MD/COMMON.LANGEVIN.lang0_ b/source/unres/src_MD/COMMON.LANGEVIN.lang0_ deleted file mode 100644 index 26eb500..0000000 --- a/source/unres/src_MD/COMMON.LANGEVIN.lang0_ +++ /dev/null @@ -1,11 +0,0 @@ - double precision friction(3,0:MAXRES2),stochforc(3,0:MAXRES2), - & fricmat(MAXRES6,MAXRES6),fric_work(MAXRES6), - & stoch_work(MAXRES6), - & fricgam(MAXRES6),fricvec(MAXRES6,MAXRES6) - logical flag_stoch(0:maxflag_stoch) - common /langforc/ friction,stochforc, - & fricmat,fric_work,fricgam,stoch_work,fricvec,vrand_mat1, - & vrand_mat2,prand_mat,vfric_mat,afric_mat,pfric_mat, - & pfric0_mat,afric0_mat,vfric0_mat,prand0_mat,vrand0_mat1, - & vrand0_mat2,flag_stoch - common /langmat/ mt1,mt2,mt3 diff --git a/source/unres/src_MD/COMMON.MD b/source/unres/src_MD/COMMON.MD index 22dba7c..6ce6a3f 100644 --- a/source/unres/src_MD/COMMON.MD +++ b/source/unres/src_MD/COMMON.MD @@ -66,9 +66,12 @@ & ng_start(0:MaxProcs-1),ng_counts(0:MaxProcs-1), & nginv_start(0:MaxProcs),nginv_counts(0:MaxProcs-1) double precision pi_np,pistar,s_np,s12_np,Q_np,E_old,H0,E_long, - & sold_np,d_t_half,Csplit + & sold_np,d_t_half,Csplit,hhh common /nosepoincare/ pi_np,pistar,s_np,s12_np,Q_np,E_old,H0, - & E_long,sold_np,d_t_half(3,0:MAXRES2),Csplit + & E_long,sold_np,d_t_half(3,0:MAXRES2),Csplit,hhh common /nosehoover/ glogs(maxmnh),qmass(maxmnh), & vlogs(maxmnh),xlogs(maxmnh), & nresn,nyosh,nnos,xiresp + integer hmc,hmc_acc + double precision dc_hmc,hmc_etot,totThmc + common /hmc_md/ dc_hmc(3,0:maxres2),hmc_etot,hmc,totThmc,hmc_acc diff --git a/source/unres/src_MD/COMMON.MD~ b/source/unres/src_MD/COMMON.MD~ deleted file mode 100644 index b0d62c9..0000000 --- a/source/unres/src_MD/COMMON.MD~ +++ /dev/null @@ -1,74 +0,0 @@ - double precision gcart, gxcart, gradcag,gradxag - common /mdgrad/ gcart(3,0:MAXRES), gxcart(3,0:MAXRES), - & gradcag(3,MAXRES),gradxag(3,MAXRES) - integer dimen,dimen1, dimen3, ifrag(2,50,maxprocs/20), - & ipair(2,100,maxprocs/20),iset, - & mset(maxprocs/20),nset - double precision IP,ISC(ntyp+1),mp, - & msc(ntyp+1),d_t_work(MAXRES6), - & d_t_work_new(MAXRES6),d_t(3,0:MAXRES2),d_t_new(3,0:MAXRES2), - & d_af_work(MAXRES6),d_as_work(MAXRES6), - & d_t_old(3,0:MAXRES2),d_a_old(3,0:MAXRES2),d_a_short(3,0:MAXRES2), - & Gmat(MAXRES2,MAXRES2),Ginv(MAXRES2,MAXRES2),A(MAXRES2,MAXRES2), - & d_a(3,0:MAXRES2),d_a_work(6*MAXRES),kinetic_force(MAXRES6), - & Gsqrp(MAXRES2,MAXRES2),Gsqrm(MAXRES2,MAXRES2), - & vtot(MAXRES2),Gvec(maxres2,maxres2),Geigen(maxres2) - double precision v_ini,d_time,d_time0,t_bath,tau_bath, - & EK,potE,potEcomp(0:n_ene+4),totE,totT,amax,kinetic_T,dvmax,damax, - & edriftmax, - & eq_time,wfrag(50,maxprocs/20),wpair(100,maxprocs/20), - & qfrag(50),qpair(100), - & qinfrag(50,maxprocs/20),qinpair(100,maxprocs/20), - & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst, - & dUdxconst(3,0:MAXRES),dqwol(3,0:MAXRES),dxqwol(3,0:MAXRES), - & utheta(maxfrag_back),ugamma(maxfrag_back),uscdiff(maxfrag_back), - & dutheta(maxres),dugamma(maxres),duscdiff(3,maxres), - & duscdiffx(3,maxres),wfrag_back(3,maxfrag_back,maxprocs/20), - & uconst_back - integer n_timestep,ntwx,ntwe,lang,count_reset_moment, - & count_reset_vel,reset_fricmat,nfrag,npair,nfrag_back, - & ifrag_back(3,maxfrag_back,maxprocs/20),ntime_split,ntime_split0, - & maxtime_split - integer nresn,nyosh,nnos,hremd - double precision glogs,qmass,vlogs,xlogs - logical large,print_compon,tbf,rest,reset_moment,reset_vel, - & surfarea,rattle,usampl,mdpdb,RESPA,tnp,tnp1,tnh,xiresp - integer igmult_start,igmult_end,my_ng_count,ng_start,ng_counts, - & nginv_start,nginv_counts,myginv_ng_count - common /back_constr/ uconst_back,utheta,ugamma,uscdiff, - & dutheta,dugamma,duscdiff,duscdiffx, - & wfrag_back,nfrag_back,ifrag_back - common /qmeas/ qfrag,qpair,qinfrag,qinpair,wfrag,wpair,eq_time, - & Ucdfrag,Ucdpair,dUdconst,dUdxconst,dqwol,dxqwol,Uconst, - & iset,mset,nset,usampl,ifrag,ipair,npair,nfrag - common /mdpar/ v_ini,d_time,d_time0,scal_fric, - & t_bath,tau_bath,dvmax,damax,n_timestep,mdpdb, - & ntime_split,ntime_split0,maxtime_split, - & ntwx,ntwe,large,print_compon,tbf,rest,tnp,tnp1,tnh,hremd - common /MDcalc/ totT,totE,potE,potEcomp,EK,amax,edriftmax, - & kinetic_T - common /lagrange/ d_t,d_t_old,d_t_new,d_t_work, - & d_t_work_new,d_a,d_a_old,d_a_work,d_af_work,d_as_work,d_a_short, - & kinetic_force, - & A,Ginv,Gmat,Gvec,Geigen,Gsqrp,Gsqrm, - & vtot,dimen,dimen1,dimen3,lang, - & reset_moment,reset_vel,count_reset_moment,count_reset_vel, - & rattle,RESPA - common /inertia/ IP,ISC,MP,MSC - double precision scal_fric,rwat,etawat,gamp, - & gamsc(ntyp),stdfp,stdfsc(ntyp),stdforcp(MAXRES), - & stdforcsc(MAXRES),pstok,restok(ntyp+1),cPoise,Rb - common /langevin/ pstok,restok,gamp,gamsc, - & stdfp,stdfsc,stdforcp,stdforcsc,rwat,etawat,cPoise,Rb,surfarea, - & reset_fricmat - common /mdpmpi/ igmult_start,igmult_end,my_ng_count, - & myginv_ng_count, - & ng_start(0:MaxProcs-1),ng_counts(0:MaxProcs-1), - & nginv_start(0:MaxProcs),nginv_counts(0:MaxProcs-1) - double precision pi_np,pistar,s_np,s12_np,Q_np,E_old,H0,E_long, - & sold_np,d_t_half,Csplit - common /nosepoincare/ pi_np,pistar,s_np,s12_np,Q_np,E_old,H0, - & E_long,sold_np,d_t_half(3,0:MAXRES2),Csplit - common /nosehoover/ glogs(maxmnh),qmass(maxmnh), - & vlogs(maxmnh),xlogs(maxmnh), - & nresn,nyosh,nnos,xiresp diff --git a/source/unres/src_MD/COMMON.REMD~ b/source/unres/src_MD/COMMON.REMD~ deleted file mode 100644 index ea79752..0000000 --- a/source/unres/src_MD/COMMON.REMD~ +++ /dev/null @@ -1,35 +0,0 @@ - integer nrep,nstex,hremd - logical remd_tlist,remd_mlist,mremdsync,restart1file,traj1file - double precision retmin,retmax,remd_t(maxprocs) - double precision hweights(maxprocs/20,n_ene) - integer remd_m(maxprocs),i_sync_step - integer*2 i2rep(0:maxprocs),i2set(0:maxprocs) - integer*2 ifirst(maxprocs) - integer*2 nupa(0:maxprocs/4,0:maxprocs), - & ndowna(0:maxprocs/4,0:maxprocs) - real t_restart1(5,maxprocs) - integer iset_restart1(maxprocs) - common /remdcommon/ nrep,nstex,retmin,retmax,remd_t,remd_tlist, - & remd_mlist,remd_m,mremdsync,restart1file, - & traj1file,i_sync_step - common /hamilt_remd/ hweights,hremd - common /remdrestart/ i2rep,i2set,ifirst,nupa,ndowna,t_restart1, - & iset_restart1 - real totT_cache,EK_cache,potE_cache,t_bath_cache,Uconst_cache, - & qfrag_cache,qpair_cache,c_cache, - & ugamma_cache,utheta_cache - integer ntwx_cache,ii_write,max_cache_traj_use - common /traj1cache/ totT_cache(max_cache_traj), - & EK_cache(max_cache_traj), - & potE_cache(max_cache_traj), - & t_bath_cache(max_cache_traj), - & Uconst_cache(max_cache_traj), - & qfrag_cache(50,max_cache_traj), - & qpair_cache(100,max_cache_traj), - & ugamma_cache(maxfrag_back,max_cache_traj), - & utheta_cache(maxfrag_back,max_cache_traj), - & uscdiff_cache(maxfrag_back,max_cache_traj), - & c_cache(3,maxres2+2,max_cache_traj), - & iset_cache(max_cache_traj),ntwx_cache, - & ii_write,max_cache_traj_use - diff --git a/source/unres/src_MD/DIMENSIONS b/source/unres/src_MD/DIMENSIONS index e9c0e9b..224dade 100644 --- a/source/unres/src_MD/DIMENSIONS +++ b/source/unres/src_MD/DIMENSIONS @@ -106,18 +106,18 @@ C Maximum number of groups of angles C Maximum number of chains integer mxch parameter (mxch=1) -C Maximum number of generated conformations - integer mxio - parameter (mxio=2) -C Maximum number of n7 generated conformations - integer mxio2 - parameter (mxio2=2) -C Maximum number of moves (n1-n8) - integer mxmv - parameter (mxmv=18) -C Maximum number of seed - integer max_seed - parameter (max_seed=1) +csaC Maximum number of generated conformations +csa integer mxio +csa parameter (mxio=2) +csaC Maximum number of n7 generated conformations +csa integer mxio2 +csa parameter (mxio2=2) +csaC Maximum number of moves (n1-n8) +csa integer mxmv +csa parameter (mxmv=18) +csaC Maximum number of seed +csa integer max_seed +csa parameter (max_seed=1) C Maximum number of timesteps for which stochastic MD matrices can be stored integer maxflag_stoch parameter (maxflag_stoch=0) diff --git a/source/unres/src_MD/DIMENSIONS~ b/source/unres/src_MD/DIMENSIONS~ deleted file mode 100644 index c37025c..0000000 --- a/source/unres/src_MD/DIMENSIONS~ +++ /dev/null @@ -1,140 +0,0 @@ -******************************************************************************** -* Settings for the program of united-residue peptide simulation in real space * -* * -* ------- As of 6/23/01 ----------- * -* * -******************************************************************************** -C Max. number of processors. - integer maxprocs - parameter (maxprocs=2048) -C Max. number of fine-grain processors - integer max_fg_procs -c parameter (max_fg_procs=maxprocs) - parameter (max_fg_procs=512) -C Max. number of coarse-grain processors - integer max_cg_procs - parameter (max_cg_procs=maxprocs) -C Max. number of AA residues - integer maxres - parameter (maxres=800) -C Appr. max. number of interaction sites - integer maxres2,maxres6,mmaxres2 - parameter (maxres2=2*maxres,maxres6=6*maxres) - parameter (mmaxres2=(maxres2*(maxres2+1)/2)) -C Max. number of variables - integer maxvar - parameter (maxvar=6*maxres) -C Max. number of groups of interactions that a given SC is involved in - integer maxint_gr - parameter (maxint_gr=2) -C Max. number of derivatives of virtual-bond and side-chain vectors in theta -C or phi. - integer maxdim - parameter (maxdim=(maxres-1)*(maxres-2)/2) -C Max. number of SC contacts - integer maxcont - parameter (maxcont=12*maxres) -C Max. number of contacts per residue - integer maxconts - parameter (maxconts=maxres/4) -c parameter (maxconts=50) -C Number of AA types (at present only natural AA's will be handled - integer ntyp,ntyp1 - parameter (ntyp=20,ntyp1=ntyp+1) -C Max. number of types of dihedral angles & multiplicity of torsional barriers -C and the number of terms in double torsionals - integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2 - parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8) -C Max. number of residue types and parameters in expressions for -C virtual-bond angle bending potentials - integer maxthetyp,maxthetyp1,maxtheterm,maxtheterm2,maxtheterm3, - & maxsingle,maxdouble,mmaxtheterm - parameter (maxthetyp=3,maxthetyp1=maxthetyp+1,maxtheterm=20, - & maxtheterm2=6,maxtheterm3=4,maxsingle=6,maxdouble=4, - & mmaxtheterm=maxtheterm) -c Max number of torsional terms in SCCOR - integer maxterm_sccor - parameter (maxterm_sccor=3) -C Max. number of lobes in SC distribution - integer maxlob - parameter (maxlob=4) -C Max. number of S-S bridges - integer maxss - parameter (maxss=20) -C Max. number of dihedral angle constraints - integer maxdih_constr - parameter (maxdih_constr=maxres) -C Max. number of patterns in the pattern database - integer maxseq - parameter (maxseq=10) -C Max. number of residues in a peptide in the database - integer maxres_base - parameter (maxres_base=10) -C Max. number of threading attempts - integer maxthread - parameter (maxthread=20) -C Max. number of move types in MCM - integer maxmovetype - parameter (maxmovetype=4) -C Max. number of stored confs. in MC/MCM simulation - integer maxsave - parameter (maxsave=20) -C Max. number of energy intervals - integer max_ene - parameter (max_ene=10) -C Max. number of conformations in Master's cache array - integer max_cache - parameter (max_cache=10) -C Max. number of conformations in the pool - integer max_pool - parameter (max_pool=10) -C Number of energy components - integer n_ene,n_ene2 - parameter (n_ene=23,n_ene2=2*n_ene) -C Number of threads in deformation - integer max_thread,max_thread2 - parameter (max_thread=4,max_thread2=2*max_thread) -C Number of structures to compare at t=0 - integer max_threadss,max_threadss2 - parameter (max_threadss=8,max_threadss2=2*max_threadss) -C Maxmimum number of angles per residue - integer mxang - parameter (mxang=4) -C Maximum number of groups of angles - integer mxgr - parameter (mxgr=2*maxres) -C Maximum number of chains - integer mxch - parameter (mxch=1) -C Maximum number of generated conformations - integer mxio - parameter (mxio=2) -C Maximum number of n7 generated conformations - integer mxio2 - parameter (mxio2=2) -C Maximum number of moves (n1-n8) - integer mxmv - parameter (mxmv=18) -C Maximum number of seed - integer max_seed - parameter (max_seed=1) -C Maximum number of timesteps for which stochastic MD matrices can be stored - integer maxflag_stoch - parameter (maxflag_stoch=0) -C Maximum number of backbone fragments in restraining - integer maxfrag_back - parameter (maxfrag_back=4) -C Maximum number of SC local term fitting function coefficiants - integer maxsccoef - parameter (maxsccoef=65) -C Maximum number of terms in SC bond-stretching potential - integer maxbondterm - parameter (maxbondterm=3) -C Maximum number of conformation stored in cache on each CPU before sending -C to master; depends on nstex / ntwx ratio - integer max_cache_traj - parameter (max_cache_traj=10) -C Nose-Hoover chain - chain length and order of Yoshida algorithm - integer maxmnh,maxyosh - parameter(maxmnh=10,maxyosh=5) -C Hamiltonian dynamics \ No newline at end of file diff --git a/source/unres/src_MD/MD_A-MTS.F b/source/unres/src_MD/MD_A-MTS.F index 042fcc0..29e4fcb 100644 --- a/source/unres/src_MD/MD_A-MTS.F +++ b/source/unres/src_MD/MD_A-MTS.F @@ -592,13 +592,15 @@ c Backup the coordinates, velocities, and accelerations H=(HNose1-H0)*s_np cd write (iout,'(a,10f)') "hhh",EK,s_np,potE,pi_np,H0 cd & ,EK+potE+pi_np**2/(2*Q_np)+dimen3*0.001986d0*t_bath*log(s_np) - write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 +cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 + hhh=h endif if(tnh) then HNose1=Hnose_nh(EK,potE) H=HNose1-H0 - write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 + hhh=h +cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 endif if (large) then @@ -1104,14 +1106,16 @@ c Backup the coordinates, velocities, and accelerations H=(HNose1-H0)*s_np cd write (iout,'(a,10f)') "hhh",EK,s_np,potE,pi_np,H0 cd & ,EK+potE+pi_np**2/(2*Q_np)+dimen3*0.001986d0*t_bath*log(s_np) - write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 +cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 + hhh=h cd write (iout,'(a,3f)') "EE2 NP S, pi",totT, s_np, pi_np endif if(tnh) then HNose1=Hnose_nh(EK,potE) H=HNose1-H0 - write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 +cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 + hhh=h endif @@ -1888,6 +1892,17 @@ c Removing the velocity of the center of mass write (iout,*) 'H0= ',H0 endif + if (hmc.gt.0) then + hmc_acc=0 + hmc_etot=potE+EK + if(me.eq.king.or..not.out1file) + & write(iout,*) 'HMC',hmc_etot,potE,EK + do i=1,2*nres + do j=1,3 + dc_hmc(j,i)=dc(j,i) + enddo + enddo + endif call cartgrad call lagrangian @@ -2019,6 +2034,9 @@ C 7/2/2009 Copy accelerations due to short-lange forces to an auxiliary array t_enegrad=t_enegrad+tcpu()-tt0 #endif endif + + + return end c----------------------------------------------------------- @@ -3379,3 +3397,61 @@ cd write(iout,'(a,4f)') 'mmm',EK,potE,HNose1,pi_np return end + + subroutine hmc_test(itime) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CONTROL' + include 'COMMON.MD' + include 'COMMON.CHAIN' + + hmc_acc=hmc_acc+1 + delta=-(potE+EK-hmc_etot)/(Rb*t_bath) + if (delta .lt. -50.0d0) then + delta=0.0d0 + else + delta=dexp(delta) + endif + xxx=ran_number(0.0d0,1.0d0) + + if (me.eq.king .or. .not. out1file) + & write(iout,'(a8,i5,6f10.4)') + & 'HMC',itime,potE+EK,potE,EK,hmc_etot,delta,xxx + + if (delta .le. xxx) then + do i=1,2*nres + do j=1,3 + dc(j,i)=dc_hmc(j,i) + enddo + enddo + itime=itime-hmc + totT=totThmc + else + if (me.eq.king .or. .not. out1file) + & write(iout,*) 'HMC accepting new' + totThmc=totT + do i=1,2*nres + do j=1,3 + dc_hmc(j,i)=dc(j,i) + enddo + enddo + endif + + call chainbuild_cart + call random_vel + do i=0,2*nres + do j=1,3 + d_t_old(j,i)=d_t(j,i) + enddo + enddo + call kinetic(EK) + kinetic_T=2.0d0/(dimen3*Rb)*EK + call etotal(potEcomp) + potE=potEcomp(0) + hmc_etot=potE+EK + if (me.eq.king .or. .not. out1file) + & write(iout,'(a8,i5,3f10.4)')'HMC new',itime,potE+EK,potE,EK + + + return + end diff --git a/source/unres/src_MD/MREMD.F b/source/unres/src_MD/MREMD.F index 2d184b6..9ddb9e9 100644 --- a/source/unres/src_MD/MREMD.F +++ b/source/unres/src_MD/MREMD.F @@ -479,6 +479,10 @@ c Variable time step algorithm. stop #endif endif + if(hmc.gt.0 .and. mod(itime,hmc).eq.0) then + call statout(itime) + call hmc_test(itime) + endif if(ntwe.ne.0) then if (mod(itime,ntwe).eq.0) call statout(itime) endif @@ -1403,6 +1407,8 @@ cd end & 'MD steps:',t_MD write (iout,'(/28(1h=),a25,27(1h=))') & ' End of MD calculation ' + if(hmc.gt.0) write (iout,*) 'HMC acceptance ratio', + & n_timestep*1.0d0/hmc/hmc_acc endif return end diff --git a/source/unres/src_MD/Makefile b/source/unres/src_MD/Makefile index d911d7a..696c70e 120000 --- a/source/unres/src_MD/Makefile +++ b/source/unres/src_MD/Makefile @@ -1 +1 @@ -Makefile_single_gfortran \ No newline at end of file +Makefile_ifort \ No newline at end of file diff --git a/source/unres/src_MD/TAU b/source/unres/src_MD/TAU deleted file mode 100644 index 231a93e..0000000 --- a/source/unres/src_MD/TAU +++ /dev/null @@ -1,6 +0,0 @@ -module load tau/tau-2.17 -#with preprocessor -setenv TAU_OPTIONS '-optPreProcess -optVerbose' -setenv TAU_THROTTLE 1 -setenv TAU_THROTTLE_NUMCALLS 400000 -setenv TAU_THROTTLE_PERCALL 3000 diff --git a/source/unres/src_MD/TAU_setup.sh b/source/unres/src_MD/TAU_setup.sh deleted file mode 100755 index 1423b72..0000000 --- a/source/unres/src_MD/TAU_setup.sh +++ /dev/null @@ -1,15 +0,0 @@ -#!/bin/bash -# -# Adding tau -# Must be executed from command line, don't know why! -#soft add +tau -# -# With preprocessor -# -export TAU_OPTIONS='-optPreProcess -optVerbose' -# -# sets tau makefile -# -export TAU_MAKEFILE=/soft/apps/tau/tau-2.17.1/bgp/lib/Makefile.tau-mpi-pdt - -export TAU_OPTIONS='-optTauSelectFile=select.tau -optPreProcess -optVerbose -optKeepFiles' diff --git a/source/unres/src_MD/bank.F b/source/unres/src_MD/bank.F deleted file mode 100644 index a48eac2..0000000 --- a/source/unres/src_MD/bank.F +++ /dev/null @@ -1,1086 +0,0 @@ -#ifdef MPI -cc--------------------------------- - subroutine refresh_bank(ntrial) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - character chacc - integer iaccn - double precision l_diff(mxio),denep - - do i=0,mxmv - do j=1,3 - nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j) - nstatnx(i,j)=0 - enddo - enddo - -c loop over all newly obtained conformations - do n=1,ntrial - chacc=' ' - iaccn=0 - nstatnx(movernx(n),1)=nstatnx(movernx(n),1)+1 -cccccccccccccccccccccccccccccccccccccccccccc -cjlee - if(iref.ne.0) then - if(rmsn(n).gt.rmscut.or.pncn(n).lt.pnccut) goto 100 - endif -cjlee - if(etot(n).gt.ebmax) goto 100 -c Find the conformation closest to the conformation n in the bank - difmin=9.d9 - do m=1,nbank - call get_diff12(dihang(1,1,1,n),bvar(1,1,1,m),l_diff(m)) - if(l_diff(m).lt.difmin) then - difmin=l_diff(m) - idmin=m - endif - enddo - - if(difmin.lt.cutdif) then -c n is redundant to idmin - if(etot(n).lt.bene(idmin)) then - if(etot(n).lt.bene(idmin)-0.01d0) then - ibank(idmin)=0 - jbank(idmin)=0 - endif - denep=bene(idmin)-etot(n) - call replace_bvar(idmin,n) -crc Update dij - do i1=1,nbank - if (i1.ne.idmin) then - dij(i1,idmin)=l_diff(i1) - dij(idmin,i1)=l_diff(i1) - endif - enddo - chacc='c' - iaccn=idmin - nstatnx(movernx(n),2)=nstatnx(movernx(n),2)+1 - if(idmin.eq.ibmax) call find_max - endif - else -c got new conformation - del_ene=0.0d0 - if(ebmax-ebmin.gt.del_ene) then - denep=ebmax-etot(n) - call replace_bvar(ibmax,n) -crc Update dij - do i1=1,nbank - if (i1.ne.ibmax) then - dij(i1,ibmax)=l_diff(i1) - dij(ibmax,i1)=l_diff(i1) - endif - enddo - chacc='f' - iaccn=ibmax - nstatnx(movernx(n),3)=nstatnx(movernx(n),3)+1 - ibank(ibmax)=0 - jbank(ibmax)=0 - call find_max - else - if(del_ene.lt.0.0001) then - write (iout,*) 'ERROR in refresh_bank: ' - write (iout,*) 'ebmax: ',ebmax - write (iout,*) 'ebmin: ',ebmin - write (iout,*) 'del_ene: ',del_ene -crc call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif -cjp nbmax is never defined so condition below is always false -c if(nbank.lt.nbmax) then -c nbank=nbank+1 -c call replace_bvar(nbank,n) -c ibank(nbank)=0 -c jbank(nbank)=0 -c else - call replace_bvar(ibmax,n) - ibank(ibmax)=0 - jbank(ibmax)=0 - call find_max -c endif - endif - endif -cccccccccccccccccccccccccccccccccccccccccccc - 100 continue - if (iaccn.eq.0) then - if (iref.eq.0) then - write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5)') - & indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ', - & indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9) - else - write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5 - & ,a5,0pf4.1,a5,f3.0)') - & indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ', - & indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9), - & ' rms ',rmsn(n),' %NC ',pncn(n)*100 - endif - else - if (iref.eq.0) then - write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5, - & 1x,a1,i4,0pf8.1,0pf8.1)') - & indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ', - & indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9), - & chacc,iaccn,difmin,denep - else - write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5,a5, - & 0pf4.1,a5,f3.0,1x,a1,i4,0pf8.1,0pf8.1)') - & indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ', - & indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9), - & ' rms ',rmsn(n),' %NC ',pncn(n)*100, - & chacc,iaccn,difmin,denep - endif - endif - enddo -c end of loop over all newly obtained conformations - do i=0,mxmv - if(nstatnx(i,1).ne.0) then - if (i.le.9) then - write(iout,'(a4,i1,a7,i4,a7,i4,a5,i4,a5,f5.1)') - & '## N',i,' total=',nstatnx(i,1), - & ' close=',nstatnx(i,2),' far=',nstatnx(i,3), - & ' %acc',(nstatnx(i,2)+nstatnx(i,3))*100.0/nstatnx(i,1) - else - write(iout,'(a3,i2,a7,i4,a7,i4,a5,i4,a5,f5.1)') - & '##N',i,' total=',nstatnx(i,1), - & ' close=',nstatnx(i,2),' far=',nstatnx(i,3), - & ' %acc',(nstatnx(i,2)+nstatnx(i,3))*100.0/nstatnx(i,1) - endif - else - if (i.le.9) then - write(iout,'(a4,i1,a7,i4,a7,i4,a5,i4,a5,f5.1)') - & '## N',i,' total=',nstatnx(i,1), - & ' close=',nstatnx(i,2),' far=',nstatnx(i,3), - & ' %acc',0.0 - else - write(iout,'(a3,i2,a7,i4,a7,i4,a5,i4,a5,f5.1)') - & '##N',i,' total=',nstatnx(i,1), - & ' close=',nstatnx(i,2),' far=',nstatnx(i,3), - & ' %acc',0.0 - endif - endif - enddo - call flush(iout) -crc Update dij -crc moved up, saves some get_diff12 calls -crc -crc do i1=1,nbank-1 -crc do i2=i1+1,nbank -crc if(jbank(i1).eq.0.or.jbank(i2).eq.0) then -crc call get_diff12(bvar(1,1,1,i1),bvar(1,1,1,i2),diff) -crc dij(i1,i2)=diff -crc dij(i2,i1)=diff -crc endif -crc enddo -crc enddo - - do i=1,nbank - jbank(i)=1 - enddo - - return - end -c--------------------------------- - subroutine replace_bvar(iold,inew) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - - if (iold.gt.mxio .or. iold.lt.1 .or. inew.gt.mxio .or. inew.lt.1) - & then - write (iout,*) 'Dimension ERROR in REPLACE_BVAR: IOLD',iold, - & ' INEW',inew - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do k=1,numch - do j=2,nres-1 - do i=1,4 - bvar(i,j,k,iold)=dihang(i,j,k,inew) - enddo - enddo - enddo - bene(iold)=etot(inew) - brmsn(iold)=rmsn(inew) - bpncn(iold)=pncn(inew) - - if(bene(iold).lt.ebmin) then - ebmin=bene(iold) - ibmin=iold - endif - - if(vdisulf) then - bvar_nss(iold)=nss_out(inew) -cd write(iout,*) 'SS BANK',iold,bvar_nss(iold) - do i=1,bvar_nss(iold) - bvar_ss(1,i,iold)=iss_out(i,inew) - bvar_ss(2,i,iold)=jss_out(i,inew) -cd write(iout,*) 'SS',bvar_ss(1,i,iold)-nres, -cd & bvar_ss(2,i,iold)-nres - enddo - - bvar_ns(iold)=ns-2*bvar_nss(iold) -cd write(iout,*) 'CYS #free ', bvar_ns(iold) - k=0 - do i=1,ns - j=1 - do while( iss(i).ne.iss_out(j,inew)-nres .and. - & iss(i).ne.jss_out(j,inew)-nres .and. - & j.le.nss_out(inew)) - j=j+1 - enddo - if (j.gt.nss_out(inew)) then - k=k+1 - bvar_s(k,iold)=iss(i) - endif - enddo -cd write(iout,*) 'CYS free',(bvar_s(k,iold),k=1,bvar_ns(iold)) - endif - - return - end -c--------------------------------------- - subroutine write_rbank(jlee,adif,nft) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - - open(icsa_rbank,file=csa_rbank,status="unknown") - write (icsa_rbank,900) jlee,nbank,nstep,nft,icycle,adif - do k=1,nbank - write (icsa_rbank,952) k,rene(k),rrmsn(k),rpncn(k) - do j=1,numch - do l=2,nres-1 - write (icsa_rbank,850) (rad2deg*rvar(i,l,j,k),i=1,4) - enddo - enddo - enddo - close(icsa_rbank) - - 850 format (10f8.3) - 900 format (1x,"jlee =",i3,3x,"nbank =",i4,3x,"nstep =", - & i8,i10,i2,f15.5) - 952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3 - & ,' %NC ',0pf5.2) - - return - end -c--------------------------------------- - subroutine read_rbank(jlee,adif) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.SETUP' - character*80 karta - - open(icsa_rbank,file=csa_rbank,status="old") - read (icsa_rbank,901) jleer,nbankr,nstepr,nftr,icycler,adif - print *,jleer,nbankr,nstepr,nftr,icycler,adif -c print *, 'adif from read_rbank ',adif - if(nbankr.ne.nbank) then - write (iout,*) 'ERROR in READ_BANK: NBANKR',nbankr, - & ' NBANK',nbank - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - if(jleer.ne.jlee) then - write (iout,*) 'ERROR in READ_BANK: JLEER',jleer, - & ' JLEE',jlee - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - - kk=0 - do k=1,nbankr - read (icsa_rbank,'(a80)') karta - write(iout,*) "READ_RBANK: kk=",kk - write(iout,*) karta -c if (index(karta,"*").gt.0) then -c write (iout,*) "***** Stars in bankr ***** k=",k, -c & " skipped" -c do j=1,numch -c do l=2,nres-1 -c read (30,850) (rdummy,i=1,4) -c enddo -c enddo -c else - kk=kk+1 - call reada(karta,"total E",rene(kk),1.0d20) - call reada(karta,"rmsd from N",rrmsn(kk),0.0d0) - call reada(karta,"%NC",rpncn(kk),0.0d0) - write(iout,*)"total E",bene(kk),"rmsd from N",brmsn(kk), - & "%NC",bpncn(kk),ibank(kk) -c read (icsa_rbank,953) kdummy,rene(kk),rrmsn(kk),rpncn(kk) - do j=1,numch - do l=2,nres-1 - read (icsa_rbank,850) (rvar(i,l,j,kk),i=1,4) -c write (iout,850) (rvar(i,l,j,kk),i=1,4) - do i=1,4 - rvar(i,l,j,kk)=deg2rad*rvar(i,l,j,kk) - enddo - enddo - enddo -c endif - enddo -cd write (*,*) "read_rbank ******************* kk",kk, -cd & "nbankr",nbankr - if (kk.lt.nbankr) nbankr=kk -cd do kk=1,nbankr -cd print *,"kk=",kk -cd do j=1,numch -cd do l=2,nres-1 -cd write (*,850) (rvar(i,l,j,kk),i=1,4) -cd enddo -cd enddo -cd enddo - close(icsa_rbank) - - 850 format (10f8.3) - 901 format (1x,6x,i3,3x,7x,i4,3x,7x,i8,i10,i2,f15.5) - 953 format (1x,1x,i4,9x,f12.3,13x,f8.3,5x,f5.2) - - return - end -c--------------------------------------- - subroutine write_bank(jlee,nft) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - character*7 chtmp - character*40 chfrm - external ilen - - open(icsa_bank,file=csa_bank,status="unknown") - write (icsa_bank,900) jlee,nbank,nstep,nft,icycle,cutdif - write (icsa_bank,902) nglob_csa, eglob_csa - open (igeom,file=intname,status='UNKNOWN') - do k=1,nbank - write (icsa_bank,952) k,bene(k),brmsn(k),bpncn(k),ibank(k) - if (vdisulf) write (icsa_bank,'(101i4)') - & bvar_nss(k),((bvar_ss(j,i,k),j=1,2),i=1,bvar_nss(k)) - do j=1,numch - do l=2,nres-1 - write (icsa_bank,850) (rad2deg*bvar(i,l,j,k),i=1,4) - enddo - enddo - if (bvar_nss(k).le.9) then - write (igeom,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k), - & bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,bvar_nss(k)) - else - write (igeom,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k), - & bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,9) - write (igeom,'(3X,11(1X,2I3))') (bvar_ss(1,i,k), - & bvar_ss(2,i,k),i=10,bvar_nss(k)) - endif - write (igeom,200) (rad2deg*bvar(1,i,1,k),i=2,nres-1) - write (igeom,200) (rad2deg*bvar(2,i,1,k),i=2,nres-2) - write (igeom,200) (rad2deg*bvar(3,i,1,k),i=2,nres-1) - write (igeom,200) (rad2deg*bvar(4,i,1,k),i=2,nres-1) - enddo - close(icsa_bank) - close(igeom) - - if (nstep/200.gt.ilastnstep) then - - ilastnstep=(ilastnstep+1)*1.5 - write(chfrm,'(a2,i1,a1)') '(i',int(dlog10(dble(nstep))+1),')' - write(chtmp,chfrm) nstep - open(icsa_int,file=prefix(:ilen(prefix)) - & //'_'//chtmp(:ilen(chtmp))//'.int',status='UNKNOWN') - do k=1,nbank - if (bvar_nss(k).le.9) then - write (icsa_int,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k), - & bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,bvar_nss(k)) - else - write (icsa_int,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k), - & bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,9) - write (icsa_int,'(3X,11(1X,2I3))') (bvar_ss(1,i,k), - & bvar_ss(2,i,k),i=10,bvar_nss(k)) - endif - write (icsa_int,200) (rad2deg*bvar(1,i,1,k),i=2,nres-1) - write (icsa_int,200) (rad2deg*bvar(2,i,1,k),i=2,nres-2) - write (icsa_int,200) (rad2deg*bvar(3,i,1,k),i=2,nres-1) - write (icsa_int,200) (rad2deg*bvar(4,i,1,k),i=2,nres-1) - enddo - close(icsa_int) - endif - - - 200 format (8f10.4) - 850 format (10f8.3) - 900 format (1x,"jlee =",i3,3x,"nbank =",i4,3x,"nstep =", - & i8,i10,i2,f15.5) - 902 format (1x,'nglob_csa =',i4,' eglob_csa =',1pe14.5) - 952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3, - & ' %NC ',0pf5.2,i5) - - return - end -c--------------------------------------- - subroutine write_bank_reminimized(jlee,nft) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.SBRIDGE' - - open(icsa_bank_reminimized,file=csa_bank_reminimized, - & status="unknown") - write (icsa_bank_reminimized,900) - & jlee,nbank,nstep,nft,icycle,cutdif - open (igeom,file=intname,status='UNKNOWN') - do k=1,nbank - write (icsa_bank_reminimized,952) k,bene(k),brmsn(k), - & bpncn(k),ibank(k) - do j=1,numch - do l=2,nres-1 - write (icsa_bank_reminimized,850) (rad2deg*bvar(i,l,j,k),i=1,4) - enddo - enddo - if (nss.le.9) then - write (igeom,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k), - & nss,(ihpb(i),jhpb(i),i=1,nss) - else - write (igeom,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k), - & nss,(ihpb(i),jhpb(i),i=1,9) - write (igeom,'(3X,11(1X,2I3))') (ihpb(i),jhpb(i),i=10,nss) - endif - write (igeom,200) (rad2deg*bvar(1,i,1,k),i=2,nres-1) - write (igeom,200) (rad2deg*bvar(2,i,1,k),i=2,nres-2) - write (igeom,200) (rad2deg*bvar(3,i,1,k),i=2,nres-1) - write (igeom,200) (rad2deg*bvar(4,i,1,k),i=2,nres-1) - enddo - close(icsa_bank_reminimized) - close(igeom) - - 200 format (8f10.4) - 850 format (10f8.3) - 900 format (1x,"jlee =",i3,3x,"nbank =",i4,3x,"nstep =", - & i8,i10,i2,f15.5) - 952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3 - & ,' %NC ',0pf5.2,i5) - - return - end -c--------------------------------- - subroutine read_bank(jlee,nft,cutdifr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - character*80 karta - integer ilen - external ilen - - open(icsa_bank,file=csa_bank,status="old") - read (icsa_bank,901) jlee,nbank,nstep,nft,icycle,cutdifr - read (icsa_bank,902) nglob_csa, eglob_csa -c if(jleer.ne.jlee) then -c write (iout,*) 'ERROR in READ_BANK: JLEER',jleer, -c & ' JLEE',jlee -c call mpi_abort(mpi_comm_world,ierror,ierrcode) -c endif - - kk=0 - do k=1,nbank - read (icsa_bank,'(a80)') karta - write(iout,*) "READ_BANK: kk=",kk - write(iout,*) karta -c if (index(karta,"*").gt.0) then -c write (iout,*) "***** Stars in bank ***** k=",k, -c & " skipped" -c do j=1,numch -c do l=2,nres-1 -c read (33,850) (rdummy,i=1,4) -c enddo -c enddo -c else - kk=kk+1 - call reada(karta,"total E",bene(kk),1.0d20) - call reada(karta,"rmsd from N",brmsn(kk),0.0d0) - call reada(karta,"%NC",bpncn(kk),0.0d0) - read (karta(ilen(karta)-1:),*,end=111,err=111) ibank(kk) - goto 112 - 111 ibank(kk)=0 - 112 continue - write(iout,*)"total E",bene(kk),"rmsd from N",brmsn(kk), - & "%NC",bpncn(kk),ibank(kk) -c read (icsa_bank,953) kdummy,bene(k),brmsn(k),bpncn(k),ibank(k) - if (vdisulf) then - read (icsa_bank,'(101i4)') - & bvar_nss(kk),((bvar_ss(j,i,kk),j=1,2),i=1,bvar_nss(kk)) - bvar_ns(kk)=ns-2*bvar_nss(kk) - write(iout,*) 'read SSBOND',bvar_nss(kk), - & ((bvar_ss(j,i,kk),j=1,2),i=1,bvar_nss(kk)) -cd write(iout,*) 'read CYS #free ', bvar_ns(kk) - l=0 - do i=1,ns - j=1 - do while( iss(i).ne.bvar_ss(1,j,kk)-nres .and. - & iss(i).ne.bvar_ss(2,j,kk)-nres .and. - & j.le.bvar_nss(kk)) - j=j+1 - enddo - if (j.gt.bvar_nss(kk)) then - l=l+1 - bvar_s(l,kk)=iss(i) - endif - enddo -cd write(iout,*)'read CYS free',(bvar_s(l,kk),l=1,bvar_ns(kk)) - endif - do j=1,numch - do l=2,nres-1 - read (icsa_bank,850) (bvar(i,l,j,kk),i=1,4) -c write (iout,850) (bvar(i,l,j,kk),i=1,4) - do i=1,4 - bvar(i,l,j,kk)=deg2rad*bvar(i,l,j,kk) - enddo ! l - enddo ! l - enddo ! j -c endif - enddo ! k - - if (kk.lt.nbank) nbank=kk -cd write (*,*) "read_bank ******************* kk",kk, -cd & "nbank",nbank -cd do kk=1,nbank -cd print *,"kk=",kk -cd do j=1,numch -cd do l=2,nres-1 -cd write (*,850) (bvar(i,l,j,kk),i=1,4) -cd enddo -cd enddo -cd enddo - -c do k=1,nbank -c read (33,953) kdummy,bene(k),brmsn(k),bpncn(k),ibank(k) -c do j=1,numch -c do l=2,nres-1 -c read (33,850) (bvar(i,l,j,k),i=1,4) -c do i=1,4 -c bvar(i,l,j,k)=deg2rad*bvar(i,l,j,k) -c enddo -c enddo -c enddo -c enddo - close(icsa_bank) - - 850 format (10f8.3) - 952 format (1x,'#',i4,' total E ',f12.3,' rmsd from N ',f8.3,i5) - 901 format (1x,6x,i3,3x,7x,i4,3x,7x,i8,i10,i2,f15.5) - 902 format (1x,11x,i4,12x,1pe14.5) - 953 format (1x,1x,i4,9x,f12.3,13x,f8.3,5x,f5.2,i5) - - return - end -c--------------------------------------- - subroutine write_bank1(jlee) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - -#if defined(AIX) || defined(PGI) - open(icsa_bank1,file=csa_bank1,position="append") -#else - open(icsa_bank1,file=csa_bank1,access="append") -#endif - write (icsa_bank1,900) jlee,nbank,nstep,cutdif - do k=1,nbank - write (icsa_bank1,952) k,bene(k),brmsn(k),bpncn(k),ibank(k) - do j=1,numch - do l=2,nres-1 - write (icsa_bank1,850) (rad2deg*bvar(i,l,j,k),i=1,4) - enddo - enddo - enddo - close(icsa_bank1) - 850 format (10f8.3) - 900 format (4x,"jlee =",i5,3x,"nbank =",i5,3x,"nstep =",i10,f15.5) - 952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3 - & ,' %NC ',0pf5.2,i5) - - return - end -c--------------------------------- - subroutine save_is(ind) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - - index=nbank+ind -c print *, "nbank,ind,index,is(ind) ",nbank,ind,index,is(ind) - if (index.gt.mxio .or. index.lt.1 .or. - & is(ind).gt.mxio .or. is(ind).lt.1) then - write (iout,*) 'Dimension ERROR in SAVE_IS: INDEX',index, - & ' IND',ind,' IS',is(ind) - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do k=1,numch - do j=2,nres-1 - do i=1,4 - bvar(i,j,k,index)=bvar(i,j,k,is(ind)) - enddo - enddo - enddo - bene(index)=bene(is(ind)) - ibank(is(ind))=1 - - return - end -c--------------------------------- - subroutine select_is(n,ifar,idum) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - dimension itag(mxio),adiff(mxio) - - iuse=0 - do i=1,nbank - if(ibank(i).eq.0) then - iuse=iuse+1 - itag(iuse)=i - endif - enddo - iusesv=iuse - - if(iuse.eq.0) then - icycle=icycle+1 - do i=1,nbank - if(ibank(i).eq.2) then - ibank(i)=1 - else - ibank(i)=0 - endif - enddo - imade=0 - call get_is(idum,ifar,n,imade,0) -ctest3 call get_is_max(idum,ifar,n,imade,0) - else if(iuse.eq.n) then - do i=1,iuse - is(i)=itag(i) - call save_is(i) - enddo - else if(iuse.lt.n) then -c if(icycle.eq.0) then -c do i=1,n -c ind=mod(i-1,iuse)+1 -c is(i)=itag(ind) -c call save_is(i) -c enddo -c else -c endif - do i=1,iuse - is(i)=itag(i) - call save_is(i) - enddo - imade=iuse -c call get_is_ran(idum,n,imade,1) - call get_is(idum,ifar,n,imade,1) -ctest3 call get_is_max(idum,ifar,n,imade,1) -c if(iusesv.le.n/10) then - if(iusesv.le.0) then - icycle=icycle+1 - do i=1,nbank -c if(ibank(i).eq.2) then -c ibank(i)=1 - if(ibank(i).ge.2) then - ibank(i)=ibank(i)-1 - else - ibank(i)=0 - endif - enddo - endif - else - imade=0 - call get_is(idum,ifar,n,imade,0) -ctest3 call get_is_max(idum,ifar,n,imade,0) - endif - iuse=iusesv - - return - end -c--------------------------------- - subroutine get_is_ran(idum,n,imade,k) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - real ran1,ran2 - dimension itag(mxio),adiff(mxio) - - do j=imade+1,n - iuse=0 - do i=1,nbank - if(ibank(i).eq.k) then - iuse=iuse+1 - itag(iuse)=i - endif - enddo - iran=iuse* ran1(idum)+1 - is(j)=itag(iran) - call save_is(j) - enddo - - return - end -c--------------------------------- - subroutine get_is(idum,ifar,n,imade,k) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - real ran1,ran2 - dimension itag(mxio),adiff(mxio) - - iuse=0 - do i=1,nbank - if(ibank(i).eq.k) then - iuse=iuse+1 - itag(iuse)=i - endif - enddo - iran=iuse* ran1(idum)+1 - imade=imade+1 - is(imade)=itag(iran) - call save_is(imade) - - do i=imade+1,ifar-1 - if(icycle.eq.-1) then - call select_iseed_max(i,k) - else - call select_iseed_min(i,k) -ctest4 call select_iseed_max(i,k) - endif - call save_is(i) - enddo - - do i=ifar,n - call select_iseed_far(i,k) - call save_is(i) - enddo - - return - end -c--------------------------------- - subroutine select_iseed_max(imade1,ik) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - dimension itag(mxio),adiff(mxio) - - iuse=0 - avedif=0.d0 - difmax=0.d0 - do n=1,nbank - if(ibank(n).eq.ik) then - iuse=iuse+1 - diffmn=9.d190 - do imade=1,imade1-1 -c m=nbank+imade -c call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff) - m=is(imade) - diff=dij(n,m) - if(diff.lt.diffmn) diffmn=diff - enddo - if(diffmn.gt.difmax) difmax=diffmn - adiff(iuse)=diffmn - itag(iuse)=n - avedif=avedif+diffmn - endif - enddo - - avedif=avedif/iuse -c avedif=(avedif+difmax)/2 - emax=-9.d190 - do i=1,iuse - if(adiff(i).ge.avedif) then - itagi=itag(i) - benei=bene(itagi) - if(benei.gt.emax) then - emax=benei - is(imade1)=itagi - endif - endif - enddo - - if(ik.eq.0) iuse=iuse-1 - - return - end -c--------------------------------- - subroutine select_iseed_min(imade1,ik) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - dimension itag(mxio),adiff(mxio) - - iuse=0 - avedif=0.d0 - difmax=0.d0 - do n=1,nbank - if(ibank(n).eq.ik) then - iuse=iuse+1 - diffmn=9.d190 - do imade=1,imade1-1 -c m=nbank+imade -c call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff) - m=is(imade) - diff=dij(n,m) - if(diff.lt.diffmn) diffmn=diff - enddo - if(diffmn.gt.difmax) difmax=diffmn - adiff(iuse)=diffmn - itag(iuse)=n - avedif=avedif+diffmn - endif - enddo - - avedif=avedif/iuse -c avedif=(avedif+difmax)/2 - emin=9.d190 - do i=1,iuse -c print *,"i, adiff(i),avedif : ",i,adiff(i),avedif - if(adiff(i).ge.avedif) then - itagi=itag(i) - benei=bene(itagi) -c print *,"i, benei,emin : ",i,benei,emin - if(benei.lt.emin) then - emin=benei - is(imade1)=itagi - endif - endif - enddo - - if(ik.eq.0) iuse=iuse-1 - -c print *, "exiting select_iseed_min",is(imade1) - - return - end -c--------------------------------- - subroutine select_iseed_far(imade1,ik) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - - dmax=-9.d190 - do n=1,nbank - if(ibank(n).eq.ik) then - diffmn=9.d190 - do imade=1,imade1-1 -c m=nbank+imade -c call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff) - m=is(imade) - diff=dij(n,m) - if(diff.lt.diffmn) diffmn=diff - enddo - endif - if(diffmn.gt.dmax) then - dmax=diffmn - is(imade1)=n - endif - enddo - - return - end -c--------------------------------- - subroutine find_min - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - - ebmin=9.d190 - - do i=1,nbank - benei=bene(i) - if(benei.lt.ebmin) then - ebmin=benei - ibmin=i - endif - enddo - - return - end -c--------------------------------- - subroutine write_csa_pdb(var,ene,nft,ik,iw_pdb) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MINIM' - include 'COMMON.SETUP' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.SBRIDGE' - integer lenpre,lenpot,ilen - external ilen - dimension var(maxvar) - character*50 titelloc - character*3 zahl - - nmin_csa=nmin_csa+1 - if(ene.lt.eglob_csa) then - eglob_csa=ene - nglob_csa=nglob_csa+1 - call numstr(nglob_csa,zahl) - - call var_to_geom(nvar,var) - call chainbuild - call secondary2(.false.) - - lenpre=ilen(prefix) - open(icsa_pdb,file=prefix(:lenpre)//'@'//zahl//'.pdb') - - if (iw_pdb.eq.1) then - write(titelloc,'(a2,i3,a3,i9,a3,i6)') - & 'GM',nglob_csa,' e ',nft,' m ',nmin_csa - else - write(titelloc,'(a2,i3,a3,i9,a3,i6,a5,f5.2,a5,f5.1)') - & 'GM',nglob_csa,' e ',nft,' m ',nmin_csa,' rms ' - & ,rmsn(ik),' %NC ',pncn(ik)*100 - endif - call pdbout(eglob_csa,titelloc,icsa_pdb) - close(icsa_pdb) - endif - - return - end -c--------------------------------- - subroutine find_max - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - - ebmax=-9.d190 - - do i=1,nbank - benei=bene(i) - if(benei.gt.ebmax) then - ebmax=benei - ibmax=i - endif - enddo - - return - end -c--------------------------------- - subroutine get_diff - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - - tdiff=0.d0 - difmin=9.d190 - do i1=1,nbank-1 - do i2=i1+1,nbank - if(jbank(i1).eq.0.or.jbank(i2).eq.0) then - call get_diff12(bvar(1,1,1,i1),bvar(1,1,1,i2),diff) - dij(i1,i2)=diff - dij(i2,i1)=diff - else - diff=dij(i1,i2) - endif - tdiff=tdiff+diff - if(diff.lt.difmin) difmin=diff - enddo - dij(i1,i1)=0.0 - enddo - - do i=1,nbank - jbank(i)=1 - enddo - - avedif=tdiff/nbank/(nbank-1)*2 - - return - end -c--------------------------------- - subroutine estimate_cutdif(adif,xct,cutdifr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - - ctdif1=adif/cut2 - - exponent = cutdifr*cut1/adif - exponent = dlog(exponent)/dlog(xct) - - nexp=exponent+0.25 - cutdif= adif/cut1*xct**nexp - if(cutdif.lt.ctdif1) cutdif=ctdif1 - - return - end -c--------------------------------- - subroutine get_is_max(idum,ifar,n,imade,k) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - double precision emax - - do i=imade+1,n - emax=-9.d190 - do j=1,nbank - if(ibank(j).eq.k .and. bene(j).gt.emax) then - emax=bene(j) - is(i)=j - endif - enddo - call save_is(i) - enddo - - return - end -#endif diff --git a/source/unres/src_MD/cartder.F b/source/unres/src_MD/cartder.F index dd2b3f1..e2e8c1a 100644 --- a/source/unres/src_MD/cartder.F +++ b/source/unres/src_MD/cartder.F @@ -47,7 +47,7 @@ dimension drt(3,3,maxres),rdt(3,3,maxres),dp(3,3),temp(3,3), & fromto(3,3,maxdim),prordt(3,3,maxres),prodrt(3,3,maxres) dimension xx(3),xx1(3) - common /przechowalnia/ fromto +c common /przechowalnia/ fromto * get the position of the jth ijth fragment of the chain coordinate system * in the fromto array. indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1 diff --git a/source/unres/src_MD/cinfo.f b/source/unres/src_MD/cinfo.f index 34bab46..aa00d45 100644 --- a/source/unres/src_MD/cinfo.f +++ b/source/unres/src_MD/cinfo.f @@ -1,26 +1,26 @@ C DO NOT EDIT THIS FILE - IT HAS BEEN GENERATED BY COMPINFO.C -C 2 4 3270 +C 2 5 26 subroutine cinfo include 'COMMON.IOUNITS' write(iout,*)'++++ Compile info ++++' - write(iout,*)'Version 2.4 build 3270' - write(iout,*)'compiled Thu Apr 7 15:31:29 2011' - write(iout,*)'compiled by adam@sun1.chem.univ.gda.pl' + write(iout,*)'Version 2.5 build 26' + write(iout,*)'compiled Wed Mar 28 23:34:22 2012' + write(iout,*)'compiled by czarek@piasek3' write(iout,*)'OS name: Linux ' - write(iout,*)'OS release: 2.6.30.5-43.fc11.x86_64 ' + write(iout,*)'OS release: 2.6.32-38-generic ' write(iout,*)'OS version:', - & ' #1 SMP Thu Aug 27 21:39:52 EDT 2009 ' + & ' #83-Ubuntu SMP Wed Jan 4 11:12:07 UTC 2012 ' write(iout,*)'flags:' - write(iout,*)'FC= gfortran' - write(iout,*)'CC = cc' - write(iout,*)'CFLAGS = -DLINUX -DPGI -c' - write(iout,*)'OPT = -fbounds-check -g' - write(iout,*)'OPT1 = -g' - write(iout,*)'FFLAGS = -c ${OPT} -I.' - write(iout,*)'FFLAGS1 = -c ${OPT1} -I.' - write(iout,*)'BIN = ../bin/unres_gfortran_single.exe' - write(iout,*)'LIBS = -L../xdrf -lxdrf' - write(iout,*)'CPPFLAGS = -DLINUX -DUNRES -DG77 -DSPLITELE -DP...' + write(iout,*)'CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DMP -DMPI ...' + write(iout,*)'INSTALL_DIR = /users/local/mpi64/mpich-1.2.7p1/' + write(iout,*)'FC= ifort' + write(iout,*)'OPT = -O3 -ip -w ' + write(iout,*)'FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include ' + write(iout,*)'FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)...' + write(iout,*)'FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include ' + write(iout,*)'FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report ...' + write(iout,*)'BIN = ../../../bin/unres/MD/unres_ifort_mpich-1...' + write(iout,*)'LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdr...' write(iout,*)'ARCH = LINUX' write(iout,*)'PP = /lib/cpp -P' write(iout,*)'object = unres.o arcos.o cartprint.o chainbuild...' diff --git a/source/unres/src_MD/common.size b/source/unres/src_MD/common.size deleted file mode 100644 index 3bc1f47..0000000 --- a/source/unres/src_MD/common.size +++ /dev/null @@ -1,130 +0,0 @@ -info 0x4010 gen_rand_conf.o -from_zscore 0x8 unres.o -mdcalc 0x108 unres.o -bank_disulfid 0x1f0 readrtns_CSA.o -parfiles 0xb00 unres.o -body 0x6180 unres.o -pool 0x697dc readrtns_CSA.o -interact 0xed94 unres.o -sclocal 0x22cc chainbuild.o -restraints 0x8 unres.o -peptbond 0x28 chainbuild.o -srutu 0x4 unres.o -mucarem 0x8000 readrtns_CSA.o -oldgeo 0xd2ff4 unres.o -minvar 0xe278 readrtns_CSA.o -spinka 0x2a3c newconf.o -torsiond 0x14200 initialize_p.o -przechowalnia 0x7b98a04 rattle.o -langforc 0x31a5054 readrtns_CSA.o -thetas 0x960 chainbuild.o -iounits 0x6c unres.o -rotat_old 0xa8c0 unres.o -remdcommon 0x6030 unres.o -chuju 0x4 minimize_p.o -refstruct 0x151ec unres.o -traj1cache 0x3679c unres.o -stretch 0x600 unres.o -mvstat 0x250 readrtns_CSA.o -thread 0x148 readrtns_CSA.o -dih_control 0xc readrtns_CSA.o -mdpar 0x6c unres.o -types 0x14 unres.o -par 0x20 eigen.o -bounds 0x3840 readrtns_CSA.o -pizda 0xe10 readrtns_CSA.o -machsw 0xc initialize_p.o -links_split 0x8 unres.o -integer_muca 0xc readrtns_CSA.o -calc 0x1f0 gen_rand_conf.o -csafiles 0xc00 unres.o -sbridge 0x9c unres.o -back_constr 0x11acc unres.o -rotat 0x2a300 unres.o -mpipriv2 0x18 unres.o -remdrestart 0x411808 unres.o -stochcalc 0xa8c0 MD_A-MTS.o -scrot 0x28a0 parmread.o -stoptim 0x4 unres.o -c_frag 0x1c28 geomout.o -precomp2 0x54600 unres.o -move 0x38b8 initialize_p.o -loc_work 0x30c local_move.o -store0 0x4 geomout.o -torsion 0x5adc parmread.o -wagi 0x10 geomout.o -vrandd 0x3f0 randgens.o -lagrange 0x15a93de0 unres.o -accept_stats 0x2008 initialize_p.o -mdpmpi 0x8010 unres.o -invlen 0x3840 chainbuild.o -locel 0x208 energy_p_new.o -frag 0xa0 geomout.o -inertia 0x160 unres.o -time1 0x30 unres.o -derivat 0x2638028 initialize_p.o -langmat 0xc readrtns_CSA.o -banii 0xa8c0 banach.o -mdgrad 0x151b0 unres.o -bank 0x1c320 readrtns_CSA.o -refer 0x98 bond_move.o -diploc 0x3938 unres.o -syfek 0xa8c0 stochfric.o -fnames 0x1007 unres.o -$BLNK_COM 0xc djacob.o -sccalc 0x28 energy_p_new.o -geo 0x40 unres.o -iofile 0x65c initialize_p.o -mapp 0x2a304 readrtns_CSA.o -theta_abinitio 0x24a70 chainbuild.o -sumsl_flag 0x4 unres.o -restr 0xd2f4 unres.o -chain 0x3f500 unres.o -torcnstr 0x5478 initialize_p.o -cipiszcze 0x4 lagrangian_lesyng.o -double_muca 0x1c228 readrtns_CSA.o -links 0x93d24c unres.o -deriv_loc 0x1e0 initialize_p.o -cache 0x69850 mcm.o -minimm 0x20 initialize_p.o -diffcuta 0x8 readrtns_CSA.o -aaaa 0x8 MP.o -fourier 0x344 initialize_p.o -mce 0x230 readrtns_CSA.o -var 0x286f0 unres.o -csa_input 0x98 readrtns_CSA.o -header 0x50 unres.o -splitele 0x10 initialize_p.o -setup 0x4028 unres.o -mcm 0x20a4 initialize_p.o -mce_counters 0x14 readrtns_CSA.o -frozen 0xe10 geomout.o -struct 0xa2c readrtns_CSA.o -info1 0x4024 gen_rand_conf.o -cntrl 0x78 unres.o -mpiprivc 0x2 unres.o -timing 0x58 unres.o -kutas 0x4 energy_p_new.o -precomp1 0x50dc0 unres.o -loc_const 0x40 local_move.o -contacts1 0x18c630 unres.o -alphaa 0x16da8 readrtns_CSA.o -thread1 0x1cd0 readrtns_CSA.o -qmeas 0x6f2bc unres.o -dipmat 0x15f9000 unres.o -indices 0x8040 chainbuild.o -ffield 0x174 unres.o -vectors 0x49d40 energy_p_new.o -varin 0xe248 readrtns_CSA.o -csaunits 0x34 unres.o -contacts_hb 0x9c9c30 unres.o -contacts 0x2a308 unres.o -deriv_scloc 0x2f760 initialize_p.o -secondarys 0x384 dihed_cons.o -pochodne 0x6318d0 geomout.o -maxgrad 0xa8 energy_p_new.o -send2 0xfd50 readrtns_CSA.o -windows 0x2a34 initialize_p.o -gucio 0x18 MD_A-MTS.o -rotmat 0x3f480 unres.o - diff --git a/source/unres/src_MD/common.size.orig b/source/unres/src_MD/common.size.orig deleted file mode 100644 index d009a52..0000000 --- a/source/unres/src_MD/common.size.orig +++ /dev/null @@ -1,130 +0,0 @@ -from_zscore 8 unres.o -mdcalc 108 unres.o -bank_disulfid 1f0 readrtns_CSA.o -parfiles b00 unres.o -body 6180 unres.o -mpipriv1 1c unres.o -pool 2459c readrtns_CSA.o -interact 6c84 unres.o -sclocal 22cc chainbuild.o -restraints 8 unres.o -peptbond 28 chainbuild.o -srutu 4 unres.o -mucarem 8000 readrtns_CSA.o -oldgeo 48b74 unres.o -minvar 4ef8 readrtns_CSA.o -spinka e88 newconf.o -torsiond 14200 initialize_p.o -langforc 34dc434 readrtns_CSA.o -thetas 960 chainbuild.o -iounits 6c unres.o -rotat_old 3a20 unres.o -remdcommon 6030 unres.o -chuju 4 minimize_p.o -dipint 31db480 unres.o -refstruct 74ac unres.o -traj1cache 13e7c unres.o -stretch 600 unres.o -mvstat 250 readrtns_CSA.o -thread 148 readrtns_CSA.o -dih_control c readrtns_CSA.o -mdpar 6c unres.o -types 14 unres.o -rattlemat ea9e84 rattle.o -par 20 eigen.o -bounds 1360 readrtns_CSA.o -pizda 4d8 readrtns_CSA.o -machsw c initialize_p.o -links_split 8 unres.o -integer_muca c readrtns_CSA.o -calc 1f0 gen_rand_conf.o -csafiles c00 unres.o -sbridge 9c unres.o -back_constr 874c unres.o -rotat e880 unres.o -mpipriv2 18 unres.o -remdrestart 411808 unres.o -stochcalc 3a20 MD_A-MTS.o -scrot 28a0 parmread.o -stoptim 4 unres.o -c_frag 9b0 geomout.o -precomp2 1d100 unres.o -move 13d8 initialize_p.o -loc_work 30c local_move.o -store0 4 geomout.o -torsion 5adc parmread.o -wagi bc4d0 geomout.o -vrandd 3f0 randgens.o -lagrange a468980 unres.o -accept_stats 2008 initialize_p.o -mdpmpi 8010 unres.o -invlen 1360 chainbuild.o -locel 208 energy_p_new.o -frag a0 geomout.o -inertia 160 unres.o -time1 30 unres.o -derivat 4cab48 initialize_p.o -langmat c readrtns_CSA.o -banii 3a20 banach.o -mdgrad 7470 unres.o -bank 9c20 readrtns_CSA.o -refer 98 bond_move.o -diploc 3938 unres.o -syfek 3a20 stochfric.o -fnames 1007 unres.o -$BLNK_COM c djacob.o -sccalc 28 energy_p_new.o -geo 40 unres.o -iofile 65c initialize_p.o -mapp e884 readrtns_CSA.o -theta_abinitio 24a70 chainbuild.o -sumsl_flag 4 unres.o -restr 48ac unres.o -chain 15d40 unres.o -torcnstr 1d28 initialize_p.o -cipiszcze 4 lagrangian_lesyng.o -double_muca 9b28 readrtns_CSA.o -links 116d34 unres.o -deriv_loc 1e0 initialize_p.o -cache 24610 mcm.o -minimm 20 initialize_p.o -diffcuta 8 readrtns_CSA.o -aaaa 8 MP.o -fourier 344 initialize_p.o -mce 230 readrtns_CSA.o -var dee0 unres.o -csa_input 98 readrtns_CSA.o -header 50 unres.o -splitele 10 initialize_p.o -setup 4028 unres.o -mcm 20a4 initialize_p.o -mce_counters 14 readrtns_CSA.o -frozen 4d8 geomout.o -struct a2c readrtns_CSA.o -info1 4024 gen_rand_conf.o -cntrl 78 unres.o -mpiprivc 2 unres.o -timing 58 unres.o -kutas 4 energy_p_new.o -precomp1 1bda0 unres.o -loc_const 40 local_move.o -contacts1 34cee8 unres.o -alphaa 7df8 readrtns_CSA.o -thread1 1cd0 readrtns_CSA.o -qmeas 6157c unres.o -dipmat 2eec800 unres.o -indices 8040 chainbuild.o -ffield 174 unres.o -vectors 196e0 energy_p_new.o -varin 4ec8 readrtns_CSA.o -csaunits 34 unres.o -contacts_hb 14e59e8 unres.o -contacts e888 unres.o -deriv_scloc 10590 initialize_p.o -secondarys 136 dihed_cons.o -pochodne 731d130 geomout.o -maxgrad a8 energy_p_new.o -send2 5760 readrtns_CSA.o -windows e8c initialize_p.o -gucio 18 MD_A-MTS.o -rotmat 15cc0 unres.o diff --git a/source/unres/src_MD/compinfo b/source/unres/src_MD/compinfo deleted file mode 100755 index 1b801efefeca3e6868d4d59a37a80effa09c278f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 10291 zcmcgydu&_P89%oB2&Jjh7lgK>7f5K@5tC+ZNlVLanmD}%Hz`fRcy!#jvE3LPJF>4! zieM|Gtz>y&K>}1EP3xu!F>QZzT2-Yjqk(n}ttM31UJBjaizTfva=Y01(?mhSX*z0d|Ivk9Wlik3OJ2+G2khn57cnN1E*2F59$}VS% z*$hCY!%yWBq#{RjOu8moA@y89r(xbH0jDZ5k}eS(BT6+yiscoPDzkzvm?v1Gj42#I zJFIK9lvmH|;W*JQS&u%dkF-M;?Nn)}N;{$>=ok`FY9F=@e@mplB~BGMn5*&((Ha3WqGWe7*kL`tX`*^w8;xvVv+CMtus#}zr3UK;K_J&nBnRp1btxT(FHyQX+xII!#m@WXqF@_qk&@j&xspN=iQuwusJR~TbY%)j#; zw51huN-mfV#zLj5d!PaVIK?rA{hQK+#AgD4eU8$k2`@|`C|uCPRZySCDgqTI+&rIEnQ-%Xt~TN5 zi;`l(X-uQ6&V)n53aP<_&nlpdHJR{>O}J{pXPa=%ghL<;X^RP;Q$QKJ)r7lEc#jFk z`#?z>dZ!|LJw!Nr1}}evHfuvCD^BEBuc%a5zV;fpx|gbuLmqoQ%bm+Zs=X3 z41KPL^KT%JAyUY7(xnaGn%CC8nyhs%-3@htoAIne zOD|jvO8EsZajne4WoWYY)x;a8rq7401B<)k^oejd>~Sx}8I-YZZD_;sixhB>K5xt$ zMF{Iwal8o%I-Ngv`ozeHsM7=Qj6&3pJ~u~Yqi5ivrC-+4d9J;V4dfPh%%R=^$E`u&P3-2IdDjDygp)p6=dnl7Sl-WF*>3-^1 z9XiN(&o-m>-=I99Js+K~;xbXCOU+d}557jXn50Y1(s7gyn55U3rN72{6pBAky7)&x z38J*+Q;g<#_NC7`t4VerNRK}cmZGkofK=Rw9C{Ns;#o9Fd!IWpffz*SKfq_a&uQuB z3yqAS4#&o`PEjHi(IU*VAkJb9evkZ6)}gt)*;9-indJ5EMmgNEqRZDn@0e1BMT*)F zYt6;dLA4m-gP?jupnSmWYUDxe5;nC6sEzJNHQ9NtG)Mb-baKq%>a@eq= zA5D=}fb7Tx4vTSO3t%0Vk?DSp+CZc7;Aen~c41Y1hivIuKE_3pD|cQ|zJ?Ei&fAU= zlfxeA(0y36d;K=|o((WHepOxXLz@zHord_{G56jij@v4DDyQD?J@bvM2er{wleE$- zb)$5vNs7xtp%c81gO7&}#-qr?U>eV!7WpyE{{iyHe+VALz`PSh51hn_66RT)*FVJB z)->O0>1fR>{&cYBoHks4)ij0qhijK00X*wZ8#NRD^nEpxT6$XztPbxq`Inz>PJiJ` zU(lZU!sSc@#488&E37xLFzt6Ku#QaTjmwVVYnXd!EA;K5w<}8Q)$^=}C!l96}}YUHV{4=USJktkLZ3=;i{(LVtH*DLq* z#RL5j)$E5h9``Dk@C#3*mb=EvBif_<&%7VJ?3op~$AHTQ{$9V3&o|*yYV(|`mVM638Mh9hJ8p;m zCSlHXA|O)@&@T8*0G>wd=ATU8H$$JJwhhhvsq-P%Fg^jB5mxztL9Q>5>|>tbt{C_e)JO=4oGmSk4lkhBAV~n{NOPj`NZ3`7!Ld&EOPnfj#r;}^bH&TFVwUGt!qsfQ-l=kY zy>wW^x#Goc-wGm_!sAqak5dH%=S5Bm``*(93;XTX)DA4pg=D|msRGB?ZVBv{4aWHt zvt&>6)-8bHTuJsc|5nS2(tHalJlW%SC!jdjkv+|CC#C(B(vIp+dPMIAInJHL)BKs0 z_6^eBUVjO*dm)3WWKZ*TwJea@N#)zyzsF`z^M8Xhp!EV-T+{6K4*`ZT!TMpM^=`ie zsC*%{?)@Q#Yp~h=;0zUEc90y}0xrW+*uQ)PbS?HXRWyh1Hk`0Y@*~)Son+bLkTKiS z`uwEaw3CF?Eqj*;9)KU(Q~XEe`aUWRpCSS1V50a54xR@fW45R78}!|yh7={G_7i;A zX1^cai7@S-%L%(rkiyko{uoHGe0pA>??Ci@h@NN2f!%)GW{*2ynCj+nG9})2`{zN; zTt04pVQP~0c6~elXVAr4O!cSrUX}LrJ&L*k*;Bh-2U~ObwBLPpJ_sO@zTk>H;r{@E z*`A)aUXk`AWGE@w5q-;M-zWEh`{VmhPFehv_IxbMCpl5F zpM#AvB^%4In^D;&HFmFjApOz|Lf&qVylseZi^=Z@!zMY7k@dij;zsidK8KbnzoAyx zyKF*x`9iDo)rGZns#Apcb%oYRv(N=Kq4m#-Pb)mJlD?S_MW7Q1tyo*&9zK@%QE;gs|o@2$`jOIrx zUIpKIRWro%F6dn}pP7X&_+m-(log*3^G=T$;&~Um?a;hp7P{C%_?}%#|B}LYFRT8g zh4(2dUd?FSTJg&mjYliK$jtJ*7zdT?b-8|#0*bZOKl7Mki~qwMpUbM| zsgNtCpF`GB;y(Tca9*xlcgf-z$droPpU{tU>V13z4W0AY0$Y7PEQ8O0fH<5}`;QxN zg-z`bivX8P5_&A8dX85z{Cb6n=E4mUr}HOV2$$9}essVUQZmt48T`RAejY7@ALRJd zaecUq{^>G!whaDx8Qcv4nahgv2CaXW170egjeu8`i2wJ?=y#%jr<;x0`cDtX=QI2W zXiojyPbI_8jF|BG71RA?{67qM6^!4g94|tfv7bqNw+;Vg89#^1;AhJCf1!;2n`Q7x zj#o1LZie#CLeVtu!VnWwjE!>SQ zCQ&f1?})~?2ckNEebxi1L55q4(U1`ede$^Htz{_CBf&x7)~;mY4Lq3Y@83n`c-vcf zF>PC$H+yyBuo%i0OX2V8g;MxVIn;NPzhh&wU+-vZ>-2W%UCkT)UaU861?Yi9BCtz` zZA>e`&x0_%^|tor&At|fZ}#GVhB)-0s&qsH4`%2(KfuwOOzC_}L24Gxj);RHMVsru z!gA_Fzj3F&HMAoFM@14X(Lgd8N{X`~MH^9$Z^6SQRa8r*U%j-#E);!pmkru pZVme?6j;1nVSdcUsw7U?STQ}sw`Js!8>i' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i - return - end -C----------------------------------------------------------------------------- - subroutine escp(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(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)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+e1+e2 - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -cgrad if (j.lt.i) then -cd write (iout,*) 'ji' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C-------------------------------------------------------------------------- - subroutine edis(ehpb) -C -C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - dimension ggg(3) - ehpb=0.0D0 -cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr -cd write(iout,*)'link_start=',link_start,' link_end=',link_end - if (link_end.eq.0) return - do i=link_start,link_end -C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a -C CA-CA distance used in regularization of structure. - ii=ihpb(i) - jj=jhpb(i) -C iii and jjj point to the residues for which the distance is assigned. - if (ii.gt.nres) then - iii=ii-nres - jjj=jj-nres - else - iii=ii - jjj=jj - endif -cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj -C 24/11/03 AL: SS bridges handled separately because of introducing a specific -C distance and angle dependent SS bond potential. - if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then - call ssbond_ene(iii,jjj,eij) - ehpb=ehpb+2*eij -cd write (iout,*) "eij",eij - else -C Calculate the distance between the two points and its difference from the -C target distance. - dd=dist(ii,jj) - rdis=dd-dhpb(i) -C Get the force constant corresponding to this distance. - waga=forcon(i) -C Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis -C -C Evaluate gradient. -C - fac=waga*rdis/dd -cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd, -cd & ' waga=',waga,' fac=',fac - do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) - enddo -cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3) -C If this is a SC-SC distance, we need to calculate the contributions to the -C Cartesian gradient in the SC vectors (ghpbx). - if (iii.lt.ii) then - do j=1,3 - ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) - ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) - enddo - endif -cgrad do j=iii,jjj-1 -cgrad do k=1,3 -cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k) -cgrad enddo -cgrad enddo - do k=1,3 - ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) - ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) - enddo - endif - enddo - ehpb=0.5D0*ehpb - return - end -C-------------------------------------------------------------------------- - subroutine ssbond_ene(i,j,eij) -C -C Calculate the distance and angle dependent SS-bond potential energy -C using a free-energy function derived based on RHF/6-31G** ab initio -C calculations of diethyl disulfide. -C -C A. Liwo and U. Kozlowska, 11/24/03 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - double precision erij(3),dcosom1(3),dcosom2(3),gg(3) - itypi=itype(i) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(nres+i) - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(nres+j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - erij(1)=xj*rij - erij(2)=yj*rij - erij(3)=zj*rij - om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) - om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) - om12=dxi*dxj+dyi*dyj+dzi*dzj - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - rij=1.0d0/rij - deltad=rij-d0cm - deltat1=1.0d0-om1 - deltat2=1.0d0+om2 - deltat12=om2-om1+2.0d0 - cosphi=om12-om1*om2 - eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) - & +akct*deltad*deltat12 - & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi -c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, -c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2, -c & " deltat12",deltat12," eij",eij - ed=2*akcm*deltad+akct*deltat12 - pom1=akct*deltad - pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi - eom1=-2*akth*deltat1-pom1-om2*pom2 - eom2= 2*akth*deltat2+pom1-om1*pom2 - eom12=pom2 - do k=1,3 - ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - ghpbx(k,i)=ghpbx(k,i)-ggk - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - ghpbx(k,j)=ghpbx(k,j)+ggk - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - ghpbc(k,i)=ghpbc(k,i)-ggk - ghpbc(k,j)=ghpbc(k,j)+ggk - enddo -C -C Calculate the components of the gradient in DC and X -C -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l) -cgrad enddo -cgrad enddo - return - end -C-------------------------------------------------------------------------- - subroutine ebond(estr) -c -c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision u(3),ud(3) - estr=0.0d0 - do i=ibondp_start,ibondp_end - diff = vbld(i)-vbldp0 -c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff - estr=estr+diff*diff - do j=1,3 - gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) - enddo -c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3) - enddo - estr=0.5d0*AKP*estr -c -c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included -c - do i=ibond_start,ibond_end - iti=itype(i) - if (iti.ne.10) then - nbi=nbondterm(iti) - if (nbi.eq.1) then - diff=vbld(i+nres)-vbldsc0(1,iti) -c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, -c & AKSC(1,iti),AKSC(1,iti)*diff*diff - estr=estr+0.5d0*AKSC(1,iti)*diff*diff - do j=1,3 - gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) - enddo - else - do j=1,nbi - diff=vbld(i+nres)-vbldsc0(j,iti) - ud(j)=aksc(j,iti)*diff - u(j)=abond0(j,iti)+0.5d0*ud(j)*diff - enddo - uprod=u(1) - do j=2,nbi - uprod=uprod*u(j) - enddo - usum=0.0d0 - usumsqder=0.0d0 - do j=1,nbi - uprod1=1.0d0 - uprod2=1.0d0 - do k=1,nbi - if (k.ne.j) then - uprod1=uprod1*u(k) - uprod2=uprod2*u(k)*u(k) - endif - enddo - usum=usum+uprod1 - usumsqder=usumsqder+ud(j)*uprod2 - enddo - estr=estr+uprod/usum - do j=1,3 - gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres) - enddo - endif - endif - enddo - return - end -#ifdef CRYST_THETA -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - double precision y(2),z(2) - delta=0.02d0*pi -c time11=dexp(-2*time) -c time12=1.0d0 - etheta=0.0D0 -c write (*,'(a,i2)') 'EBEND ICG=',icg - do i=ithet_start,ithet_end -C Zero the energy function and its derivative at 0 or pi. - call splinthet(theta(i),0.5d0*delta,ss,ssd) - it=itype(i-1) - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - y(1)=dcos(phii) - y(2)=dsin(phii) - else - y(1)=0.0D0 - y(2)=0.0D0 - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) - z(1)=cos(phii1) -#else - phii1=phi(i+1) - z(1)=dcos(phii1) -#endif - z(2)=dsin(phii1) - else - z(1)=0.0D0 - z(2)=0.0D0 - endif -C Calculate the "mean" value of theta from the part of the distribution -C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2). -C In following comments this theta will be referred to as t_c. - thet_pred_mean=0.0d0 - do k=1,2 - athetk=athet(k,it) - bthetk=bthet(k,it) - thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k) - enddo - dthett=thet_pred_mean*ssd - thet_pred_mean=thet_pred_mean*ss+a0thet(it) -C Derivatives of the "mean" values in gamma1 and gamma2. - dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss - dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss - if (theta(i).gt.pi-delta) then - call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0, - & E_tc0) - call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0) - call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai, - & E_theta) - call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else if (theta(i).lt.delta) then - call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0) - call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai, - & E_theta) - call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0) - call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else - call theteng(theta(i),thet_pred_mean,theta0(it),ethetai, - & E_theta,E_tc) - endif - etheta=etheta+ethetai - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'ebend',i,ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1 - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2 - gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett) - enddo -C Ufff.... We've done all this!!! - return - end -C--------------------------------------------------------------------------- - subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta, - & E_tc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it -C Calculate the contributions to both Gaussian lobes. -C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time) -C The "polynomial part" of the "standard deviation" of this part of -C the distribution. - sig=polthet(3,it) - do j=2,0,-1 - sig=sig*thet_pred_mean+polthet(j,it) - enddo -C Derivative of the "interior part" of the "standard deviation of the" -C gamma-dependent Gaussian lobe in t_c. - sigtc=3*polthet(3,it) - do j=2,1,-1 - sigtc=sigtc*thet_pred_mean+j*polthet(j,it) - enddo - sigtc=sig*sigtc -C Set the parameters of both Gaussian lobes of the distribution. -C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc) - fac=sig*sig+sigc0(it) - sigcsq=fac+fac - sigc=1.0D0/sigcsq -C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c - sigsqtc=-4.0D0*sigcsq*sigtc -c print *,i,sig,sigtc,sigsqtc -C Following variable (sigtc) is d[sigma(t_c)]/dt_c - sigtc=-sigtc/(fac*fac) -C Following variable is sigma(t_c)**(-2) - sigcsq=sigcsq*sigcsq - sig0i=sig0(it) - sig0inv=1.0D0/sig0i**2 - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i - term1=-0.5D0*sigcsq*delthec*delthec - term2=-0.5D0*sig0inv*delthe0*delthe0 -C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and -C NaNs in taking the logarithm. We extract the largest exponent which is added -C to the energy (this being the log of the distribution) at the end of energy -C term evaluation for this virtual-bond angle. - if (term1.gt.term2) then - termm=term1 - term2=dexp(term2-termm) - term1=1.0d0 - else - termm=term2 - term1=dexp(term1-termm) - term2=1.0d0 - endif -C The ratio between the gamma-independent and gamma-dependent lobes of -C the distribution is a Gaussian function of thet_pred_mean too. - diffak=gthet(2,it)-thet_pred_mean - ratak=diffak/gthet(3,it)**2 - ak=dexp(gthet(1,it)-0.5D0*diffak*ratak) -C Let's differentiate it in thet_pred_mean NOW. - aktc=ak*ratak -C Now put together the distribution terms to make complete distribution. - termexp=term1+ak*term2 - termpre=sigc+ak*sig0i -C Contribution of the bending energy from this theta is just the -log of -C the sum of the contributions from the two lobes and the pre-exponential -C factor. Simple enough, isn't it? - ethetai=(-dlog(termexp)-termm+dlog(termpre)) -C NOW the derivatives!!! -C 6/6/97 Take into account the deformation. - E_theta=(delthec*sigcsq*term1 - & +ak*delthe0*sig0inv*term2)/termexp - E_tc=((sigtc+aktc*sig0i)/termpre - & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ - & aktc*term2)/termexp) - return - end -c----------------------------------------------------------------------------- - subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i -C "Thank you" to MAPLE (probably spared one day of hand-differentiation). - t3 = thetai-thet_pred_mean - t6 = t3**2 - t9 = term1 - t12 = t3*sigcsq - t14 = t12+t6*sigsqtc - t16 = 1.0d0 - t21 = thetai-theta0i - t23 = t21**2 - t26 = term2 - t27 = t21*t26 - t32 = termexp - t40 = t32**2 - E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 - & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 - & *(-t12*t9-ak*sig0inv*t27) - return - end -#else -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C ab initio-derived potentials from -c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision coskt(mmaxtheterm),sinkt(mmaxtheterm), - & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle), - & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble), - & sinph1ph2(maxdouble,maxdouble) - logical lprn /.false./, lprn1 /.false./ - etheta=0.0D0 - do i=ithet_start,ithet_end - dethetai=0.0d0 - dephii=0.0d0 - dephii1=0.0d0 - theti2=0.5d0*theta(i) - ityp2=ithetyp(itype(i-1)) - do k=1,nntheterm - coskt(k)=dcos(k*theti2) - sinkt(k)=dsin(k*theti2) - enddo - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - ityp1=ithetyp(itype(i-2)) - do k=1,nsingle - cosph1(k)=dcos(k*phii) - sinph1(k)=dsin(k*phii) - enddo - else - phii=0.0d0 - ityp1=nthetyp+1 - do k=1,nsingle - cosph1(k)=0.0d0 - sinph1(k)=0.0d0 - enddo - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) -#else - phii1=phi(i+1) -#endif - ityp3=ithetyp(itype(i)) - do k=1,nsingle - cosph2(k)=dcos(k*phii1) - sinph2(k)=dsin(k*phii1) - enddo - else - phii1=0.0d0 - ityp3=nthetyp+1 - do k=1,nsingle - cosph2(k)=0.0d0 - sinph2(k)=0.0d0 - enddo - endif - ethetai=aa0thet(ityp1,ityp2,ityp3) - do k=1,ndouble - do l=1,k-1 - ccl=cosph1(l)*cosph2(k-l) - ssl=sinph1(l)*sinph2(k-l) - scl=sinph1(l)*cosph2(k-l) - csl=cosph1(l)*sinph2(k-l) - cosph1ph2(l,k)=ccl-ssl - cosph1ph2(k,l)=ccl+ssl - sinph1ph2(l,k)=scl+csl - sinph1ph2(k,l)=scl-csl - enddo - enddo - if (lprn) then - write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2, - & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1 - write (iout,*) "coskt and sinkt" - do k=1,nntheterm - write (iout,*) k,coskt(k),sinkt(k) - enddo - endif - do k=1,ntheterm - ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k) - dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3) - & *coskt(k) - if (lprn) - & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3), - & " ethetai",ethetai - enddo - if (lprn) then - write (iout,*) "cosph and sinph" - do k=1,nsingle - write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k) - enddo - write (iout,*) "cosph1ph2 and sinph2ph2" - do k=2,ndouble - do l=1,k-1 - write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l), - & sinph1ph2(l,k),sinph1ph2(k,l) - enddo - enddo - write(iout,*) "ethetai",ethetai - endif - do m=1,ntheterm2 - do k=1,nsingle - aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k) - & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k) - & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k) - & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*aux*coskt(m) - dephii=dephii+k*sinkt(m)*( - & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)- - & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)) - dephii1=dephii1+k*sinkt(m)*( - & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)- - & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k)) - if (lprn) - & write (iout,*) "m",m," k",k," bbthet", - & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet", - & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet", - & ddthet(k,m,ityp1,ityp2,ityp3)," eethet", - & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai - enddo - enddo - if (lprn) - & write(iout,*) "ethetai",ethetai - do m=1,ntheterm3 - do k=2,ndouble - do l=1,k-1 - aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*coskt(m)*aux - dephii=dephii+l*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)- - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - dephii1=dephii1+(k-l)*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)- - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - if (lprn) then - write (iout,*) "m",m," k",k," l",l," ffthet", - & ffthet(l,k,m,ityp1,ityp2,ityp3), - & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet", - & ggthet(l,k,m,ityp1,ityp2,ityp3), - & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai - write (iout,*) cosph1ph2(l,k)*sinkt(m), - & cosph1ph2(k,l)*sinkt(m), - & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m) - endif - enddo - enddo - enddo -10 continue - if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') - & i,theta(i)*rad2deg,phii*rad2deg, - & phii1*rad2deg,ethetai - etheta=etheta+ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 - gloc(nphi+i-2,icg)=wang*dethetai - enddo - return - end -#endif -#ifdef CRYST_SC -c----------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), - & ddersc0(3),ddummy(3),xtemp(3),temp(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 -c write (iout,'(a)') 'ESC' - do i=loc_start,loc_end - it=itype(i) - if (it.eq.10) goto 1 - nlobit=nlob(it) -c print *,'i=',i,' it=',it,' nlobit=',nlobit -c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad - theti=theta(i+1)-pipol - x(1)=dtan(theti) - x(2)=alph(i) - x(3)=omeg(i) - - if (x(2).gt.pi-delta) then - xtemp(1)=x(1) - xtemp(2)=pi-delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=pi - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=pi-delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=pi - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - call splinthet(x(2),0.5d0*delta,ss,ssd) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c escloci=esclocbi -c write (iout,*) escloci - else if (x(2).lt.delta) then - xtemp(1)=x(1) - xtemp(2)=delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=0.0d0 - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=0.0d0 - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - call splinthet(x(2),0.5d0*delta,ss,ssd) - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c write (iout,*) escloci - else - call enesc(x,escloci,dersc,ddummy,.false.) - endif - - escloc=escloc+escloci - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'escloc',i,escloci -c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc - - gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ - & wscloc*dersc(1) - gloc(ialph(i,1),icg)=wscloc*dersc(2) - gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) - 1 continue - enddo - return - end -C--------------------------------------------------------------------------- - subroutine enesc(x,escloci,dersc,ddersc,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3) - double precision contr(maxlob,-1:1) - logical mixed -c write (iout,*) 'it=',it,' nlobit=',nlobit - escloc_i=0.0D0 - do j=1,3 - dersc(j)=0.0D0 - if (mixed) ddersc(j)=0.0d0 - enddo - x3=x(3) - -C Because of periodicity of the dependence of the SC energy in omega we have -C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi). -C To avoid underflows, first compute & store the exponents. - - do iii=-1,1 - - x(3)=x3+iii*dwapi - - do j=1,nlobit - do k=1,3 - z(k)=x(k)-censc(k,j,it) - enddo - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j,iii)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j,iii)*z(k) - enddo - contr(j,iii)=expfac - enddo ! j - - enddo ! iii - - x(3)=x3 -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1,-1) - do iii=-1,1 - do j=1,nlobit - if (emin.gt.contr(j,iii)) emin=contr(j,iii) - enddo - enddo - emin=0.5D0*emin -cd print *,'it=',it,' emin=',emin - -C Compute the contribution to SC energy and derivatives - do iii=-1,1 - - do j=1,nlobit -#ifdef OSF - adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin - if(adexp.ne.adexp) adexp=1.0 - expfac=dexp(adexp) -#else - expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin) -#endif -cd print *,'j=',j,' expfac=',expfac - escloc_i=escloc_i+expfac - do k=1,3 - dersc(k)=dersc(k)+Ax(k,j,iii)*expfac - enddo - if (mixed) then - do k=1,3,2 - ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) - & +gaussc(k,2,j,it))*expfac - enddo - endif - enddo - - enddo ! iii - - dersc(1)=dersc(1)/cos(theti)**2 - ddersc(1)=ddersc(1)/cos(theti)**2 - ddersc(3)=ddersc(3) - - escloci=-(dlog(escloc_i)-emin) - do j=1,3 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) then - do j=1,3,2 - ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j)) - enddo - endif - return - end -C------------------------------------------------------------------------------ - subroutine enesc_bound(x,escloci,dersc,dersc12,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob),dersc(3) - double precision contr(maxlob) - logical mixed - - escloc_i=0.0D0 - - do j=1,3 - dersc(j)=0.0D0 - enddo - - do j=1,nlobit - do k=1,2 - z(k)=x(k)-censc(k,j,it) - enddo - z(3)=dwapi - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j)*z(k) - enddo - contr(j)=expfac - enddo ! j - -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1) - do j=1,nlobit - if (emin.gt.contr(j)) emin=contr(j) - enddo - emin=0.5D0*emin - -C Compute the contribution to SC energy and derivatives - - dersc12=0.0d0 - do j=1,nlobit - expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin) - escloc_i=escloc_i+expfac - do k=1,2 - dersc(k)=dersc(k)+Ax(k,j)*expfac - enddo - if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) - & +gaussc(1,2,j,it))*expfac - dersc(3)=0.0d0 - enddo - - dersc(1)=dersc(1)/cos(theti)**2 - dersc12=dersc12/cos(theti)**2 - escloci=-(dlog(escloc_i)-emin) - do j=1,2 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1)) - return - end -#else -c---------------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA derived from AM1 all-atom calculations. -C added by Urszula Kozlowska. 07/11/2007 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.SCROT' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.VECTORS' - double precision x_prime(3),y_prime(3),z_prime(3) - & , sumene,dsc_i,dp2_i,x(65), - & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6, - & de_dxx,de_dyy,de_dzz,de_dt - double precision s1_t,s1_6_t,s2_t,s2_6_t - double precision - & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3), - & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3), - & dt_dCi(3),dt_dCi1(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 - do i=loc_start,loc_end - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=itype(i) - if (it.eq.10) goto 1 -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo -C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres), -C & dc_norm(3,i+nres) - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - do j = 1,3 - z_prime(j) = -uz(j,i-1) - enddo -c write (2,*) "i",i -c write (2,*) "x_prime",(x_prime(j),j=1,3) -c write (2,*) "y_prime",(y_prime(j),j=1,3) -c write (2,*) "z_prime",(z_prime(j),j=1,3) -c write (2,*) "xx",scalar(x_prime(1),x_prime(1)), -c & " xy",scalar(x_prime(1),y_prime(1)), -c & " xz",scalar(x_prime(1),z_prime(1)), -c & " yy",scalar(y_prime(1),y_prime(1)), -c & " yz",scalar(y_prime(1),z_prime(1)), -c & " zz",scalar(z_prime(1),z_prime(1)) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxtab(i)=xx - yytab(i)=yy - zztab(i)=zz -C -C Compute the energy of the ith side cbain -C -c write (2,*) "xx",xx," yy",yy," zz",zz - it=itype(i) - do j = 1,65 - x(j) = sc_parmin(j,it) - enddo -#ifdef CHECK_COORD -Cc diagnostics - remove later - xx1 = dcos(alph(2)) - yy1 = dsin(alph(2))*dcos(omeg(2)) - zz1 = -dsin(alph(2))*dsin(omeg(2)) - write(2,'(3f8.1,3f9.3,1x,3f9.3)') - & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz, - & xx1,yy1,zz1 -C," --- ", xx_w,yy_w,zz_w -c end diagnostics -#endif - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)+yy*sint2tab(i+1))) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)-yy*sint2tab(i+1))) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) - & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6) -c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3, -c & sumene4, -c & dscp1,dscp2,sumene -c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - escloc = escloc + sumene -c write (2,*) "i",i," escloc",sumene,escloc -#ifdef DEBUG -C -C This section to check the numerical derivatives of the energy of ith side -C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert -C #define DEBUG in the code to turn it on. -C - write (2,*) "sumene =",sumene - aincr=1.0d-7 - xxsave=xx - xx=xx+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dxx_num=(sumenep-sumene)/aincr - xx=xxsave - write (2,*) "xx+ sumene from enesc=",sumenep - yysave=yy - yy=yy+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dyy_num=(sumenep-sumene)/aincr - yy=yysave - write (2,*) "yy+ sumene from enesc=",sumenep - zzsave=zz - zz=zz+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dzz_num=(sumenep-sumene)/aincr - zz=zzsave - write (2,*) "zz+ sumene from enesc=",sumenep - costsave=cost2tab(i+1) - sintsave=sint2tab(i+1) - cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr)) - sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr)) - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dt_num=(sumenep-sumene)/aincr - write (2,*) " t+ sumene from enesc=",sumenep - cost2tab(i+1)=costsave - sint2tab(i+1)=sintsave -C End of diagnostics section. -#endif -C -C Compute the gradient of esc -C - pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2 - pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2 - pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2 - pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2 - pom_dx=dsc_i*dp2_i*cost2tab(i+1) - pom_dy=dsc_i*dp2_i*sint2tab(i+1) - pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1)) - pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1)) - pom1=(sumene3*sint2tab(i+1)+sumene1) - & *(pom_s1/dscp1+pom_s16*dscp1**4) - pom2=(sumene4*cost2tab(i+1)+sumene2) - & *(pom_s2/dscp2+pom_s26*dscp2**4) - sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy - sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 - & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) - & +x(40)*yy*zz - sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy - sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 - & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) - & +x(60)*yy*zz - de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) - & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) - & +(pom1+pom2)*pom_dx -#ifdef DEBUG - write(2,*), "de_dxx = ", de_dxx,de_dxx_num -#endif -C - sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz - sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 - & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) - & +x(40)*xx*zz - sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz - sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz - & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz - & +x(59)*zz**2 +x(60)*xx*zz - de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) - & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) - & +(pom1-pom2)*pom_dy -#ifdef DEBUG - write(2,*), "de_dyy = ", de_dyy,de_dyy_num -#endif -C - de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy - & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx - & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) - & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) - & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 - & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy - & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) - & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6) -#ifdef DEBUG - write(2,*), "de_dzz = ", de_dzz,de_dzz_num -#endif -C - de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) - & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) - & +pom1*pom_dt1+pom2*pom_dt2 -#ifdef DEBUG - write(2,*), "de_dt = ", de_dt,de_dt_num -#endif -c -C - cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres)) - cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) - cosfac2xx=cosfac2*xx - sinfac2yy=sinfac2*yy - do k = 1,3 - dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* - & vbld_inv(i+1) - dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* - & vbld_inv(i) - pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1) - pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i) -c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1, -c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k) -c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3), -c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i) - dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx - dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx - dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy - dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy - dZZ_Ci1(k)=0.0d0 - dZZ_Ci(k)=0.0d0 - do j=1,3 - dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres) - dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres) - enddo - - dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres)) - dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres)) - dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres)) -c - dt_dCi(k) = -dt_dCi(k)/sinttab(i+1) - dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1) - enddo - - do k=1,3 - dXX_Ctab(k,i)=dXX_Ci(k) - dXX_C1tab(k,i)=dXX_Ci1(k) - dYY_Ctab(k,i)=dYY_Ci(k) - dYY_C1tab(k,i)=dYY_Ci1(k) - dZZ_Ctab(k,i)=dZZ_Ci(k) - dZZ_C1tab(k,i)=dZZ_Ci1(k) - dXX_XYZtab(k,i)=dXX_XYZ(k) - dYY_XYZtab(k,i)=dYY_XYZ(k) - dZZ_XYZtab(k,i)=dZZ_XYZ(k) - enddo - - do k = 1,3 -c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1", -c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k) -c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci", -c & dyy_ci(k)," dzz_ci",dzz_ci(k) -c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci", -c & dt_dci(k) -c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ", -c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k) - gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) - & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k) - gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) - & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k) - gsclocx(k,i)= de_dxx*dxx_XYZ(k) - & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k) - enddo -c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3), -c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3) - -C to check gradient call subroutine check_grad - - 1 continue - enddo - return - end -c------------------------------------------------------------------------------ - double precision function enesc(x,xx,yy,zz,cost2,sint2) - implicit none - double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2, - & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6 - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2+yy*sint2)) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2-yy*sint2)) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) - & + (sumene4*cost2 +sumene2)*(s2+s2_6) - enesc=sumene - return - end -#endif -c------------------------------------------------------------------------------ - subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont) -C -C This procedure calculates two-body contact function g(rij) and its derivative: -C -C eps0ij ! x < -1 -C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1 -C 0 ! x > 1 -C -C where x=(rij-r0ij)/delta -C -C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy -C - implicit none - double precision rij,r0ij,eps0ij,fcont,fprimcont - double precision x,x2,x4,delta -c delta=0.02D0*r0ij -c delta=0.2D0*r0ij - x=(rij-r0ij)/delta - if (x.lt.-1.0D0) then - fcont=eps0ij - fprimcont=0.0D0 - else if (x.le.1.0D0) then - x2=x*x - x4=x2*x2 - fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0) - fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta - else - fcont=0.0D0 - fprimcont=0.0D0 - endif - return - end -c------------------------------------------------------------------------------ - subroutine splinthet(theti,delta,ss,ssder) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - thetup=pi-delta - thetlow=delta - if (theti.gt.pipol) then - call gcont(theti,thetup,1.0d0,delta,ss,ssder) - else - call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder) - ssder=-ssder - endif - return - end -c------------------------------------------------------------------------------ - subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim) - implicit none - double precision x,x0,delta,f0,f1,fprim0,f,fprim - double precision ksi,ksi2,ksi3,a1,a2,a3 - a1=fprim0*delta/(f1-f0) - a2=3.0d0-2.0d0*a1 - a3=a1-2.0d0 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi)) - fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3)) - return - end -c------------------------------------------------------------------------------ - subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx) - implicit none - double precision x,x0,delta,f0x,f1x,fprim0x,fx - double precision ksi,ksi2,ksi3,a1,a2,a3 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - a1=fprim0x*delta - a2=3*(f1x-f0x)-2*fprim0x*delta - a3=fprim0x*delta-2*(f1x-f0x) - fx=f0x+a1*ksi+a2*ksi2+a3*ksi3 - return - end -C----------------------------------------------------------------------------- -#ifdef CRYST_TOR -C----------------------------------------------------------------------------- - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Proline-Proline pair is a special case... - if (itori.eq.3 .and. itori1.eq.3) then - if (phii.gt.-dwapi3) then - cosphi=dcos(3*phii) - fac=1.0D0/(1.0D0-cosphi) - etorsi=v1(1,3,3)*fac - etorsi=etorsi+etorsi - etors=etors+etorsi-v1(1,3,3) - if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3) - gloci=gloci-3*fac*etorsi*dsin(3*phii) - endif - do j=1,3 - v1ij=v1(j+1,itori,itori1) - v2ij=v2(j+1,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - else - do j=1,nterm_old - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - endif - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - 'etor',i,etors_ii - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 - do i=1,ndih_constr - itori=idih_constr(i) - phii=phi(itori) - difi=phii-phi0(i) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - endif -! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, -! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -! write (iout,*) 'edihcnstr',edihcnstr - return - end -c------------------------------------------------------------------------------ - subroutine etor_d(etors_d) - etors_d=0.0d0 - return - end -c---------------------------------------------------------------------------- -#else - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Regular cosine and sine terms - do j=1,nterm(itori,itori1) - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo -C Lorentz terms -C v1 -C E = SUM ----------------------------------- - v1 -C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1 -C - cosphi=dcos(0.5d0*phii) - sinphi=dsin(0.5d0*phii) - do j=1,nlor(itori,itori1) - vl1ij=vlor1(j,itori,itori1) - vl2ij=vlor2(j,itori,itori1) - vl3ij=vlor3(j,itori,itori1) - pom=vl2ij*cosphi+vl3ij*sinphi - pom1=1.0d0/(pom*pom+1.0d0) - etors=etors+vl1ij*pom1 - if (energy_dec) etors_ii=etors_ii+ - & vl1ij*pom1 - pom=-pom*pom1*pom1 - gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom - enddo -C Subtract the constant term - etors=etors-v0(itori,itori1) - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii-v0(itori,itori1) - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 -c do i=1,ndih_constr - do i=idihconstr_start,idihconstr_end - itori=idih_constr(i) - phii=phi(itori) - difi=pinorm(phii-phi0(i)) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else - difi=0.0 - endif -cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii, -cd & rad2deg*phi0(i), rad2deg*drange(i), -cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -cd write (iout,*) 'edihcnstr',edihcnstr - return - end -c---------------------------------------------------------------------------- - subroutine etor_d(etors_d) -C 6/23/01 Compute double torsional energy - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors_d=0.0D0 - do i=iphid_start,iphid_end - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - itori2=itortyp(itype(i)) - phii=phi(i) - phii1=phi(i+1) - gloci1=0.0D0 - gloci2=0.0D0 -C Regular cosine and sine terms - do j=1,ntermd_1(itori,itori1,itori2) - v1cij=v1c(1,j,itori,itori1,itori2) - v1sij=v1s(1,j,itori,itori1,itori2) - v2cij=v1c(2,j,itori,itori1,itori2) - v2sij=v1s(2,j,itori,itori1,itori2) - cosphi1=dcos(j*phii) - sinphi1=dsin(j*phii) - cosphi2=dcos(j*phii1) - sinphi2=dsin(j*phii1) - etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ - & v2cij*cosphi2+v2sij*sinphi2 - gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) - gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) - enddo - do k=2,ntermd_2(itori,itori1,itori2) - do l=1,k-1 - v1cdij = v2c(k,l,itori,itori1,itori2) - v2cdij = v2c(l,k,itori,itori1,itori2) - v1sdij = v2s(k,l,itori,itori1,itori2) - v2sdij = v2s(l,k,itori,itori1,itori2) - cosphi1p2=dcos(l*phii+(k-l)*phii1) - cosphi1m2=dcos(l*phii-(k-l)*phii1) - sinphi1p2=dsin(l*phii+(k-l)*phii1) - sinphi1m2=dsin(l*phii-(k-l)*phii1) - etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ - & v1sdij*sinphi1p2+v2sdij*sinphi1m2 - gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2-v2cdij*sinphi1m2) - gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) - enddo - enddo - gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1 - gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2 - enddo - return - end -#endif -c------------------------------------------------------------------------------ - subroutine eback_sc_corr(esccor) -c 7/21/2007 Correlations between the backbone-local and side-chain-local -c conformational states; temporarily implemented as differences -c between UNRES torsional potentials (dependent on three types of -c residues) and the torsional potentials dependent on all 20 types -c of residues computed from AM1 energy surfaces of terminally-blocked -c amino-acid residues. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. -c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor - esccor=0.0D0 - do i=iphi_start,iphi_end - esccor_ii=0.0D0 - itori=itype(i-2) - itori1=itype(i-1) - phii=phi(i) - gloci=0.0D0 - do j=1,nterm_sccor - v1ij=v1sccor(j,itori,itori1) - v2ij=v2sccor(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - esccor=esccor+v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6) - gsccor_loc(i-3)=gsccor_loc(i-3)+gloci - enddo - return - end -c---------------------------------------------------------------------------- - subroutine multibody(ecorr) -C This subroutine calculates multi-body contributions to energy following -C the idea of Skolnick et al. If side chains I and J make a contact and -C at the same time side chains I+1 and J+1 make a contact, an extra -C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - -C Set lprn=.true. for debugging - lprn=.false. - - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(i2,20(1x,i2,f10.5))') - & i,(jcont(j,i),facont(j,i),j=1,num_cont(i)) - enddo - endif - ecorr=0.0D0 - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo - do i=nnt,nct-2 - - DO ISHIFT = 3,4 - - i1=i+ishift - num_conti=num_cont(i) - num_conti1=num_cont(i1) - do jj=1,num_conti - j=jcont(jj,i) - do kk=1,num_conti1 - j1=jcont(kk,i1) - if (j1.eq.j+ishift .or. j1.eq.j-ishift) then -cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1, -cd & ' ishift=',ishift -C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk) - endif ! j1==j+-ishift - enddo ! kk - enddo ! jj - - ENDDO ! ISHIFT - - enddo ! i - return - end -c------------------------------------------------------------------------------ - double precision function esccorr(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont(jj,i) - ekl=facont(kk,k) -cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl -C Calculate the multi-body contribution to energy. -C Calculate multi-body contributions to the gradient. -cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3), -cd & k,l,(gacont(m,kk,k),m=1,3) - do m=1,3 - gx(m) =ekl*gacont(m,jj,i) - gx1(m)=eij*gacont(m,kk,k) - gradxorr(m,i)=gradxorr(m,i)-gx(m) - gradxorr(m,j)=gradxorr(m,j)+gx(m) - gradxorr(m,k)=gradxorr(m,k)-gx1(m) - gradxorr(m,l)=gradxorr(m,l)+gx1(m) - enddo - do m=i,j-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx(ll) - enddo - enddo - do m=k,l-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll) - enddo - enddo - esccorr=-eij*ekl - return - end -c------------------------------------------------------------------------------ - subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=26) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.LOCAL' - double precision gx(3),gx1(3),time00 - logical lprn,ldone - -C Set lprn=.true. for debugging - lprn=.false. -#ifdef MPI - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - call flush(iout) - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors -c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end -c call flush(iout) - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.gt.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,i) - zapas(4,nn,iproc)=ees0p(j,i) - zapas(5,nn,iproc)=ees0m(j,i) - zapas(6,nn,iproc)=gacont_hbr(1,j,i) - zapas(7,nn,iproc)=gacont_hbr(2,j,i) - zapas(8,nn,iproc)=gacont_hbr(3,j,i) - zapas(9,nn,iproc)=gacontm_hb1(1,j,i) - zapas(10,nn,iproc)=gacontm_hb1(2,j,i) - zapas(11,nn,iproc)=gacontm_hb1(3,j,i) - zapas(12,nn,iproc)=gacontp_hb1(1,j,i) - zapas(13,nn,iproc)=gacontp_hb1(2,j,i) - zapas(14,nn,iproc)=gacontp_hb1(3,j,i) - zapas(15,nn,iproc)=gacontm_hb2(1,j,i) - zapas(16,nn,iproc)=gacontm_hb2(2,j,i) - zapas(17,nn,iproc)=gacontm_hb2(3,j,i) - zapas(18,nn,iproc)=gacontp_hb2(1,j,i) - zapas(19,nn,iproc)=gacontp_hb2(2,j,i) - zapas(20,nn,iproc)=gacontp_hb2(3,j,i) - zapas(21,nn,iproc)=gacontm_hb3(1,j,i) - zapas(22,nn,iproc)=gacontm_hb3(2,j,i) - zapas(23,nn,iproc)=gacontm_hb3(3,j,i) - zapas(24,nn,iproc)=gacontp_hb3(1,j,i) - zapas(25,nn,iproc)=gacontp_hb3(2,j,i) - zapas(26,nn,iproc)=gacontp_hb3(3,j,i) - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq - call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" - call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - facont_hb(nnn,ii)=zapas_recv(3,i,iii) - ees0p(nnn,ii)=zapas_recv(4,i,iii) - ees0m(nnn,ii)=zapas_recv(5,i,iii) - gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii) - gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii) - gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii) - gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii) - gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii) - gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii) - gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii) - gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii) - gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii) - gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii) - gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii) - gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii) - gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii) - gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii) - gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii) - gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii) - gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii) - gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii) - gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii) - gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii) - gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii) - enddo - enddo - call flush(iout) - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the local-electrostatic correlation terms - do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end) - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0) - n_corr=n_corr+1 - else if (j1.eq.j) then -C Contacts I-J and I-(J+1) occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) - endif - enddo ! kk - do kk=1,num_conti - j1=jcont_hb(kk,i) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1) then -C Contacts I-J and (I+1)-J occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) - endif ! j1==j+1 - enddo ! kk - enddo ! jj - enddo ! i - return - end -c------------------------------------------------------------------------------ - subroutine add_hb_contact(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=26) - include "COMMON.CONTACTS" - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,ii) - zapas(4,nn,iproc)=ees0p(j,ii) - zapas(5,nn,iproc)=ees0m(j,ii) - zapas(6,nn,iproc)=gacont_hbr(1,j,ii) - zapas(7,nn,iproc)=gacont_hbr(2,j,ii) - zapas(8,nn,iproc)=gacont_hbr(3,j,ii) - zapas(9,nn,iproc)=gacontm_hb1(1,j,ii) - zapas(10,nn,iproc)=gacontm_hb1(2,j,ii) - zapas(11,nn,iproc)=gacontm_hb1(3,j,ii) - zapas(12,nn,iproc)=gacontp_hb1(1,j,ii) - zapas(13,nn,iproc)=gacontp_hb1(2,j,ii) - zapas(14,nn,iproc)=gacontp_hb1(3,j,ii) - zapas(15,nn,iproc)=gacontm_hb2(1,j,ii) - zapas(16,nn,iproc)=gacontm_hb2(2,j,ii) - zapas(17,nn,iproc)=gacontm_hb2(3,j,ii) - zapas(18,nn,iproc)=gacontp_hb2(1,j,ii) - zapas(19,nn,iproc)=gacontp_hb2(2,j,ii) - zapas(20,nn,iproc)=gacontp_hb2(3,j,ii) - zapas(21,nn,iproc)=gacontm_hb3(1,j,ii) - zapas(22,nn,iproc)=gacontm_hb3(2,j,ii) - zapas(23,nn,iproc)=gacontm_hb3(3,j,ii) - zapas(24,nn,iproc)=gacontp_hb3(1,j,ii) - zapas(25,nn,iproc)=gacontp_hb3(2,j,ii) - zapas(26,nn,iproc)=gacontp_hb3(3,j,ii) - exit - endif - enddo - endif - enddo - return - end -c------------------------------------------------------------------------------ - subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr, - & n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=70) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.CONTROL' - double precision gx(3),gx1(3) - integer num_cont_hb_old(maxres) - logical lprn,ldone - double precision eello4,eello5,eelo6,eello_turn6 - external eello4,eello5,eello6,eello_turn6 -C Set lprn=.true. for debugging - lprn=.false. - eturn6=0.0d0 -#ifdef MPI - do i=1,nres - num_cont_hb_old(i)=num_cont_hb(i) - enddo - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - call flush(iout) - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.ne.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,i) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i) - enddo - enddo - enddo - enddo - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq - call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" - call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - d_cont(nnn,ii)=zapas_recv(3,i,iii) - ind=3 - do kk=1,3 - ind=ind+1 - grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - enddo - enddo - enddo - enddo - call flush(iout) - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 - ecorr5=0.0d0 - ecorr6=0.0d0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the dipole-dipole interaction energies - if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then - do i=iatel_s,iatel_e+1 - num_conti=num_cont_hb(i) - do jj=1,num_conti - j=jcont_hb(jj,i) -#ifdef MOMENT - call dipole(i,j,jj) -#endif - enddo - enddo - endif -C Calculate the local-electrostatic correlation terms -c write (iout,*) "gradcorr5 in eello5 before loop" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1) -c write (iout,*) "corr loop i",i - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk -c if (j1.eq.j+1 .or. j1.eq.j-1) then - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - n_corr=n_corr+1 - sqd1=dsqrt(d_cont(jj,i)) - sqd2=dsqrt(d_cont(kk,i1)) - sred_geom = sqd1*sqd2 - IF (sred_geom.lt.cutoff_corr) THEN - call gcont(sred_geom,r0_corr,1.0D0,delt_corr, - & ekont,fprimcont) -cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1, -cd & ' jj=',jj,' kk=',kk - fac_prim1=0.5d0*sqd2/sqd1*fprimcont - fac_prim2=0.5d0*sqd1/sqd2*fprimcont - do l=1,3 - g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i) - g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1) - enddo - n_corr1=n_corr1+1 -cd write (iout,*) 'sred_geom=',sred_geom, -cd & ' ekont=',ekont,' fprim=',fprimcont, -cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2 -cd write (iout,*) "g_contij",g_contij -cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i) -cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1) - call calc_eello(i,jp,i+1,jp1,jj,kk) - if (wcorr4.gt.0.0d0) - & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk) - if (energy_dec.and.wcorr4.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 before eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (wcorr5.gt.0.0d0) - & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 after eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (energy_dec.and.wcorr5.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk) -cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6 -cd write(2,*)'ijkl',i,jp,i+1,jp1 - if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 - & .or. wturn6.eq.0.0d0))then -cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1 - ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk) -cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5, -cd & 'ecorr6=',ecorr6 -cd write (iout,'(4e15.5)') sred_geom, -cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello6(i,jp,i+1,jp1,jj,kk)) - else if (wturn6.gt.0.0d0 - & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then -cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1 - eturn6=eturn6+eello_turn6(i,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk) -cd write (2,*) 'multibody_eello:eturn6',eturn6 - endif - ENDIF -1111 continue - endif - enddo ! kk - enddo ! jj - enddo ! i - do i=1,nres - num_cont_hb(i)=num_cont_hb_old(i) - enddo -c write (iout,*) "gradcorr5 in eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - return - end -c------------------------------------------------------------------------------ - subroutine add_hb_contact_eello(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=70) - include "COMMON.CONTACTS" - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "send turns i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,ii) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii) - enddo - enddo - enddo - enddo - exit - endif - enddo - endif - enddo - return - end -c------------------------------------------------------------------------------ - double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont_hb(jj,i) - ekl=facont_hb(kk,k) - ees0pij=ees0p(jj,i) - ees0pkl=ees0p(kk,k) - ees0mij=ees0m(jj,i) - ees0mkl=ees0m(kk,k) - ekont=eij*ekl - ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl) -cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl) -C Following 4 lines for diagnostics. -cd ees0pkl=0.0D0 -cd ees0pij=1.0D0 -cd ees0mkl=0.0D0 -cd ees0mij=1.0D0 -c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)') -c & 'Contacts ',i,j, -c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l -c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees, -c & 'gradcorr_long' -C Calculate the multi-body contribution to energy. - ecorr=ecorr+ekont*ees -C Calculate multi-body contributions to the gradient. - coeffpees0pij=coeffp*ees0pij - coeffmees0mij=coeffm*ees0mij - coeffpees0pkl=coeffp*ees0pkl - coeffmees0mkl=coeffm*ees0mkl - do ll=1,3 -cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i) - gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb1(ll,jj,i)) - gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb2(ll,jj,i)) -cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k) - gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ - & coeffmees0mij*gacontm_hb1(ll,kk,k)) - gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ - & coeffmees0mij*gacontm_hb2(ll,kk,k)) - gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- - & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb3(ll,jj,i)) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij - gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- - & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ - & coeffmees0mij*gacontm_hb3(ll,kk,k)) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl -c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl - enddo -c write (iout,*) -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*ekl*gacont_hbr(ll,jj,i)- -cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ -cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*eij*gacont_hbr(ll,kk,k)- -cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ -cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) -cgrad enddo -cgrad enddo -c write (iout,*) "ehbcorr",ekont*ees - ehbcorr=ekont*ees - return - end -#ifdef MOMENT -C--------------------------------------------------------------------------- - subroutine dipole(i,j,jj) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2), - & auxmat(2,2) - iti1 = itortyp(itype(i+1)) - if (j.lt.nres-1) then - itj1 = itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - do iii=1,2 - dipi(iii,1)=Ub2(iii,i) - dipderi(iii)=Ub2der(iii,i) - dipi(iii,2)=b1(iii,iti1) - dipj(iii,1)=Ub2(iii,j) - dipderj(iii)=Ub2der(iii,j) - dipj(iii,2)=b1(iii,itj1) - enddo - kkk=0 - do iii=1,2 - call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1)) - do jjj=1,2 - kkk=kkk+1 - dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - do kkk=1,5 - do lll=1,3 - mmm=0 - do iii=1,2 - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii), - & auxvec(1)) - do jjj=1,2 - mmm=mmm+1 - dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - enddo - enddo - call transpose2(a_chuj(1,1,jj,i),auxmat(1,1)) - call matvec2(auxmat(1,1),dipderi(1),auxvec(1)) - do iii=1,2 - dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii)) - enddo - call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1)) - do iii=1,2 - dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii)) - enddo - return - end -#endif -C--------------------------------------------------------------------------- - subroutine calc_eello(i,j,k,l,jj,kk) -C -C This subroutine computes matrices and vectors needed to calculate -C the fourth-, fifth-, and sixth-order local-electrostatic terms. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2), - & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2) - logical lprn - common /kutas/ lprn -cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l, -cd & ' jj=',jj,' kk=',kk -cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return -cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2) -cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2) - do iii=1,2 - do jjj=1,2 - aa1(iii,jjj)=a_chuj(iii,jjj,jj,i) - aa2(iii,jjj)=a_chuj(iii,jjj,kk,k) - enddo - enddo - call transpose2(aa1(1,1),aa1t(1,1)) - call transpose2(aa2(1,1),aa2t(1,1)) - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,jj,i), - & aa1tder(1,1,lll,kkk)) - call transpose2(a_chuj_der(1,1,lll,kkk,kk,k), - & aa2tder(1,1,lll,kkk)) - enddo - enddo - if (l.eq.j+1) then -C parallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itj=itortyp(itype(j)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -C A1 kernel(j+1) A2T -cd do iii=1,2 -cd write (iout,'(3f10.5,5x,3f10.5)') -cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2) -cd enddo - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l), - & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - lprn=.false. - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l), - & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants -cd lprn=.false. -cd if (lprn) then -cd write (2,*) 'In calc_eello6' -cd do iii=1,2 -cd write (2,*) 'iii=',iii -cd do kkk=1,5 -cd write (2,*) 'kkk=',kkk -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) -cd enddo -cd enddo -cd enddo -cd endif - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A1T kernel(i+1) A2 - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2)) - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - else -C Antiparallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif -C A2 kernel(j-1)T A1T - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j), - & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j), - & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A2T kernel(i+1)T A1 - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2)) - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. - & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - endif - return - end -C--------------------------------------------------------------------------- - subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp, - & KK,KKderg,AKA,AKAderg,AKAderx) - implicit none - integer nderg - logical transp - double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5), - & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2), - & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2) - integer iii,kkk,lll - integer jjj,mmm - logical lprn - common /kutas/ lprn - call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1)) - do iii=1,nderg - call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp, - & AKAderg(1,1,iii)) - enddo -cd if (lprn) write (2,*) 'In kernel' - do kkk=1,5 -cd if (lprn) write (2,*) 'kkk=',kkk - do lll=1,3 - call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,1)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=1' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2) -cd enddo -cd endif - call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,2)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=2' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2) -cd enddo -cd endif - enddo - enddo - return - end -C--------------------------------------------------------------------------- - double precision function eello4(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then -cd eello4=0.0d0 -cd return -cd endif -cd print *,'eello4:',i,j,k,l,jj,kk -cd write (2,*) 'i',i,' j',j,' k',k,' l',l -cd call checkint4(i,j,k,l,jj,kk,eel4_num) -cold eij=facont_hb(jj,i) -cold ekl=facont_hb(kk,k) -cold ekont=eij*ekl - eel4=-EAEA(1,1,1)-EAEA(2,2,1) -cd eel41=-EAEA(1,1,2)-EAEA(2,2,2) - gcorr_loc(k-1)=gcorr_loc(k-1) - & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1)) - if (l.eq.j+1) then - gcorr_loc(l-1)=gcorr_loc(l-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - else - gcorr_loc(j-1)=gcorr_loc(j-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) - & -EAEAderx(2,2,lll,kkk,iii,1) -cd derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd gcorr_loc(l-1)=0.0d0 -cd gcorr_loc(j-1)=0.0d0 -cd gcorr_loc(k-1)=0.0d0 -cd eel4=1.0d0 -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l, -cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel4*g_contij(ll,1) -cgrad ggg2(ll)=eel4*g_contij(ll,2) - glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1) - glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2) -cgrad ghalf=0.5d0*ggg1(ll) - gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1) - gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1) - gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1) - gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij -cgrad ghalf=0.5d0*ggg2(ll) - gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2) - gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2) - gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2) - gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl - enddo -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,gcorr_loc(iii) -cd enddo - eello4=ekont*eel4 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello4',ekont*eel4 - return - end -C--------------------------------------------------------------------------- - double precision function eello5(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2) - double precision ggg1(3),ggg2(3) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel chains C -C C -C o o o o C -C /l\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j| o |l1 | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C Antiparallel chains C -C C -C o o o o C -C /j\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j1| o |l | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C o denotes a local interaction, vertical lines an electrostatic interaction. C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then -cd eello5=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO5: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - itk=itortyp(itype(k)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - eello5_1=0.0d0 - eello5_2=0.0d0 - eello5_3=0.0d0 - eello5_4=0.0d0 -cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num, -cd & eel5_3_num,eel5_4_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l -cd goto 1111 -C Contribution from the graph I. -cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1) -cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) -C Explicit gradient in virtual-dihedral angles. - if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,i))) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - if (l.eq.j+1) then - if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - else - if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) - enddo - enddo - enddo -c goto 1112 -c1111 continue -C Contribution from graph II - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - if (l.eq.j+1) then - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - else - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) - enddo - enddo - enddo -cd goto 1112 -cd1111 continue - if (l.eq.j+1) then -cd goto 1110 -C Parallel orientation -C Contribution from graph III - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,j))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) - call transpose2(EUgder(1,1,l),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -cd1110 continue - call transpose2(EE(1,1,itl),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) - enddo - enddo - enddo - else -C Antiparallel orientation -C Contribution from graph III -c goto 1110 - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,l))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) - call transpose2(EUgder(1,1,j),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -1110 continue - call transpose2(EE(1,1,itj),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) - enddo - enddo - enddo - endif -1112 continue - eel5=eello5_1+eello5_2+eello5_3+eello5_4 -cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then -cd write (2,*) 'ijkl',i,j,k,l -cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2, -cd & ' eello5_3',eello5_3,' eello5_4',eello5_4 -cd endif -cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num -cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num -cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num -cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 -cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont -C 2/11/08 AL Gradients over DC's connecting interacting sites will be -C summed up outside the subrouine as for the other subroutines -C handling long-range interactions. The old code is commented out -C with "cgrad" to keep track of changes. - do ll=1,3 -cgrad ggg1(ll)=eel5*g_contij(ll,1) -cgrad ggg2(ll)=eel5*g_contij(ll,2) - gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2) -c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)') -c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1), -c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2), -c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont -c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)') -c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1), -c & gradcorr5ij, -c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl -cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1) - gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1) - gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1) - gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1) - gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij - gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij -cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k) -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2) - gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2) - gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2) - gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2) - gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl - gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -c1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr5_loc(iii) -cd enddo - eello5=ekont*eel5 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello5',ekont*eel5 - return - end -c-------------------------------------------------------------------------- - double precision function eello6(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - eello6_1=0.0d0 - eello6_2=0.0d0 - eello6_3=0.0d0 - eello6_4=0.0d0 - eello6_5=0.0d0 - eello6_6=0.0d0 -cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num, -cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - if (l.eq.j+1) then - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(j,i,l,k,2,.false.) - eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.) - eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.) - else - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(l,k,j,i,2,.true.) - eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - if (wturn6.eq.0.0d0 .or. j.ne.i+4) then - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) - else - eello6_5=0.0d0 - endif - eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.) - endif -C If turn contributions are considered, they will be handled separately. - eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6 -cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num -cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num -cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num -cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num -cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num -cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel6*g_contij(ll,1) -cgrad ggg2(ll)=eel6*g_contij(ll,2) -cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2) - gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1) - gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1) - gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1) - gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1) - gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij - gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij -cgrad ghalf=0.5d0*ggg2(ll) -cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k) -cd ghalf=0.0d0 - gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2) - gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2) - gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2) - gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2) - gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl - gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello6=ekont*eel6 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello6',ekont*eel6 - return - end -c-------------------------------------------------------------------------- - double precision function eello6_graph1(i,j,k,l,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2) - logical swap - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C /l\ /j\ -C / \ / \ -C /| o | | o |\ -C \ j|/k\| / \ |/k\|l / -C \ / \ / \ / \ / -C o o o o -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - itk=itortyp(itype(k)) - s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk) - vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk) - s5=scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 - eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5) - if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) - & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) - & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) - & +scalar2(vv(1),Dtobr2der(1,i))) - call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk) - vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk) - if (l.eq.j+1) then - g_corr6_loc(l-1)=g_corr6_loc(l-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - endif - call transpose2(EUgCder(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) - & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) - & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i)))) - do iii=1,2 - if (swap) then - ind=3-iii - else - ind=iii - endif - do kkk=1,5 - do lll=1,3 - s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) - & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk) - vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) - & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk) - s5=scalar2(vv(1),Dtobr2(1,i)) - derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5) - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph2(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - logical swap - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(1),auxmat1(2,2) - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C \ /l\ /j\ / -C \ / \ / \ / -C o| o | | o |o -C \ j|/k\| \ |/k\|l -C \ / \ \ / \ -C o o -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l -C AL 7/4/01 s1 would occur in the sixth-order moment, -C but not in a cluster cumulant -#ifdef MOMENT - s1=dip(1,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph2=-(s1+s2+s3+s4) -#else - eello6_graph2=-(s2+s3+s4) -#endif -c eello6_graph2=-s3 -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - s1=dipderg(1,jj,i)*dip(1,kk,k) -#endif - s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i)) -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3 - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3 -C Derivatives in gamma(j-1) or gamma(l-1) - if (j.gt.1) then -#ifdef MOMENT - s1=dipderg(3,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1)) - call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - endif -#endif - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4) -c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3 - endif -C Derivatives in gamma(l-1) or gamma(j-1) - if (l.gt.1) then -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(3,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - else - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - endif -#endif - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4) -c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3 - endif -C Cartesian derivatives. - if (lprn) then - write (2,*) 'In eello6_graph2' - do iii=1,2 - write (2,*) 'iii=',iii - do kkk=1,5 - write (2,*) 'kkk=',kkk - do jjj=1,2 - write (2,'(3(2f10.5),5x)') - & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) - enddo - enddo - enddo - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k) - else - s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k) - endif -#endif - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k), - & auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l), - & auxvec(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph3(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C /l\ / \ /j\ -C / \ / \ / \ -C /| o |o o| o |\ -C j|/k\| / |/k\|l / -C / \ / / \ / -C / o / o -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. - iti=itortyp(itype(i)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -#ifdef MOMENT - s1=dip(4,jj,i)*dip(4,kk,k) -#endif - call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4, -cd & "sum",-(s2+s3+s4) -#ifdef MOMENT - eello6_graph3=-(s1+s2+s3+s4) -#else - eello6_graph3=-(s2+s3+s4) -#endif -c eello6_graph3=-s4 -C Derivatives in gamma(k-1) - call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k)) - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4) -C Derivatives in gamma(l-1) - call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k) - else - s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k) - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1), - & auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif -c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4 - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxmat1(2,2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C /l\ / \ /j\ -C / \ / \ / \ -C /| o |o o| o |\ -C \ j|/k\| \ |/k\|l -C \ / \ \ / \ -C o \ o \ -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. -cd write (2,*) 'eello_graph4: wturn6',wturn6 - iti=itortyp(itype(i)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - if (k.lt.nres-1) then - itk1=itortyp(itype(k+1)) - else - itk1=ntortyp+1 - endif - itl=itortyp(itype(l)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l -cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk, -cd & ' itl',itl,' itl1',itl1 -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dip(3,kk,k) - else - s1=dip(2,jj,j)*dip(2,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph4=-(s1+s2+s3+s4) -#else - eello6_graph4=-(s2+s3+s4) -#endif -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - if (imat.eq.1) then - s1=dipderg(2,jj,i)*dip(3,kk,k) - else - s1=dipderg(4,jj,j)*dip(2,kk,l) - endif -#endif - s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -cd write (2,*) 'turn6 derivatives' -#ifdef MOMENT - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif - endif - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderg(2,kk,k) - else - s1=dip(2,jj,j)*dipderg(4,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif - endif -C Derivatives in gamma(j-1) or gamma(l-1) - if (l.eq.j+1 .and. l.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) - else if (j.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then - gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4) - endif - endif -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - if (imat.eq.1) then - s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k) - else - s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l) - endif - else - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k) - else - s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l) - endif - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k), - & auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itj1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec(1)) - else - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itl1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec(1)) - endif - call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (swap) then - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s1+s2+s4) -#else - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s2+s4) -#endif - derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3 - else -#ifdef MOMENT - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4) -#else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4) -#endif - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - else -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (l.eq.j+1) then - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - endif - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello_turn6(i,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2), - & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2), - & ggg1(3),ggg2(3) - double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2), - & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2) -C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to -C the respective energy moment and not to the cluster cumulant. - s1=0.0d0 - s8=0.0d0 - s13=0.0d0 -c - eello_turn6=0.0d0 - j=i+4 - k=i+1 - l=i+3 - iti=itortyp(itype(i)) - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) -cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj -cd write (2,*) 'i',i,' k',k,' j',j,' l',l -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l -cd call checkint_turn6(i,jj,kk,eel_turn6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx_turn(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) -cd eello6_5=0.0d0 -cd write (2,*) 'eello6_5',eello6_5 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1)) - ss1=scalar2(Ub2(1,i+2),b1(1,itl)) - s1 = (auxmat(1,1)+auxmat(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) - call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1)) - s2 = scalar2(b1(1,itk),vtemp1(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atemp(1,1)) - call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1)) - call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1)) - s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1)) - s12 = scalar2(Ub2(1,i+2),vtemp3(1)) -#ifdef MOMENT - call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1)) - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1)) - call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) - call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) - ss13 = scalar2(b1(1,itk),vtemp4(1)) - s13 = (gtemp(1,1)+gtemp(2,2))*ss13 -#endif -c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13 -c s1=0.0d0 -c s2=0.0d0 -c s8=0.0d0 -c s12=0.0d0 -c s13=0.0d0 - eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13) -C Derivatives in gamma(i+2) - s1d =0.0d0 - s8d =0.0d0 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 - call transpose2(AEAderg(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 - gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d) -C Derivatives in gamma(i+3) -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - ss1d=scalar2(Ub2der(1,i+2),b1(1,itl)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d -#endif - call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1)) - call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1)) - s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1)) -#endif - s12d = scalar2(Ub2der(1,i+2),vtemp3(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Derivatives in gamma(i+4) - call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -C s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d) -#else - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d) -#endif -C Derivatives in gamma(i+5) -#ifdef MOMENT - call transpose2(AEAderg(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1)) - call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Cartesian derivatives - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1), - & vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))* - & scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2), - & auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*(s1d+s2d) -#else - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*s2d -#endif -#ifdef MOMENT - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*(s8d+s12d) -#else - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*s12d -#endif - enddo - enddo - enddo -#ifdef MOMENT - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1), - & achuj_tempd(1,1)) - call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d=(gtempd(1,1)+gtempd(2,2))*ss13 - derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4), - & vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d - derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d - enddo - enddo -#endif -cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num', -cd & 16*eel_turn6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel_turn6*g_contij(ll,1) -cgrad ggg2(ll)=eel_turn6*g_contij(ll,2) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1) - gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2) - gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf - & +ekont*derx_turn(ll,2,1) - gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1) - gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf - & +ekont*derx_turn(ll,4,1) - gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1) - gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij - gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf - & +ekont*derx_turn(ll,2,2) - gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2) - gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf - & +ekont*derx_turn(ll,4,2) - gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2) - gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl - gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello_turn6=ekont*eel_turn6 -cd write (2,*) 'ekont',ekont -cd write (2,*) 'eel_turn6',ekont*eel_turn6 - return - end - -C----------------------------------------------------------------------------- - double precision function scalar(u,v) -!DIR$ INLINEALWAYS scalar -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::scalar -#endif - implicit none - double precision u(3),v(3) -cd double precision sc -cd integer i -cd sc=0.0d0 -cd do i=1,3 -cd sc=sc+u(i)*v(i) -cd enddo -cd scalar=sc - - scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3) - return - end -crc------------------------------------------------- - SUBROUTINE MATVEC2(A1,V1,V2) -!DIR$ INLINEALWAYS MATVEC2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),V1(2),V2(2) -c DO 1 I=1,2 -c VI=0.0 -c DO 3 K=1,2 -c 3 VI=VI+A1(I,K)*V1(K) -c Vaux(I)=VI -c 1 CONTINUE - - vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2) - vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2) - - v2(1)=vaux1 - v2(2)=vaux2 - END -C--------------------------------------- - SUBROUTINE MATMAT2(A1,A2,A3) -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),A2(2,2),A3(2,2) -c DIMENSION AI3(2,2) -c DO J=1,2 -c A3IJ=0.0 -c DO K=1,2 -c A3IJ=A3IJ+A1(I,K)*A2(K,J) -c enddo -c A3(I,J)=A3IJ -c enddo -c enddo - - ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1) - ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2) - ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1) - ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2) - - A3(1,1)=AI3_11 - A3(2,1)=AI3_21 - A3(1,2)=AI3_12 - A3(2,2)=AI3_22 - END - -c------------------------------------------------------------------------- - double precision function scalar2(u,v) -!DIR$ INLINEALWAYS scalar2 - implicit none - double precision u(2),v(2) - double precision sc - integer i - scalar2=u(1)*v(1)+u(2)*v(2) - return - end - -C----------------------------------------------------------------------------- - - subroutine transpose2(a,at) -!DIR$ INLINEALWAYS transpose2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::transpose2 -#endif - implicit none - double precision a(2,2),at(2,2) - at(1,1)=a(1,1) - at(1,2)=a(2,1) - at(2,1)=a(1,2) - at(2,2)=a(2,2) - return - end -c-------------------------------------------------------------------------- - subroutine transpose(n,a,at) - implicit none - integer n,i,j - double precision a(n,n),at(n,n) - do i=1,n - do j=1,n - at(j,i)=a(i,j) - enddo - enddo - return - end -C--------------------------------------------------------------------------- - subroutine prodmat3(a1,a2,kk,transp,prod) -!DIR$ INLINEALWAYS prodmat3 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::prodmat3 -#endif - implicit none - integer i,j - double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2) - logical transp -crc double precision auxmat(2,2),prod_(2,2) - - if (transp) then -crc call transpose2(kk(1,1),auxmat(1,1)) -crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2) - - else -crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2) - - endif -c call transpose2(a2(1,1),a2t(1,1)) - -crc print *,transp -crc print *,((prod_(i,j),i=1,2),j=1,2) -crc print *,((prod(i,j),i=1,2),j=1,2) - - return - end - diff --git a/source/unres/src_MD/energy_split-sep.F.org b/source/unres/src_MD/energy_split-sep.F.org deleted file mode 100644 index 24ab8dd..0000000 --- a/source/unres/src_MD/energy_split-sep.F.org +++ /dev/null @@ -1,472 +0,0 @@ - subroutine etotal_long(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c -c Compute the long-range slow-varying contributions to the energy -c -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.MD' -c write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot - if (modecalc.eq.12.or.modecalc.eq.14) then -#ifdef MPI -c if (fg_rank.eq.0) call int_from_cart1(.false.) -#else - call int_from_cart1(.false.) -#endif - endif -#ifdef MPI -c write(iout,*) "ETOTAL_LONG Processor",fg_rank, -c & " absolute rank",myrank," nfgtasks",nfgtasks - call flush(iout) - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR) -c write (iout,*) "Processor",myrank," BROADCAST iorder" -c call flush(iout) -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - endif - call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 - time_Bcastw=time_Bcastw+MPI_Wtime()-time00 -c call chainbuild_cart -c call int_from_cart1(.false.) - endif -c write (iout,*) 'Processor',myrank, -c & ' calling etotal_short ipot=',ipot -c call flush(iout) -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#endif -cd print *,'nnt=',nnt,' nct=',nct -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj_long(evdw) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk_long(evdw) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp_long(evdw) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb_long(evdw) - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv_long(evdw) - goto 107 -C Soft-sphere potential - 106 call e_softsphere(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue - call vec_and_deriv - if (ipot.lt.6) then -#ifdef SPLITELE - if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#else - if (welec.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#endif - call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4) - else - ees=0 - evdw1=0 - eel_loc=0 - eello_turn3=0 - eello_turn4=0 - endif - else -c write (iout,*) "Soft-spheer ELEC potential" - call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) - endif -C -C Calculate excluded-volume interaction energy between peptide groups -C and side chains. -C - if (ipot.lt.6) then - if(wscp.gt.0d0) then - call escp_long(evdw2,evdw2_14) - else - evdw2=0 - evdw2_14=0 - endif - else - call escp_soft_sphere(evdw2,evdw2_14) - endif -C -C 12/1/95 Multi-body terms -C - n_corr=0 - n_corr1=0 - if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 - & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then - call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1, -c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 - else - ecorr=0.0d0 - ecorr5=0.0d0 - ecorr6=0.0d0 - eturn6=0.0d0 - 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) - endif -C -C If performing constraint dynamics, call the constraint energy -C after the equilibration time - if(usampl.and.totT.gt.eq_time) then - call EconstrQ - call Econstr_back - else - Uconst=0.0d0 - Uconst_back=0.0d0 - endif -C -C Sum the energies -C - do i=1,n_ene - energia(i)=0.0d0 - enddo - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(3)=ees - energia(16)=evdw1 -#else - energia(3)=ees+evdw1 - energia(16)=0.0d0 -#endif - energia(4)=ecorr - energia(5)=ecorr5 - energia(6)=ecorr6 - energia(7)=eel_loc - energia(8)=eello_turn3 - energia(9)=eello_turn4 - energia(10)=eturn6 - energia(20)=Uconst+Uconst_back - call sum_energy(energia,.true.) -c write (iout,*) "Exit ETOTAL_LONG" - call flush(iout) - return - end -c------------------------------------------------------------------------------ - subroutine etotal_short(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c -c Compute the short-range fast-varying contributions to the energy -c -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - -c write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot -c call flush(iout) - if (modecalc.eq.12.or.modecalc.eq.14) then -#ifdef MPI - if (fg_rank.eq.0) call int_from_cart1(.false.) -#else - call int_from_cart1(.false.) -#endif - endif -#ifdef MPI -c write(iout,*) "ETOTAL_SHORT Processor",fg_rank, -c & " absolute rank",myrank," nfgtasks",nfgtasks -c call flush(iout) - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR) -c write (iout,*) "Processor",myrank," BROADCAST iorder" -c call flush(iout) -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - endif -c write (iout,*),"Processor",myrank," BROADCAST weights" - call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST c" - call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST dc" - call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST dc_norm" - call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST theta" - call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST phi" - call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST alph" - call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST omeg" - call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST vbld" - call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 -c write (iout,*) "Processor",myrank," BROADCAST vbld_inv" - endif -c write (iout,*) 'Processor',myrank, -c & ' calling etotal_short ipot=',ipot -c call flush(iout) -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#endif -c call int_from_cart1(.false.) -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj_short(evdw) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk_short(evdw) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp_short(evdw) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb_short(evdw) - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv_short(evdw) - goto 107 -C Soft-sphere potential - already dealt with in the long-range part - 106 evdw=0.0d0 -c 106 call e_softsphere_short(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue -c -c Calculate the short-range part of Evdwpp -c - call evdwpp_short(evdw1) -c -c Calculate the short-range part of ESCp -c - if (ipot.lt.6) then - call escp_short(evdw2,evdw2_14) - endif -c -c Calculate the bond-stretching energy -c - call ebond(estr) -C -C Calculate the disulfide-bridge and other energy and the contributions -C from other distance constraints. - call edis(ehpb) -C -C Calculate the virtual-bond-angle energy. -C - call ebend(ebe) -C -C Calculate the SC local energy. -C - call vec_and_deriv - call esc(escloc) -C -C Calculate the virtual-bond torsional energy. -C - call etor(etors,edihcnstr) -C -C 6/23/01 Calculate double-torsional energy -C - call etor_d(etors_d) -C -C 21/5/07 Calculate local sicdechain correlation energy -C - if (wsccor.gt.0.0d0) then - call eback_sc_corr(esccor) - else - esccor=0.0d0 - endif -C -C Put energy components into an array -C - do i=1,n_ene - energia(i)=0.0d0 - enddo - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(16)=evdw1 -#else - energia(3)=evdw1 -#endif - energia(11)=ebe - energia(12)=escloc - energia(13)=etors - energia(14)=etors_d - energia(15)=ehpb - energia(17)=estr - energia(19)=edihcnstr - energia(21)=esccor -c write (iout,*) "ETOTAL_SHORT before SUM_ENERGY" - call flush(iout) - call sum_energy(energia,.true.) -c write (iout,*) "Exit ETOTAL_SHORT" - call flush(iout) - return - end diff --git a/source/unres/src_MD/geomout.F b/source/unres/src_MD/geomout.F index 460b7be..69d7802 100644 --- a/source/unres/src_MD/geomout.F +++ b/source/unres/src_MD/geomout.F @@ -406,16 +406,30 @@ c----------------------------------------------------------------- #endif if (refstr) then call rms_nac_nnc(rms,frac,frac_nn,co,.false.) + if(tnp .or. tnp1 .or. tnh) then + write (line1,'(i10,f15.2,3f12.3,f12.6,f7.2,4f6.3,3f12.3,i5,$)') + & itime,totT,EK,potE,totE,hhh, + & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me + format1="a145" + else write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)') & itime,totT,EK,potE,totE, & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me format1="a133" + endif + else + if(tnp .or. tnp1 .or. tnh) then + write (line1,'(i10,f15.2,7f12.3,f12.6,i5,$)') + & itime,totT,EK,potE,totE,hhh, + & amax,kinetic_T,t_bath,gyrate(),me + format1="a126" else write (line1,'(i10,f15.2,7f12.3,i5,$)') & itime,totT,EK,potE,totE, & amax,kinetic_T,t_bath,gyrate(),me format1="a114" endif + endif if(usampl.and.totT.gt.eq_time) then write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back, & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair), diff --git a/source/unres/src_MD/indexx.f b/source/unres/src_MD/indexx.f deleted file mode 100644 index b903862..0000000 --- a/source/unres/src_MD/indexx.f +++ /dev/null @@ -1,81 +0,0 @@ - SUBROUTINE indexx(n,arr,indx) - implicit real*8 (a-h,o-z) - INTEGER n,indx(n),M,NSTACK - REAL*8 arr(n) -c PARAMETER (M=7,NSTACK=50) - PARAMETER (M=7,NSTACK=500) - INTEGER i,indxt,ir,itemp,j,jstack,k,l,istack(NSTACK) - REAL*8 a - do 11 j=1,n - indx(j)=j -11 continue - jstack=0 - l=1 - ir=n -1 if(ir-l.lt.M)then - do 13 j=l+1,ir - indxt=indx(j) - a=arr(indxt) - do 12 i=j-1,1,-1 - if(arr(indx(i)).le.a)goto 2 - indx(i+1)=indx(i) -12 continue - i=0 -2 indx(i+1)=indxt -13 continue - if(jstack.eq.0)return - ir=istack(jstack) - l=istack(jstack-1) - jstack=jstack-2 - else - k=(l+ir)/2 - itemp=indx(k) - indx(k)=indx(l+1) - indx(l+1)=itemp - if(arr(indx(l+1)).gt.arr(indx(ir)))then - itemp=indx(l+1) - indx(l+1)=indx(ir) - indx(ir)=itemp - endif - if(arr(indx(l)).gt.arr(indx(ir)))then - itemp=indx(l) - indx(l)=indx(ir) - indx(ir)=itemp - endif - if(arr(indx(l+1)).gt.arr(indx(l)))then - itemp=indx(l+1) - indx(l+1)=indx(l) - indx(l)=itemp - endif - i=l+1 - j=ir - indxt=indx(l) - a=arr(indxt) -3 continue - i=i+1 - if(arr(indx(i)).lt.a)goto 3 -4 continue - j=j-1 - if(arr(indx(j)).gt.a)goto 4 - if(j.lt.i)goto 5 - itemp=indx(i) - indx(i)=indx(j) - indx(j)=itemp - goto 3 -5 indx(l)=indx(j) - indx(j)=indxt - jstack=jstack+2 - if(jstack.gt.NSTACK)pause 'NSTACK too small in indexx' - if(ir-i+1.ge.j-l)then - istack(jstack)=ir - istack(jstack-1)=i - ir=j-1 - else - istack(jstack)=j-1 - istack(jstack-1)=l - l=i - endif - endif - goto 1 - END -C (C) Copr. 1986-92 Numerical Recipes Software *11915aZ%. diff --git a/source/unres/src_MD/initialize_p.F b/source/unres/src_MD/initialize_p.F index a055c1d..75c98de 100644 --- a/source/unres/src_MD/initialize_p.F +++ b/source/unres/src_MD/initialize_p.F @@ -81,7 +81,9 @@ C igeom= 8 intin= 9 ithep= 11 + ithep_pdb=51 irotam=12 + irotam_pdb=52 itorp= 13 itordp= 23 ielep= 14 diff --git a/source/unres/src_MD/minim_jlee.F b/source/unres/src_MD/minim_jlee.F deleted file mode 100644 index 21a3b97..0000000 --- a/source/unres/src_MD/minim_jlee.F +++ /dev/null @@ -1,436 +0,0 @@ -#ifdef MPI - subroutine minim_jlee -c controls minimization and sorting routines - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MINIM' - include 'COMMON.CONTROL' - include 'mpif.h' - external func,gradient,fdum - real ran1,ran2,ran3 - include 'COMMON.SETUP' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.CHAIN' - dimension muster(mpi_status_size) - dimension var(maxvar),erg(mxch*(mxch+1)/2+1) - dimension var2(maxvar) - integer iffr(maxres),ihpbt(maxdim),jhpbt(maxdim) - double precision d(maxvar),v(1:lv+1),garbage(maxvar) - double precision energia(0:n_ene),time0s,time1s - dimension indx(9),info(12) - dimension iv(liv) - dimension idum(1),rdum(1) - dimension icont(2,maxcont) - logical check_var,fail - integer iloop(2) - common /przechowalnia/ v - data rad /1.745329252d-2/ -c receive # of start -! print *,'Processor',me,' calling MINIM_JLEE maxfun',maxfun, -! & ' maxmin',maxmin,' tolf',tolf,' rtolf',rtolf - nhpb0=nhpb - 10 continue - time0s=MPI_WTIME() -c print *, 'MINIM_JLEE: ',me,' is waiting' - call mpi_recv(info,12,mpi_integer,king,idint,CG_COMM, - * muster,ierr) - time1s=MPI_WTIME() - write (iout,'(a12,f10.4,a4)')'Waiting for ',time1s-time0s,' sec' - call flush(iout) - n=info(1) -c print *, 'MINIM_JLEE: ',me,' received: ',n - -crc if (ierr.ne.0) go to 100 -c if # = 0, return - if (n.eq.0) then - write (iout,*) 'Finishing minim_jlee - signal',n,' from master' - call flush(iout) - return - endif - - nfun=0 - IF (n.lt.0) THEN - call mpi_recv(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) - call mpi_recv(iffr,nres,mpi_integer, - * king,idint,CG_COMM,muster,ierr) - call mpi_recv(var2,nvar,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) - ELSE -c receive initial values of variables - call mpi_recv(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) -crc if (ierr.ne.0) go to 100 - ENDIF - - if(vdisulf.and.info(2).ne.-1) then - if(info(4).ne.0)then - call mpi_recv(ihpbt,info(4),mpi_integer, - * king,idint,CG_COMM,muster,ierr) - call mpi_recv(jhpbt,info(4),mpi_integer, - * king,idint,CG_COMM,muster,ierr) - endif - endif - - IF (n.lt.0) THEN - n=-n - nhpb=nhpb0 - link_start=1 - link_end=nhpb - call init_int_table - call contact_cp(var,var2,iffr,nfun,n) - ENDIF - - if(vdisulf.and.info(2).ne.-1) then - nss=0 - if(info(4).ne.0)then -cd write(iout,*) 'SS=',info(4),'N=',info(1),'IT=',info(2) - call var_to_geom(nvar,var) - call chainbuild - do i=1,info(4) - if (dist(ihpbt(i),jhpbt(i)).lt.7.0) then - nss=nss+1 - ihpb(nss)=ihpbt(i) - jhpb(nss)=jhpbt(i) -cd write(iout,*) 'SS mv=',info(3), -cd & ihpb(nss)-nres,jhpb(nss)-nres, -cd & dist(ihpb(nss),jhpb(nss)) - dhpb(nss)=dbr - forcon(nss)=fbr - else -cd write(iout,*) 'rm SS mv=',info(3), -cd & ihpbt(i)-nres,jhpbt(i)-nres,dist(ihpbt(i),jhpbt(i)) - endif - enddo - endif - nhpb=nss - link_start=1 - link_end=nhpb - call init_int_table - endif - - if (info(3).eq.14) then - write(iout,*) 'calling local_move',info(7),info(8) - call local_move_init(.false.) - call var_to_geom(nvar,var) - call local_move(info(7),info(8),20d0,50d0) - call geom_to_var(nvar,var) - endif - - - if (info(3).eq.16) then - write(iout,*) 'calling beta_slide',info(7),info(8), - & info(10), info(11), info(12) - call var_to_geom(nvar,var) - call beta_slide(info(7),info(8),info(10),info(11),info(12) - & ,nfun,n) - call geom_to_var(nvar,var) - endif - - - if (info(3).eq.17) then - write(iout,*) 'calling beta_zip',info(7),info(8) - call var_to_geom(nvar,var) - call beta_zip(info(7),info(8),nfun,n) - call geom_to_var(nvar,var) - endif - - -crc overlap test - - if (overlapsc) then - - call var_to_geom(nvar,var) - call chainbuild - call etotal(energia(0)) - nfun=nfun+1 - if (energia(1).eq.1.0d20) then - info(3)=-info(3) - write (iout,'(a,1pe14.5)')'#OVERLAP evdw=1d20',energia(1) - call overlap_sc(fail) - if(.not.fail) then - call geom_to_var(nvar,var) - call etotal(energia(0)) - nfun=nfun+1 - write (iout,'(a,1pe14.5)')'#OVERLAP evdw after',energia(1) - else - v(10)=1.0d20 - iv(1)=-1 - goto 201 - endif - endif - endif - - if (searchsc) then - call var_to_geom(nvar,var) - call sc_move(2,nres-1,1,10d0,nft_sc,etot) - call geom_to_var(nvar,var) -cd write(iout,*) 'sc_move',nft_sc,etot - endif - - if (check_var(var,info)) then - v(10)=1.0d21 - iv(1)=6 - goto 201 - endif - - -crc - -! write (iout,*) 'MINIM_JLEE: Processor',me,' nvar',nvar -! write (iout,'(8f10.4)') (var(i),i=1,nvar) -! write (*,*) 'MINIM_JLEE: Processor',me,' received nvar',nvar -! write (*,'(8f10.4)') (var(i),i=1,nvar) - - do i=1,nvar - garbage(i)=var(i) - enddo - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit -cd iv(21)=iout - iv(21)=0 -* 1 means to print out result - iv(22)=0 -cd iv(22)=1 -* 1 means to print out summary stats - iv(23)=0 -* 1 means to print initial x and d - iv(24)=0 - -c if(me.eq.3.and.n.eq.255) then -c print *,' CHUJ: stoi' -c iv(21)=6 -c iv(22)=1 -c iv(23)=1 -c iv(24)=1 -c endif - -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo -c minimize energy -! write (iout,*) 'Processor',me,' nvar',nvar -! write (iout,*) 'Variables BEFORE minimization:' -! write (iout,'(8f10.4)') (rad2deg*var(i),i=1,nvar) - -c print *, 'MINIM_JLEE: ',me,' before SUMSL ' - - call func(nvar,var,nf,eee,idum,rdum,fdum) - nfun=nfun+1 - if(eee.ge.1.0d20) then -c print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL' -c print *,' energy before SUMSL =',eee -c print *,' aborting local minimization' - iv(1)=-1 - v(10)=eee - go to 201 - endif - -ct time0s=MPI_WTIME() - call sumsl(nvar,d,var,func,gradient,iv,liv,lv,v,idum,rdum,fdum) -ct write(iout,*) 'sumsl time=',MPI_WTIME()-time0s,iv(7),v(10) -c print *, 'MINIM_JLEE: ',me,' after SUMSL ' - -c find which conformation was returned from sumsl - nfun=nfun+iv(7) -! print *,'Processor',me,' iv(17)',iv(17),' iv(18)',iv(18),' nf',nf, -! & ' retcode',iv(1),' energy',v(10),' tolf',v(31),' rtolf',v(32) -c if (iv(1).ne.4 .or. nf.le.1) then -c write (*,*) 'Processor',me,' something bad in SUMSL',iv(1),nf -c write (*,*) 'Initial Variables' -c write (*,'(8f10.4)') (rad2deg*garbage(i),i=1,nvar) -c write (*,*) 'Variables' -c write (*,'(8f10.4)') (rad2deg*var(i),i=1,nvar) -c write (*,*) 'Vector d' -c write (*,'(8f10.4)') (d(i),i=1,nvar) -c write (iout,*) 'Processor',me,' something bad in SUMSL', -c & iv(1),nf -c write (iout,*) 'Initial Variables' -c write (iout,'(8f10.4)') (rad2deg*garbage(i),i=1,nvar) -c write (iout,*) 'Variables' -c write (iout,'(8f10.4)') (rad2deg*var(i),i=1,nvar) -c write (iout,*) 'Vector d' -c write (iout,'(8f10.4)') (d(i),i=1,nvar) -c endif -c if (nf.lt.iv(6)-1) then -c recalculate intra- and interchain energies -c call func(nvar,var,nf,v(10),iv,v,fdum) -c else if (nf.eq.iv(6)-1) then -c regenerate conformation -c call var_to_geom(nvar,var) -c call chainbuild -c endif -c change origin and axes to standard ECEPP format -c call var_to_geom(nvar,var) -! write (iout,*) 'MINIM_JLEE after minim: Processor',me,' nvar',nvar -! write (iout,'(8f10.4)') (var(i),i=1,nvar) -! write (iout,*) 'Energy:',v(10) -c send back output -c print *, 'MINIM_JLEE: ',me,' minimized: ',n - 201 continue - indx(1)=n -c return code: 6-gradient 9-number of ftn evaluation, etc - indx(2)=iv(1) -c total # of ftn evaluations (for iwf=0, it includes all minimizations). - indx(3)=nfun - indx(4)=info(2) - indx(5)=info(3) - indx(6)=nss - indx(7)=info(5) - indx(8)=info(6) - indx(9)=info(9) - call mpi_send(indx,9,mpi_integer,king,idint,CG_COMM, - * ierr) -c send back energies -c al & cc -c calculate contact order -#ifdef CO_BIAS - call contact(.false.,ncont,icont,co) - erg(1)=v(10)-1.0d2*co -#else - erg(1)=v(10) -#endif - j=1 - call mpi_send(erg,j,mpi_double_precision,king,idreal, - * CG_COMM,ierr) -#ifdef CO_BIAS - call mpi_send(co,j,mpi_double_precision,king,idreal, - * CG_COMM,ierr) -#endif -c send back values of variables - call mpi_send(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,ierr) -! print * , 'MINIM_JLEE: Processor',me,' send erg and var ' - - if(vdisulf.and.info(2).ne.-1.and.nss.ne.0) then -cd call intout -cd call chainbuild -cd call etotal(energia(0)) -cd etot=energia(0) -cd call enerprint(energia(0)) - call mpi_send(ihpb,nss,mpi_integer, - * king,idint,CG_COMM,ierr) - call mpi_send(jhpb,nss,mpi_integer, - * king,idint,CG_COMM,ierr) - endif - - go to 10 - 100 print *, ' error in receiving message from emperor', me - call mpi_abort(mpi_comm_world,ierror,ierrcode) - return - 200 print *, ' error in sending message to emperor' - call mpi_abort(mpi_comm_world,ierror,ierrcode) - return - 300 print *, ' error in communicating with emperor' - call mpi_abort(mpi_comm_world,ierror,ierrcode) - return - 956 format (' initial energy could not be calculated',41x) - 957 format (80x) - 965 format (' convergence code ',i2,' # of function calls ', - * i4,' # of gradient calls ',i4,10x) - 975 format (' energy ',1p,e12.4,' scaled gradient ',e11.3,32x) - end -#endif - logical function check_var(var,info) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.SETUP' - dimension var(maxvar) - dimension info(3) -C AL ------- - check_var=.false. - do i=nphi+ntheta+1,nphi+ntheta+nside -! Check the side chain "valence" angles alpha - if (var(i).lt.1.0d-7) then - write (iout,*) 'CHUJ NASTAPIL ABSOLUTNY!!!!!!!!!!!!' - write (iout,*) 'Processor',me,'received bad variables!!!!' - write (iout,*) 'Variables' - write (iout,'(8f10.4)') (rad2deg*var(j),j=1,nvar) - write (iout,*) 'Continuing calculations at this point', - & ' could destroy the results obtained so far... ABORTING!!!!!!' - write (iout,'(a19,i5,f10.4,a4,2i4,a3,i3)') - & 'valence angle alpha',i-nphi-ntheta,var(i), - & 'n it',info(1),info(2),'mv ',info(3) - write (*,*) 'CHUJ NASTAPIL ABSOLUTNY!!!!!!!!!!!!' - write (*,*) 'Processor',me,'received bad variables!!!!' - write (*,*) 'Variables' - write (*,'(8f10.4)') (rad2deg*var(j),j=1,nvar) - write (*,*) 'Continuing calculations at this point', - & ' could destroy the results obtained so far... ABORTING!!!!!!' - write (*,'(a19,i5,f10.4,a4,2i4,a3,i3)') - & 'valence angle alpha',i-nphi-ntheta,var(i), - & 'n it',info(1),info(2),'mv ',info(3) - check_var=.true. - return - endif - enddo -! Check the backbone "valence" angles theta - do i=nphi+1,nphi+ntheta - if (var(i).lt.1.0d-7) then - write (iout,*) 'CHUJ NASTAPIL ABSOLUTNY!!!!!!!!!!!!' - write (iout,*) 'Processor',me,'received bad variables!!!!' - write (iout,*) 'Variables' - write (iout,'(8f10.4)') (rad2deg*var(j),j=1,nvar) - write (iout,*) 'Continuing calculations at this point', - & ' could destroy the results obtained so far... ABORTING!!!!!!' - write (iout,'(a19,i5,f10.4,a4,2i4,a3,i3)') - & 'valence angle theta',i-nphi,var(i), - & 'n it',info(1),info(2),'mv ',info(3) - write (*,*) 'CHUJ NASTAPIL ABSOLUTNY!!!!!!!!!!!!' - write (*,*) 'Processor',me,'received bad variables!!!!' - write (*,*) 'Variables' - write (*,'(8f10.4)') (rad2deg*var(j),j=1,nvar) - write (*,*) 'Continuing calculations at this point', - & ' could destroy the results obtained so far... ABORTING!!!!!!' - write (*,'(a19,i5,f10.4,a4,2i4,a3,i3)') - & 'valence angle theta',i-nphi,var(i), - & 'n it',info(1),info(2),'mv ',info(3) - check_var=.true. - return - endif - enddo - return - end diff --git a/source/unres/src_MD/minimize_p.F b/source/unres/src_MD/minimize_p.F index 902dde2..1de3824 100644 --- a/source/unres/src_MD/minimize_p.F +++ b/source/unres/src_MD/minimize_p.F @@ -24,7 +24,7 @@ external func,gradient,fdum external func_restr,grad_restr logical not_done,change,reduce - common /przechowalnia/ v +c common /przechowalnia/ v icall = 1 @@ -416,7 +416,7 @@ c---------------------------------------------------------- include 'COMMON.CHAIN' dimension iv(liv) double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) - common /przechowalnia/ v +c common /przechowalnia/ v double precision energia(0:n_ene) external func_dc,grad_dc,fdum diff --git a/source/unres/src_MD/newconf.F b/source/unres/src_MD/newconf.F deleted file mode 100644 index df93149..0000000 --- a/source/unres/src_MD/newconf.F +++ /dev/null @@ -1,2456 +0,0 @@ -#ifdef MPI -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine make_var(n,idum,iter_csa) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.HAIRPIN' - include 'COMMON.VAR' - include 'COMMON.DISTFIT' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - logical nicht_getan,nicht_getan1,fail,lfound - integer nharp,iharp(4,maxres/3),nconf_harp - integer iisucc(mxio) - logical ifused(mxio) - integer nhx_seed(max_seed),ihx_seed(4,maxres/3,max_seed) - integer nhx_use(max_seed),ihx_use(0:4,maxres/3,max_seed) - integer nlx_seed(max_seed),ilx_seed(2,maxres/3,max_seed), - & nlx_use(max_seed),ilx_use(maxres/3,max_seed) - real ran1,ran2 - - write (iout,*) 'make_var : nseed=',nseed,'ntry=',n - index=0 - -c----------------------------------------- - if (n7.gt.0.or.n8.gt.0.or.n9.gt.0.or.n14.gt.0.or.n15.gt.0 - & .or.n16.gt.0.or.n17.gt.0.or.n18.gt.0) - & call select_frag(n7frag,n8frag,n14frag, - & n15frag,nbefrag,iter_csa) - -c--------------------------------------------------- -c N18 - random perturbation of one phi(=gamma) angle in a loop -c - IF (n18.gt.0) THEN - nlx_tot=0 - do iters=1,nseed - i1=is(iters) - nlx_seed(iters)=0 - do i2=1,n14frag - if (lvar_frag(i2,1).eq.i1) then - nlx_seed(iters)=nlx_seed(iters)+5 - ilx_seed(1,nlx_seed(iters),iters)=lvar_frag(i2,2) - ilx_seed(2,nlx_seed(iters),iters)=lvar_frag(i2,3) - ilx_use(nlx_seed(iters),iters)=5 - endif - enddo - nlx_use(iters)=nlx_seed(iters) - nlx_tot=nlx_tot+nlx_seed(iters) - enddo - - if (nlx_tot .ge. n18*nseed) then - ntot_gen=n18*nseed - else - ntot_gen=(nlx_tot/nseed)*nseed - endif - - ngen=0 - do while (ngen.lt.ntot_gen) - do iters=1,nseed - iseed=is(iters) - if (nlx_use(iters).gt.0) then - nicht_getan=.true. - do while (nicht_getan) - iih=iran_num(1,nlx_seed(iters)) - if (ilx_use(iih,iters).gt.0) then - nicht_getan=.false. - ilx_use(iih,iters)=ilx_use(iih,iters)-1 - nlx_use(iters)=nlx_use(iters)-1 - endif - enddo - ngen=ngen+1 - index=index+1 - movenx(index)=18 - parent(1,index)=iseed - parent(2,index)=0 - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - jr=iran_num(ilx_seed(1,iih,iters),ilx_seed(2,iih,iters)) - d=ran_number(-pi,pi) - dihang_in(2,jr-2,1,index)=pinorm(dihang_in(2,jr-2,1,index)+d) - - - if (ngen.eq.ntot_gen) goto 145 - endif - enddo - enddo - 145 continue - - ENDIF - - -c----------------------------------------- -c N17 : zip a beta in a seed by forcing one additional p-p contact -c - IF (n17.gt.0) THEN - nhx_tot=0 - do iters=1,nseed - i1=is(iters) - nhx_seed(iters)=0 - nhx_use(iters)=0 - do i2=1,nbefrag - if (avar_frag(i2,1).eq.i1) then - nhx_seed(iters)=nhx_seed(iters)+1 - ihx_use(2,nhx_seed(iters),iters)=1 - if (avar_frag(i2,5)-avar_frag(i2,3).le.3.and. - & avar_frag(i2,2).gt.1.and.avar_frag(i2,4).lt.nres) then - ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1 - ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)+1 - ihx_use(0,nhx_seed(iters),iters)=1 - ihx_use(1,nhx_seed(iters),iters)=0 - nhx_use(iters)=nhx_use(iters)+1 - else - if (avar_frag(i2,4).gt.avar_frag(i2,5)) then - if (avar_frag(i2,2).gt.1.and. - & avar_frag(i2,4).lt.nres) then - ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1 - ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)+1 - ihx_use(0,nhx_seed(iters),iters)=1 - ihx_use(1,nhx_seed(iters),iters)=0 - nhx_use(iters)=nhx_use(iters)+1 - endif - if (avar_frag(i2,3).lt.nres.and. - & avar_frag(i2,5).gt.1) then - ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,3)+1 - ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,5)-1 - ihx_use(0,nhx_seed(iters),iters)= - & ihx_use(0,nhx_seed(iters),iters)+1 - ihx_use(2,nhx_seed(iters),iters)=0 - nhx_use(iters)=nhx_use(iters)+1 - endif - else - if (avar_frag(i2,2).gt.1.and. - & avar_frag(i2,4).gt.1) then - ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1 - ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)-1 - ihx_use(0,nhx_seed(iters),iters)=1 - ihx_use(1,nhx_seed(iters),iters)=0 - nhx_use(iters)=nhx_use(iters)+1 - endif - if (avar_frag(i2,3).lt.nres.and. - & avar_frag(i2,5).lt.nres) then - ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,3)+1 - ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,5)+1 - ihx_use(0,nhx_seed(iters),iters)= - & ihx_use(0,nhx_seed(iters),iters)+1 - ihx_use(2,nhx_seed(iters),iters)=0 - nhx_use(iters)=nhx_use(iters)+1 - endif - endif - endif - endif - enddo - - nhx_tot=nhx_tot+nhx_use(iters) -cd write (iout,*) "debug N17",iters,nhx_seed(iters), -cd & nhx_use(iters),nhx_tot - enddo - - if (nhx_tot .ge. n17*nseed) then - ntot_gen=n17*nseed - else if (nhx_tot .ge. nseed) then - ntot_gen=(nhx_tot/nseed)*nseed - else - ntot_gen=nhx_tot - endif -cd write (iout,*) "debug N17==",ntot_gen,nhx_tot,nseed - - ngen=0 - do while (ngen.lt.ntot_gen) - do iters=1,nseed - iseed=is(iters) - if (nhx_use(iters).gt.0) then -cd write (iout,*) "debug N17",nhx_use(iters),ngen,ntot_gen -cd write (iout,*) "debugN17^", -cd & (ihx_use(0,k,iters),k=1,nhx_use(iters)) - nicht_getan=.true. - do while (nicht_getan) - iih=iran_num(1,nhx_seed(iters)) -cd write (iout,*) "debugN17^",iih - if (ihx_use(0,iih,iters).gt.0) then - iim=iran_num(1,2) -cd write (iout,*) "debugN17=",iih,nhx_seed(iters) -cd write (iout,*) "debugN17-",iim,'##', -cd & (ihx_use(k,iih,iters),k=0,2) -cd call flush(iout) - do while (ihx_use(iim,iih,iters).eq.1) - iim=iran_num(1,2) -cd write (iout,*) "debugN17-",iim,'##', -cd & (ihx_use(k,iih,iters),k=0,2) -cd call flush(iout) - enddo - nicht_getan=.false. - ihx_use(iim,iih,iters)=1 - ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1 - nhx_use(iters)=nhx_use(iters)-1 - endif - enddo - ngen=ngen+1 - index=index+1 - movenx(index)=17 - parent(1,index)=iseed - parent(2,index)=0 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - if (iim.eq.1) then - idata(1,index)=ihx_seed(1,iih,iters) - idata(2,index)=ihx_seed(2,iih,iters) - else - idata(1,index)=ihx_seed(3,iih,iters) - idata(2,index)=ihx_seed(4,iih,iters) - endif - - if (ngen.eq.ntot_gen) goto 115 - endif - enddo - enddo - 115 continue - write (iout,*) "N17",n17," ngen/nseed",ngen/nseed, - & ngen,nseed - - - ENDIF -c----------------------------------------- -c N16 : slide non local beta in a seed by +/- 1 or +/- 2 -c - IF (n16.gt.0) THEN - nhx_tot=0 - do iters=1,nseed - i1=is(iters) - nhx_seed(iters)=0 - do i2=1,n7frag - if (bvar_frag(i2,1).eq.i1) then - nhx_seed(iters)=nhx_seed(iters)+1 - ihx_seed(1,nhx_seed(iters),iters)=bvar_frag(i2,3) - ihx_seed(2,nhx_seed(iters),iters)=bvar_frag(i2,4) - ihx_seed(3,nhx_seed(iters),iters)=bvar_frag(i2,5) - ihx_seed(4,nhx_seed(iters),iters)=bvar_frag(i2,6) - ihx_use(0,nhx_seed(iters),iters)=4 - do i3=1,4 - ihx_use(i3,nhx_seed(iters),iters)=0 - enddo - endif - enddo - nhx_use(iters)=4*nhx_seed(iters) - nhx_tot=nhx_tot+nhx_seed(iters) -cd write (iout,*) "debug N16",iters,nhx_seed(iters) - enddo - - if (4*nhx_tot .ge. n16*nseed) then - ntot_gen=n16*nseed - else if (4*nhx_tot .ge. nseed) then - ntot_gen=(4*nhx_tot/nseed)*nseed - else - ntot_gen=4*nhx_tot - endif - write (iout,*) "debug N16",ntot_gen,4*nhx_tot,nseed - - ngen=0 - do while (ngen.lt.ntot_gen) - do iters=1,nseed - iseed=is(iters) - if (nhx_use(iters).gt.0) then - nicht_getan=.true. - do while (nicht_getan) - iih=iran_num(1,nhx_seed(iters)) - if (ihx_use(0,iih,iters).gt.0) then - iim=iran_num(1,4) - do while (ihx_use(iim,iih,iters).eq.1) -cd write (iout,*) iim, -cd & ihx_use(0,iih,iters),ihx_use(iim,iih,iters) - iim=iran_num(1,4) - enddo - nicht_getan=.false. - ihx_use(iim,iih,iters)=1 - ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1 - nhx_use(iters)=nhx_use(iters)-1 - endif - enddo - ngen=ngen+1 - index=index+1 - movenx(index)=16 - parent(1,index)=iseed - parent(2,index)=0 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - do i=1,4 - idata(i,index)=ihx_seed(i,iih,iters) - enddo - idata(5,index)=iim - - if (ngen.eq.ntot_gen) goto 116 - endif - enddo - enddo - 116 continue - write (iout,*) "N16",n16," ngen/nseed",ngen/nseed, - & ngen,nseed - ENDIF -c----------------------------------------- -c N15 : copy two 2nd structure elements from 1 or 2 conf. in bank to a seed -c - IF (n15.gt.0) THEN - - do iters=1,nseed - iseed=is(iters) - do i=1,mxio - ifused(i)=.false. - enddo - - do idummy=1,n15 - iter=0 - 84 continue - - iran=0 - iif=iran_num(1,n15frag) - do while( (ifused(iif) .or. svar_frag(iif,1).eq.iseed) .and. - & iran.le.mxio ) - iif=iran_num(1,n15frag) - iran=iran+1 - enddo - if(iran.ge.mxio) goto 811 - - iran=0 - iig=iran_num(1,n15frag) - do while( (ifused(iig) .or. svar_frag(iig,1).eq.iseed .or. - & .not.(svar_frag(iif,3).lt.svar_frag(iig,2).or. - & svar_frag(iig,3).lt.svar_frag(iif,2)) ) .and. - & iran.le.mxio ) - iig=iran_num(1,n15frag) - iran=iran+1 - enddo - if(iran.ge.mxio) goto 811 - - index=index+1 - movenx(index)=15 - parent(1,index)=iseed - parent(2,index)=svar_frag(iif,1) - parent(3,index)=svar_frag(iig,1) - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - ifused(iif)=.true. - ifused(iig)=.true. - call newconf_copy(idum,dihang_in(1,1,1,index), - & svar_frag(iif,1),svar_frag(iif,2),svar_frag(iif,3)) - - do j=svar_frag(iig,2),svar_frag(iig,3) - do i=1,4 - dihang_in(i,j,1,index)=bvar(i,j,1,svar_frag(iig,1)) - enddo - enddo - - - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) then - index=index-1 - ifused(iif)=.false. - goto 84 - endif - endif - - 811 continue - enddo - enddo - ENDIF - -c----------------------------------------- -c N14 local_move (Maurizio) for loops in a seed -c - IF (n14.gt.0) THEN - nlx_tot=0 - do iters=1,nseed - i1=is(iters) - nlx_seed(iters)=0 - do i2=1,n14frag - if (lvar_frag(i2,1).eq.i1) then - nlx_seed(iters)=nlx_seed(iters)+3 - ilx_seed(1,nlx_seed(iters),iters)=lvar_frag(i2,2) - ilx_seed(2,nlx_seed(iters),iters)=lvar_frag(i2,3) - ilx_use(nlx_seed(iters),iters)=3 - endif - enddo - nlx_use(iters)=nlx_seed(iters) - nlx_tot=nlx_tot+nlx_seed(iters) -cd write (iout,*) "debug N14",iters,nlx_seed(iters) - enddo - - if (nlx_tot .ge. n14*nseed) then - ntot_gen=n14*nseed - else - ntot_gen=(nlx_tot/nseed)*nseed - endif -cd write (iout,*) "debug N14",ntot_gen,n14frag,nseed - - ngen=0 - do while (ngen.lt.ntot_gen) - do iters=1,nseed - iseed=is(iters) - if (nlx_use(iters).gt.0) then - nicht_getan=.true. - do while (nicht_getan) - iih=iran_num(1,nlx_seed(iters)) - if (ilx_use(iih,iters).gt.0) then - nicht_getan=.false. - ilx_use(iih,iters)=ilx_use(iih,iters)-1 - nlx_use(iters)=nlx_use(iters)-1 - endif - enddo - ngen=ngen+1 - index=index+1 - movenx(index)=14 - parent(1,index)=iseed - parent(2,index)=0 - - idata(1,index)=ilx_seed(1,iih,iters) - idata(2,index)=ilx_seed(2,iih,iters) - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - if (ngen.eq.ntot_gen) goto 131 - endif - enddo - enddo - 131 continue -cd write (iout,*) "N14",n14," ngen/nseed",ngen/nseed, -cd & ngen,nseed - - ENDIF -c----------------------------------------- -c N9 : shift a helix in a seed -c - IF (n9.gt.0) THEN - nhx_tot=0 - do iters=1,nseed - i1=is(iters) - nhx_seed(iters)=0 - do i2=1,n8frag - if (hvar_frag(i2,1).eq.i1) then - nhx_seed(iters)=nhx_seed(iters)+1 - ihx_seed(1,nhx_seed(iters),iters)=hvar_frag(i2,2) - ihx_seed(2,nhx_seed(iters),iters)=hvar_frag(i2,3) - ihx_use(0,nhx_seed(iters),iters)=4 - do i3=1,4 - ihx_use(i3,nhx_seed(iters),iters)=0 - enddo - endif - enddo - nhx_use(iters)=4*nhx_seed(iters) - nhx_tot=nhx_tot+nhx_seed(iters) -cd write (iout,*) "debug N9",iters,nhx_seed(iters) - enddo - - if (4*nhx_tot .ge. n9*nseed) then - ntot_gen=n9*nseed - else - ntot_gen=(4*nhx_tot/nseed)*nseed - endif -cd write (iout,*) "debug N9",ntot_gen,n8frag,nseed - - ngen=0 - do while (ngen.lt.ntot_gen) - do iters=1,nseed - iseed=is(iters) - if (nhx_use(iters).gt.0) then - nicht_getan=.true. - do while (nicht_getan) - iih=iran_num(1,nhx_seed(iters)) - if (ihx_use(0,iih,iters).gt.0) then - iim=iran_num(1,4) - do while (ihx_use(iim,iih,iters).eq.1) -cd write (iout,*) iim, -cd & ihx_use(0,iih,iters),ihx_use(iim,iih,iters) - iim=iran_num(1,4) - enddo - nicht_getan=.false. - ihx_use(iim,iih,iters)=1 - ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1 - nhx_use(iters)=nhx_use(iters)-1 - endif - enddo - ngen=ngen+1 - index=index+1 - movenx(index)=9 - parent(1,index)=iseed - parent(2,index)=0 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - jstart=max(nnt,ihx_seed(1,iih,iters)+1) - jend=min(nct,ihx_seed(2,iih,iters)) -cd write (iout,*) "debug N9",iters,iih,jstart,jend - if (iim.eq.1) then - ishift=-2 - else if (iim.eq.2) then - ishift=-1 - else if (iim.eq.3) then - ishift=1 - else if (iim.eq.4) then - ishift=2 - else - write (iout,*) 'CHUJ NASTAPIL: iim=',iim - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do j=jstart,jend - if (itype(j).eq.10) then - iang=2 - else - iang=4 - endif - do i=1,iang - if (j+ishift.ge.nnt.and.j+ishift.le.nct) - & dihang_in(i,j+ishift,1,index)=bvar(i,j,1,iseed) - enddo - enddo - if (ishift.gt.0) then - do j=0,ishift-1 - if (itype(jend+j).eq.10) then - iang=2 - else - iang=4 - endif - do i=1,iang - if (jend+j.ge.nnt.and.jend+j.le.nct) - & dihang_in(i,jstart+j,1,index)=bvar(i,jend+j,1,iseed) - enddo - enddo - else - do j=0,-ishift-1 - if (itype(jstart+j).eq.10) then - iang=2 - else - iang=4 - endif - do i=1,iang - if (jend+j.ge.nnt.and.jend+j.le.nct) - & dihang_in(i,jend+j,1,index)=bvar(i,jstart+j,1,iseed) - enddo - enddo - endif - if (ngen.eq.ntot_gen) goto 133 - endif - enddo - enddo - 133 continue -cd write (iout,*) "N9",n9," ngen/nseed",ngen/nseed, -cd & ngen,nseed - - ENDIF -c----------------------------------------- -c N8 : copy a helix from bank to seed -c - if (n8.gt.0) then - if (n8frag.lt.n8) then - write (iout,*) "N8: only ",n8frag,'helices' - n8c=n8frag - else - n8c=n8 - endif - - do iters=1,nseed - iseed=is(iters) - do i=1,mxio - ifused(i)=.false. - enddo - - - do idummy=1,n8c - iter=0 - 94 continue - iran=0 - iif=iran_num(1,n8frag) - do while( (ifused(iif) .or. hvar_frag(iif,1).eq.iseed) .and. - & iran.le.mxio ) - iif=iran_num(1,n8frag) - iran=iran+1 - enddo - - if(iran.ge.mxio) goto 911 - - index=index+1 - movenx(index)=8 - parent(1,index)=iseed - parent(2,index)=hvar_frag(iif,1) - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - ifused(iif)=.true. - if (hvar_frag(iif,3)-hvar_frag(iif,2).le.6) then - call newconf_copy(idum,dihang_in(1,1,1,index), - & hvar_frag(iif,1),hvar_frag(iif,2),hvar_frag(iif,3)) - else - ih_start=iran_num(hvar_frag(iif,2),hvar_frag(iif,3)-6) - ih_end=iran_num(ih_start,hvar_frag(iif,3)) - call newconf_copy(idum,dihang_in(1,1,1,index), - & hvar_frag(iif,1),ih_start,ih_end) - endif - iter=iter+1 - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) then - index=index-1 - ifused(iif)=.false. - goto 94 - endif - endif - - - 911 continue - - enddo - enddo - - endif - -c----------------------------------------- -c N7 : copy nonlocal beta fragment from bank to seed -c - if (n7.gt.0) then - if (n7frag.lt.n7) then - write (iout,*) "N7: only ",n7frag,'nonlocal fragments' - n7c=n7frag - else - n7c=n7 - endif - - do i=1,maxres - do j=1,mxio2 - iff_in(i,j)=0 - enddo - enddo - index2=0 - do i=1,mxio - isend2(i)=0 - enddo - - do iters=1,nseed - iseed=is(iters) - do i=1,mxio - ifused(i)=.false. - enddo - - do idummy=1,n7c - iran=0 - iif=iran_num(1,n7frag) - do while( (ifused(iif) .or. bvar_frag(iif,1).eq.iseed) .and. - & iran.le.mxio ) - iif=iran_num(1,n7frag) - iran=iran+1 - enddo - -cd write (*,'(3i5,l,4i5)'),iters,idummy,iif,ifused(iif), -cd & bvar_frag(iif,1),iseed,iran,index2 - - if(iran.ge.mxio) goto 999 - if(index2.ge.mxio2) goto 999 - - index=index+1 - movenx(index)=7 - parent(1,index)=iseed - parent(2,index)=bvar_frag(iif,1) - index2=index2+1 - isend2(index)=index2 - ifused(iif)=.true. - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in2(i,j,k,index2)=bvar(i,j,k,bvar_frag(iif,1)) - enddo - enddo - enddo - - if (bvar_frag(iif,2).eq.4) then - do i=bvar_frag(iif,3),bvar_frag(iif,4) - iff_in(i,index2)=1 - enddo - if (bvar_frag(iif,5).lt.bvar_frag(iif,6)) then -cd print *,'###',bvar_frag(iif,3),bvar_frag(iif,4), -cd & bvar_frag(iif,5),bvar_frag(iif,6) - do i=bvar_frag(iif,5),bvar_frag(iif,6) - iff_in(i,index2)=1 - enddo - else -cd print *,'###',bvar_frag(iif,3),bvar_frag(iif,4), -cd & bvar_frag(iif,6),bvar_frag(iif,5) - do i=bvar_frag(iif,6),bvar_frag(iif,5) - iff_in(i,index2)=1 - enddo - endif - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - - 999 continue - - enddo - enddo - - endif -c----------------------------------------------- -c N6 : copy random continues fragment from bank to seed -c - do iters=1,nseed - iseed=is(iters) - do idummy=1,n6 - isize=(is2-is1+1)*ran1(idum)+is1 - index=index+1 - movenx(index)=6 - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - iter=0 - 104 continue - if(icycle.le.0) then - i1=nconf* ran1(idum)+1 - i1=nbank-nconf+i1 - else - i1=nbank* ran1(idum)+1 - endif - if(i1.eq.iseed) goto 104 - iter=iter+1 - call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize) - parent(1,index)=iseed - parent(2,index)=i1 - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 104 - endif - enddo - enddo -c----------------------------------------- - if (n3.gt.0.or.n4.gt.0) call gen_hairpin - nconf_harp=0 - do iters=1,nseed - if (nharp_seed(iters).gt.0) nconf_harp=nconf_harp+1 - enddo -c----------------------------------------- -c N3 : copy hairpin from bank to seed -c - do iters=1,nseed - iseed=is(iters) - nsucc=0 - nacc=0 - do idummy=1,n3 - index=index+1 - iter=0 - 124 continue - if(icycle.le.0) then - i1=nconf* ran1(idum)+1 - i1=nbank-nconf+i1 - else - i1=nbank* ran1(idum)+1 - endif - if(i1.eq.iseed) goto 124 - do k=1,nsucc - if (i1.eq.iisucc(k).and.nsucc.lt.nconf_harp-1) goto 124 - enddo - nsucc=nsucc+1 - iisucc(nsucc)=i1 - iter=iter+1 - call newconf_residue_hairpin(idum,dihang_in(1,1,1,index), - & i1,fail) - if (fail) then - if (icycle.le.0 .and. nsucc.eq.nconf .or. - & icycle.gt.0 .and. nsucc.eq.nbank) then - index=index-1 - goto 125 - else - goto 124 - endif - endif - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 124 - endif - movenx(index)=3 - parent(1,index)=iseed - parent(2,index)=i1 - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - nacc=nacc+1 - enddo -c if not enough hairpins, supplement with windows - 125 continue -cdd if (n3.ne.0) write (iout,*) "N3",n3," nsucc",nsucc," nacc",nacc - do idummy=nacc+1,n3 - isize=(is2-is1+1)*ran1(idum)+is1 - index=index+1 - movenx(index)=6 - parent(1,index)=iseed - parent(2,index)=i1 - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - iter=0 - 114 continue - if(icycle.le.0) then - i1=nconf* ran1(idum)+1 - i1=nbank-nconf+i1 - else - i1=nbank* ran1(idum)+1 - endif - if(i1.eq.iseed) goto 114 - iter=iter+1 - call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize) - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 114 - endif - enddo - enddo -c----------------------------------------- -c N4 : shift a turn in hairpin in seed -c - IF (N4.GT.0) THEN - if (4*nharp_tot .ge. n4*nseed) then - ntot_gen=n4*nseed - else - ntot_gen=(4*nharp_tot/nseed)*nseed - endif - ngen=0 - do while (ngen.lt.ntot_gen) - do iters=1,nseed - iseed=is(iters) -c write (iout,*) 'iters',iters,' iseed',iseed,' nharp_seed', -c & nharp_seed(iters),' nharp_use',nharp_use(iters), -c & ' ntot_gen',ntot_gen -c write (iout,*) 'iharp_use(0)', -c & (iharp_use(0,k,iters),k=1,nharp_seed(iters)) - if (nharp_use(iters).gt.0) then - nicht_getan=.true. - do while (nicht_getan) - iih=iran_num(1,nharp_seed(iters)) -c write (iout,*) 'iih',iih,' iharp_use', -c & (iharp_use(k,iih,iters),k=1,4) - if (iharp_use(0,iih,iters).gt.0) then - nicht_getan1=.true. - do while (nicht_getan1) - iim=iran_num(1,4) - nicht_getan1=iharp_use(iim,iih,iters).eq.1 - enddo - nicht_getan=.false. - iharp_use(iim,iih,iters)=1 - iharp_use(0,iih,iters)=iharp_use(0,iih,iters)-1 - nharp_use(iters)=nharp_use(iters)-1 -cdd write (iout,'(a16,i3,a5,i2,a10,2i4)') -cdd & 'N4 selected hairpin',iih,' move',iim,' iharp_seed', -cdd & iharp_seed(1,iih,iters),iharp_seed(2,iih,iters) - endif - enddo - ngen=ngen+1 - index=index+1 - movenx(index)=4 - parent(1,index)=iseed - parent(2,index)=0 - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - jstart=iharp_seed(1,iih,iters)+1 - jend=iharp_seed(2,iih,iters) - if (iim.eq.1) then - ishift=-2 - else if (iim.eq.2) then - ishift=-1 - else if (iim.eq.3) then - ishift=1 - else if (iim.eq.4) then - ishift=2 - else - write (iout,*) 'CHUJ NASTAPIL: iim=',iim - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif -c write (iout,*) 'jstart',jstart,' jend',jend,' ishift',ishift -c write (iout,*) 'Before turn shift' -c do j=2,nres-1 -c theta(j+1)=dihang_in(1,j,1,index) -c phi(j+2)=dihang_in(2,j,1,index) -c alph(j)=dihang_in(3,j,1,index) -c omeg(j)=dihang_in(4,j,1,index) -c enddo -c call intout - do j=jstart,jend - if (itype(j).eq.10) then - iang=2 - else - iang=4 - endif - do i=1,iang - if (j+ishift.ge.nnt.and.j+ishift.le.nct) - & dihang_in(i,j+ishift,1,index)=bvar(i,j,1,iseed) - enddo - enddo -c write (iout,*) 'After turn shift' -c do j=2,nres-1 -c theta(j+1)=dihang_in(1,j,1,index) -c phi(j+2)=dihang_in(2,j,1,index) -c alph(j)=dihang_in(3,j,1,index) -c omeg(j)=dihang_in(4,j,1,index) -c enddo -c call intout - if (ngen.eq.ntot_gen) goto 135 - endif - enddo - enddo -c if not enough hairpins, supplement with windows -c write (iout,*) 'end of enddo' - 135 continue -cdd write (iout,*) "N4",n4," ngen/nseed",ngen/nseed, -cdd & ngen,nseed - do iters=1,nseed - iseed=is(iters) - do idummy=ngen/nseed+1,n4 - isize=(is2-is1+1)*ran1(idum)+is1 - index=index+1 - movenx(index)=6 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - - iter=0 - 134 continue - if(icycle.le.0) then - i1=nconf* ran1(idum)+1 - i1=nbank-nconf+i1 - else - i1=nbank* ran1(idum)+1 - endif - if(i1.eq.iseed) goto 134 - iter=iter+1 - call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize) - parent(1,index)=iseed - parent(2,index)=i1 - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 134 - endif - enddo - enddo - ENDIF -c----------------------------------------- -c N5 : copy one residue from bank to seed (normally switched off - use N1) -c - do iters=1,nseed - iseed=is(iters) - isize=1 - do i=1,n5 - index=index+1 - movenx(index)=5 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - - iter=0 - 105 continue - if(icycle.le.0) then - i1=nconf* ran1(idum)+1 - i1=nbank-nconf+i1 - else - i1=nbank* ran1(idum)+1 - endif - if(i1.eq.iseed) goto 105 - iter=iter+1 - call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize) - parent(1,index)=iseed - parent(2,index)=i1 - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 105 - endif - enddo - enddo -c----------------------------------------- -c N2 : copy backbone of one residue from bank or first bank to seed -c (normally switched off - use N1) -c - do iters=1,nseed - iseed=is(iters) - do i=n2,1,-1 - if(icycle.le.0.and.iuse.gt.nconf-irr) then - iseed=ran1(idum)*nconf+1 - iseed=nbank-nconf+iseed - endif - index=index+1 - movenx(index)=2 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - iter=0 - 102 i1= ran1(idum)*nbank+1 - if(i1.eq.iseed) goto 102 - iter=iter+1 - if(icycle.le.0.and.iuse.gt.nconf-irr) then - nran=mod(i-1,nran0)+3 - call newconf1arr(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=-iseed - parent(2,index)=-i1 - else if(icycle.le.0.and.iters.le.iuse) then - nran=mod(i-1,nran0)+1 - call newconf1abr(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=iseed - parent(2,index)=-i1 - else - nran=mod(i-1,nran1)+1 - if(ran1(idum).lt.0.5) then - call newconf1abr(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=iseed - parent(2,index)=-i1 - else - call newconf1abb(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=iseed - parent(2,index)=i1 - endif - endif - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 102 - endif - enddo - enddo -c----------------------------------------- -c N1 : copy backbone or sidechain of one residue from bank or -c first bank to seed -c - do iters=1,nseed - iseed=is(iters) - do i=n1,1,-1 - if(icycle.le.0.and.iuse.gt.nconf-irr) then - iseed=ran1(idum)*nconf+1 - iseed=nbank-nconf+iseed - endif - index=index+1 - movenx(index)=1 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - iter=0 - 101 i1= ran1(idum)*nbank+1 - - if(i1.eq.iseed) goto 101 - iter=iter+1 - if(icycle.le.0.and.iuse.gt.nconf-irr) then - nran=mod(i-1,nran0)+3 - call newconf1rr(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=-iseed - parent(2,index)=-i1 - else if(icycle.le.0.and.iters.le.iuse) then - nran=mod(i-1,nran0)+1 - call newconf1br(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=iseed - parent(2,index)=-i1 - else - nran=mod(i-1,nran1)+1 - if(ran1(idum).lt.0.5) then - call newconf1br(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=iseed - parent(2,index)=-i1 - else - call newconf1bb(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=iseed - parent(2,index)=i1 - endif - endif - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 101 - endif - enddo - enddo -c----------------------------------------- -c N0 just all seeds -c - IF (n0.gt.0) THEN - do iters=1,nseed - iseed=is(iters) - index=index+1 - movenx(index)=0 - parent(1,index)=iseed - parent(2,index)=0 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - enddo - ENDIF -c----------------------------------------- - if (vdisulf) then - do iters=1,nseed - iseed=is(iters) - - do k=1,numch - do j=2,nres-1 - theta(j+1)=bvar(1,j,k,iseed) - phi(j+2)=bvar(2,j,k,iseed) - alph(j)=bvar(3,j,k,iseed) - omeg(j)=bvar(4,j,k,iseed) - enddo - enddo - call chainbuild - -cd write(iout,*) 'makevar DYNSS',iseed,'#',bvar_ns(iseed), -cd & (bvar_s(k,iseed),k=1,bvar_ns(iseed)), -cd & bvar_nss(iseed), -cd & (bvar_ss(1,k,iseed)-nres,'-', -cd & bvar_ss(2,k,iseed)-nres,k=1,bvar_nss(iseed)) - - do i1=1,bvar_ns(iseed) -c -c N10 fussion of free halfcysteines in seed -c first select CYS with distance < 7A -c - do j1=i1+1,bvar_ns(iseed) - if (dist(bvar_s(i1,iseed)+nres,bvar_s(j1,iseed)+nres) - & .lt.7.0.and. - & iabs(bvar_s(i1,iseed)-bvar_s(j1,iseed)).gt.3) then - - index=index+1 - movenx(index)=10 - parent(1,index)=iseed - parent(2,index)=0 - do ij=1,bvar_nss(iseed) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - ij=bvar_nss(iseed)+1 - nss_in(index)=ij - iss_in(ij,index)=bvar_s(i1,iseed)+nres - jss_in(ij,index)=bvar_s(j1,iseed)+nres - -cd write(iout,*) 'makevar NSS0',index, -cd & dist(bvar_s(i1,iseed)+nres,bvar_s(j1,iseed)+nres), -cd & nss_in(index),iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - endif - enddo -c -c N11 type I transdisulfidation -c - do j1=1,bvar_nss(iseed) - if (dist(bvar_s(i1,iseed)+nres,bvar_ss(1,j1,iseed)) - & .lt.7.0.and. - & iabs(bvar_s(i1,iseed)-(bvar_ss(1,j1,iseed)-nres)) - & .gt.3) then - - index=index+1 - movenx(index)=11 - parent(1,index)=iseed - parent(2,index)=0 - do ij=1,bvar_nss(iseed) - if (ij.ne.j1) then - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - endif - enddo - nss_in(index)=bvar_nss(iseed) - iss_in(j1,index)=bvar_s(i1,iseed)+nres - jss_in(j1,index)=bvar_ss(1,j1,iseed) - if (iss_in(j1,index).gt.jss_in(j1,index)) then - iss_in(j1,index)=bvar_ss(1,j1,iseed) - jss_in(j1,index)=bvar_s(i1,iseed)+nres - endif - -cd write(iout,*) 'makevar NSS1 #1',index, -cd & bvar_s(i1,iseed),bvar_ss(1,j1,iseed)-nres, -cd & dist(bvar_s(i1,iseed)+nres,bvar_ss(1,j1,iseed)), -cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres, -cd & ij=1,nss_in(index)) - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - endif - if (dist(bvar_s(i1,iseed)+nres,bvar_ss(2,j1,iseed)) - & .lt.7.0.and. - & iabs(bvar_s(i1,iseed)-(bvar_ss(2,j1,iseed)-nres)) - & .gt.3) then - - index=index+1 - movenx(index)=11 - parent(1,index)=iseed - parent(2,index)=0 - do ij=1,bvar_nss(iseed) - if (ij.ne.j1) then - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - endif - enddo - nss_in(index)=bvar_nss(iseed) - iss_in(j1,index)=bvar_s(i1,iseed)+nres - jss_in(j1,index)=bvar_ss(2,j1,iseed) - if (iss_in(j1,index).gt.jss_in(j1,index)) then - iss_in(j1,index)=bvar_ss(2,j1,iseed) - jss_in(j1,index)=bvar_s(i1,iseed)+nres - endif - - -cd write(iout,*) 'makevar NSS1 #2',index, -cd & bvar_s(i1,iseed),bvar_ss(2,j1,iseed)-nres, -cd & dist(bvar_s(i1,iseed)+nres,bvar_ss(2,j1,iseed)), -cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres, -cd & ij=1,nss_in(index)) - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - endif - enddo - enddo - -c -c N12 type II transdisulfidation -c - do i1=1,bvar_nss(iseed) - do j1=i1+1,bvar_nss(iseed) - if (dist(bvar_ss(1,i1,iseed),bvar_ss(1,j1,iseed)) - & .lt.7.0.and. - & dist(bvar_ss(2,i1,iseed),bvar_ss(2,j1,iseed)) - & .lt.7.0.and. - & iabs(bvar_ss(1,i1,iseed)-bvar_ss(1,j1,iseed)) - & .gt.3.and. - & iabs(bvar_ss(2,i1,iseed)-bvar_ss(2,j1,iseed)) - & .gt.3) then - index=index+1 - movenx(index)=12 - parent(1,index)=iseed - parent(2,index)=0 - do ij=1,bvar_nss(iseed) - if (ij.ne.i1 .and. ij.ne.j1) then - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - endif - enddo - nss_in(index)=bvar_nss(iseed) - iss_in(i1,index)=bvar_ss(1,i1,iseed) - jss_in(i1,index)=bvar_ss(1,j1,iseed) - if (iss_in(i1,index).gt.jss_in(i1,index)) then - iss_in(i1,index)=bvar_ss(1,j1,iseed) - jss_in(i1,index)=bvar_ss(1,i1,iseed) - endif - iss_in(j1,index)=bvar_ss(2,i1,iseed) - jss_in(j1,index)=bvar_ss(2,j1,iseed) - if (iss_in(j1,index).gt.jss_in(j1,index)) then - iss_in(j1,index)=bvar_ss(2,j1,iseed) - jss_in(j1,index)=bvar_ss(2,i1,iseed) - endif - - -cd write(iout,*) 'makevar NSS2 #1',index, -cd & bvar_ss(1,i1,iseed)-nres,bvar_ss(1,j1,iseed)-nres, -cd & dist(bvar_ss(1,i1,iseed),bvar_ss(1,j1,iseed)), -cd & bvar_ss(2,i1,iseed)-nres,bvar_ss(2,j1,iseed)-nres, -cd & dist(bvar_ss(2,i1,iseed),bvar_ss(2,j1,iseed)), -cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres, -cd & ij=1,nss_in(index)) - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - endif - - if (dist(bvar_ss(1,i1,iseed),bvar_ss(2,j1,iseed)) - & .lt.7.0.and. - & dist(bvar_ss(2,i1,iseed),bvar_ss(1,j1,iseed)) - & .lt.7.0.and. - & iabs(bvar_ss(1,i1,iseed)-bvar_ss(2,j1,iseed)) - & .gt.3.and. - & iabs(bvar_ss(2,i1,iseed)-bvar_ss(1,j1,iseed)) - & .gt.3) then - index=index+1 - movenx(index)=12 - parent(1,index)=iseed - parent(2,index)=0 - do ij=1,bvar_nss(iseed) - if (ij.ne.i1 .and. ij.ne.j1) then - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - endif - enddo - nss_in(index)=bvar_nss(iseed) - iss_in(i1,index)=bvar_ss(1,i1,iseed) - jss_in(i1,index)=bvar_ss(2,j1,iseed) - if (iss_in(i1,index).gt.jss_in(i1,index)) then - iss_in(i1,index)=bvar_ss(2,j1,iseed) - jss_in(i1,index)=bvar_ss(1,i1,iseed) - endif - iss_in(j1,index)=bvar_ss(2,i1,iseed) - jss_in(j1,index)=bvar_ss(1,j1,iseed) - if (iss_in(j1,index).gt.jss_in(j1,index)) then - iss_in(j1,index)=bvar_ss(1,j1,iseed) - jss_in(j1,index)=bvar_ss(2,i1,iseed) - endif - - -cd write(iout,*) 'makevar NSS2 #2',index, -cd & bvar_ss(1,i1,iseed)-nres,bvar_ss(2,j1,iseed)-nres, -cd & dist(bvar_ss(1,i1,iseed),bvar_ss(2,j1,iseed)), -cd & bvar_ss(2,i1,iseed)-nres,bvar_ss(1,j1,iseed)-nres, -cd & dist(bvar_ss(2,i1,iseed),bvar_ss(1,j1,iseed)), -cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres, -cd & ij=1,nss_in(index)) - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - endif - - - enddo - enddo -c -c N13 removal of disulfide bond -c - if (bvar_nss(iseed).gt.0) then - i1=bvar_nss(iseed)*ran1(idum)+1 - - index=index+1 - movenx(index)=13 - parent(1,index)=iseed - parent(2,index)=0 - ij=0 - do j1=1,bvar_nss(iseed) - if (j1.ne.i1) then - ij=ij+1 - iss_in(ij,index)=bvar_ss(1,j1,iseed) - jss_in(ij,index)=bvar_ss(2,j1,iseed) - endif - enddo - nss_in(index)=bvar_nss(iseed)-1 - -cd write(iout,*) 'NSS3',index,i1, -cd & bvar_ss(1,i1,iseed)-nres,'=',bvar_ss(2,i1,iseed)-nres,'#', -cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres, -cd & ij=1,nss_in(index)) - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - endif - - enddo - endif -c----------------------------------------- - - - - if(index.ne.n) write(iout,*)'make_var : ntry=',index - - n=index -cd do ii=1,n -cd write (istat,*) "======== ii=",ii," the dihang array" -cd do i=1,nres -cd write (istat,'(i5,4f15.5)') i,(dihang_in(k,i,1,ii)*rad2deg,k=1,4) -cd enddo -cd enddo - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine check_old(icheck,n) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - data ctdif /10./ - data ctdiff /60./ - - i1=n - do i2=1,n-1 - diff=0.d0 - do m=1,numch - do j=2,nres-1 - do i=1,4 - dif=rad2deg*dabs(dihang_in(i,j,m,i1)-dihang_in(i,j,m,i2)) - if(dif.gt.180.0) dif=360.0-dif - if(dif.gt.ctdif) goto 100 - diff=diff+dif - if(diff.gt.ctdiff) goto 100 - enddo - enddo - enddo - icheck=1 - return - 100 continue - enddo - - icheck=0 - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf1rr(idum,vvar,nran,i1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=rvar(i,j,k,iseed) - enddo - enddo - enddo - - do index=1,nran - iold(index) = 0 - enddo - - number=ntotgr - - iter=0 - do index=1,nran - 10 iran= ran1(idum)*number+1 - if(iter.gt.number) return - iter=iter+1 - if(iter.eq.1) goto 11 - do ind=1,index-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - if(iter.gt.number) goto 20 - goto 10 - 20 continue - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - vvar(i,j,k)=rvar(i,j,k,i1) - enddo - iold(index)=iran - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf1br(idum,vvar,nran,i1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - do index=1,nran - iold(index) = 0 - enddo - - number=ntotgr - - iter=0 - do index=1,nran - 10 iran= ran1(idum)*number+1 - if(i2ndstr.gt.0) then - rtmp=ran1(idum) - if(rtmp.le.rdih_bias) then - i=0 - do j=1,ndih_nconstr - if(igroup(2,1,iran).eq.idih_nconstr(j))i=j - enddo - if(i.eq.0) then - juhc=0 -4321 juhc=juhc+1 - iran= ran1(idum)*number+1 - i=0 - do j=1,ndih_nconstr - if(igroup(2,1,iran).eq.idih_nconstr(j))i=j - enddo - if(i.eq.0.or.juhc.lt.1000)goto 4321 - if(juhc.eq.1000) then - print *, 'move 6 : failed to find unconstrained group' - write(iout,*) 'move 6 : failed to find unconstrained group' - endif - endif - endif - endif - if(iter.gt.number) return - iter=iter+1 - if(iter.eq.1) goto 11 - do ind=1,index-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - if(iter.gt.number) goto 20 - goto 10 - 20 continue - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - vvar(i,j,k)=rvar(i,j,k,i1) - enddo - iold(index)=iran - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf1bb(idum,vvar,nran,i1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - do index=1,nran - iold(index) = 0 - enddo - - number=ntotgr - - iter=0 - do index=1,nran - 10 iran= ran1(idum)*number+1 - if(iter.gt.number) return - iter=iter+1 - if(iter.eq.1) goto 11 - do ind=1,index-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - if(iter.gt.number) goto 20 - goto 10 - 20 continue - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - vvar(i,j,k)=bvar(i,j,k,i1) - enddo - iold(index)=iran - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf1arr(idum,vvar,nran,i1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=rvar(i,j,k,iseed) - enddo - enddo - enddo - - do index=1,nran - iold(index) = 0 - enddo - - number=nres-2 - - iter=0 - do index=1,nran - 10 iran= ran1(idum)*number+1 - if(iter.gt.number) return - iter=iter+1 - if(iter.eq.1) goto 11 - do ind=1,index-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - if(iter.gt.number) goto 20 - goto 10 - 20 continue - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - vvar(i,j,k)=rvar(i,j,k,i1) - enddo - iold(index)=iran - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf1abr(idum,vvar,nran,i1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - do index=1,nran - iold(index) = 0 - enddo - - number=nres-2 - - iter=0 - do index=1,nran - 10 iran= ran1(idum)*number+1 - if(i2ndstr.gt.0) then - rtmp=ran1(idum) - if(rtmp.le.rdih_bias) then - iran=ran1(idum)*ndih_nconstr+1 - iran=idih_nconstr(iran) - endif - endif - if(iter.gt.number) return - iter=iter+1 - if(iter.eq.1) goto 11 - do ind=1,index-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - if(iter.gt.number) goto 20 - goto 10 - 20 continue - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - vvar(i,j,k)=rvar(i,j,k,i1) - enddo - iold(index)=iran - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf1abb(idum,vvar,nran,i1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - do index=1,nran - iold(index) = 0 - enddo - - number=nres-2 - - iter=0 - do index=1,nran - 10 iran= ran1(idum)*number+1 - if(i2ndstr.gt.0) then - rtmp=ran1(idum) - if(rtmp.le.rdih_bias) then - iran=ran1(idum)*ndih_nconstr+1 - iran=idih_nconstr(iran) - endif - endif - if(iter.gt.number) return - iter=iter+1 - if(iter.eq.1) goto 11 - do ind=1,index-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - if(iter.gt.number) goto 20 - goto 10 - 20 continue - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - vvar(i,j,k)=bvar(i,j,k,i1) - enddo - iold(index)=iran - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf_residue(idum,vvar,i1,isize) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - if (iseed.gt.mxio .or. iseed.lt.1) then - write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - - k=1 - number=nres+isize-2 - iter=1 - 10 iran= ran1(idum)*number+1 - if(i2ndstr.gt.0) then - rtmp=ran1(idum) - if(rtmp.le.rdih_bias) then - iran=ran1(idum)*ndih_nconstr+1 - iran=idih_nconstr(iran) - endif - endif - istart=iran-isize+1 - iend=iran - if(istart.lt.2) istart=2 - if(iend.gt.nres-1) iend=nres-1 - - if(iter.eq.1) goto 11 - do ind=1,iter-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do j=istart,iend - do i=1,4 - dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - enddo - iold(iter)=iran - iter=iter+1 - if(iter.gt.number) goto 20 - goto 10 - - 20 continue - do j=istart,iend - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,i1) - enddo - enddo - - return - end - -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf_copy(idum,vvar,i1,istart,iend) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - if (iseed.gt.mxio .or. iseed.lt.1) then - write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - - do j=istart,iend - do i=1,4 - vvar(i,j,1)=bvar(i,j,1,i1) - enddo - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf_residue_hairpin(idum,vvar,i1,fail) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.VAR' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - integer nharp,iharp(4,maxres/3),icipa(maxres/3) - logical fail,not_done - ctdif=10. - - fail=.false. - if (iseed.gt.mxio .or. iseed.lt.1) then - write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - do k=1,numch - do j=2,nres-1 - theta(j+1)=bvar(1,j,k,i1) - phi(j+2)=bvar(2,j,k,i1) - alph(j)=bvar(3,j,k,i1) - omeg(j)=bvar(4,j,k,i1) - enddo - enddo -c call intout - call chainbuild - call hairpin(.false.,nharp,iharp) - - if (nharp.eq.0) then - fail=.true. - return - endif - - n_used=0 - - DO III=1,NHARP - - not_done = .true. - icount=0 - do while (not_done) - icount=icount+1 - iih=iran_num(1,nharp) - do k=1,n_used - if (iih.eq.icipa(k)) then - iih=0 - goto 22 - endif - enddo - not_done=.false. - n_used=n_used+1 - icipa(n_used)=iih - 22 continue - not_done = not_done .and. icount.le.nharp - enddo - - if (iih.eq.0) then - write (iout,*) "CHUJ NASTAPIL W NEWCONF_RESIDUE_HAIRPIN!!!!" - fail=.true. - return - endif - - istart=iharp(1,iih)+1 - iend=iharp(2,iih) - -cdd write (iout,*) "newconf_residue_hairpin: iih",iih, -cdd & " istart",istart," iend",iend - - do k=1,numch - do j=istart,iend - do i=1,4 - dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - enddo - enddo - goto 10 - 20 continue - do k=1,numch - do j=istart,iend - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,i1) - enddo - enddo - enddo -c do j=1,numch -c do l=2,nres-1 -c write (iout,'(4f8.3)') (rad2deg*vvar(i,l,j),i=1,4) -c enddo -c enddo - return - 10 continue - ENDDO - - fail=.true. - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine gen_hairpin - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.HAIRPIN' - -c write (iout,*) 'Entering GEN_HAIRPIN' - do iters=1,nseed - i1=is(iters) - do k=1,numch - do j=2,nres-1 - theta(j+1)=bvar(1,j,k,i1) - phi(j+2)=bvar(2,j,k,i1) - alph(j)=bvar(3,j,k,i1) - omeg(j)=bvar(4,j,k,i1) - enddo - enddo - call chainbuild - call hairpin(.false.,nharp_seed(iters),iharp_seed(1,1,iters)) - enddo - - nharp_tot=0 - do iters=1,nseed - nharp_tot=nharp_tot+nharp_seed(iters) - nharp_use(iters)=4*nharp_seed(iters) - do j=1,nharp_seed(iters) - iharp_use(0,j,iters)=4 - do k=1,4 - iharp_use(k,j,iters)=0 - enddo - enddo - enddo - - write (iout,*) 'GEN_HAIRPIN: nharp_tot',nharp_tot -cdd do i=1,nseed -cdd write (iout,*) 'seed',i -cdd write (iout,*) 'nharp_seed',nharp_seed(i), -cdd & ' nharp_use',nharp_use(i) -cd write (iout,*) 'iharp_seed, iharp_use' -cd do j=1,nharp_seed(i) -cd write (iout,'(7i3)') iharp_seed(1,j,i),iharp_seed(2,j,i), -cd & (iharp_use(k,j,i),k=0,4) -cd enddo -cdd enddo - return - end - -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine select_frag(nn,nh,nl,ns,nb,i_csa) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.HAIRPIN' - include 'COMMON.DISTFIT' - character*50 linia - integer isec(maxres) - - - nn=0 - nh=0 - nl=0 - ns=0 - nb=0 -cd write (iout,*) 'Entering select_frag' - do i1=1,nbank - do i=1,nres - isec(i)=0 - enddo - do k=1,numch - do j=2,nres-1 - theta(j+1)=bvar(1,j,k,i1) - phi(j+2)=bvar(2,j,k,i1) - alph(j)=bvar(3,j,k,i1) - omeg(j)=bvar(4,j,k,i1) - enddo - enddo - call chainbuild -cd write (iout,*) ' -- ',i1,' -- ' - call secondary2(.false.) -c -c bvar_frag nn==pair of nonlocal strands in beta sheet (loop>4) -c strands > 4 residues; used by N7 and N16 -c - do j=1,nbfrag -c -Ctest 09/12/02 bfrag(2,j)-bfrag(1,j).gt.3 -c - do i=bfrag(1,j),bfrag(2,j) - isec(i)=1 - enddo - do i=bfrag(4,j),bfrag(3,j),sign(1,bfrag(3,j)-bfrag(4,j)) - isec(i)=1 - enddo - - if ( (bfrag(3,j).lt.bfrag(4,j) .or. - & bfrag(4,j)-bfrag(2,j).gt.4) .and. - & bfrag(2,j)-bfrag(1,j).gt.4 ) then - nn=nn+1 - - - if (bfrag(3,j).lt.bfrag(4,j)) then - write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)') - & "select",bfrag(1,j)-1,"-",bfrag(2,j)-1 - & ,",",bfrag(3,j)-1,"-",bfrag(4,j)-1 - else - write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)') - & "select",bfrag(1,j)-1,"-",bfrag(2,j)-1 - & ,",",bfrag(4,j)-1,"-",bfrag(3,j)-1 - - endif -cd call write_pdb(i_csa*1000+nn+nh,linia,0d0) - - bvar_frag(nn,1)=i1 - bvar_frag(nn,2)=4 - do i=1,4 - bvar_frag(nn,i+2)=bfrag(i,j) - enddo - endif - enddo - -c -c hvar_frag nh==helices; used by N8 and N9 -c - do j=1,nhfrag - - do i=hfrag(1,j),hfrag(2,j) - isec(i)=2 - enddo - - if ( hfrag(2,j)-hfrag(1,j).gt.4 ) then - nh=nh+1 - -cd write(linia,'(a6,i3,a1,i3)') -cd & "select",hfrag(1,j)-1,"-",hfrag(2,j)-1 -cd call write_pdb(i_csa*1000+nn+nh,linia,0d0) - - hvar_frag(nh,1)=i1 - hvar_frag(nh,2)=hfrag(1,j) - hvar_frag(nh,3)=hfrag(2,j) - endif - enddo - - -cv write(iout,'(i4,1pe12.4,1x,1000i1)') -cv & i1,bene(i1),(isec(i),i=1,nres) -cv write(linia,'(i4,1x,1000i1)') -cv & i1,(isec(i),i=1,nres) -cv call write_pdb(i_csa*1000+i1,linia,bene(i1)) -c -c lvar_frag nl==loops; used by N14 -c - i=1 - nl1=nl - do while (i.lt.nres) - if (isec(i).eq.0) then - nl=nl+1 - lvar_frag(nl,1)=i1 - lvar_frag(nl,2)=i - i=i+1 - do while (isec(i).eq.0.and.i.le.nres) - i=i+1 - enddo - lvar_frag(nl,3)=i-1 - if (lvar_frag(nl,3)-lvar_frag(nl,2).lt.1) nl=nl-1 - endif - i=i+1 - enddo -cd write(iout,'(4i5)') (i,(lvar_frag(i,ii),ii=1,3),i=nl1+1,nl) - -c -c svar_frag ns==an secondary structure element; used by N15 -c - i=1 - ns1=ns - do while (i.lt.nres) - if (isec(i).gt.0) then - ns=ns+1 - svar_frag(ns,1)=i1 - svar_frag(ns,2)=i - i=i+1 - do while (isec(i).gt.0.and.isec(i-1).eq.isec(i) - & .and.i.le.nres) - i=i+1 - enddo - svar_frag(ns,3)=i-1 - if (svar_frag(ns,3)-svar_frag(ns,2).lt.1) ns=ns-1 - endif - if (isec(i).eq.0) i=i+1 - enddo -cd write(iout,'(4i5)') (i,(svar_frag(i,ii),ii=1,3),i=ns1+1,ns) - -c -c avar_frag nb==any pair of beta strands; used by N17 -c - do j=1,nbfrag - nb=nb+1 - avar_frag(nb,1)=i1 - do i=1,4 - avar_frag(nb,i+1)=bfrag(i,j) - enddo - enddo - - enddo - - return - end -#endif diff --git a/source/unres/src_MD/newconf.f b/source/unres/src_MD/newconf.f deleted file mode 100644 index 0b6fc2b79f50411973f25e9316fe14e3ccc00651..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1243 zcmbtTO;5r=5FIFfd+}!CrJjUDHk9CngQ+2c2jhXnlLynnqD0vybp1N{7ySwR1pNg% zLp!pJJs6#&o%i0(+uhD?Ur*1wlByShgkne5`&imRAbU?^?3Wi!`iYmxAYztJ`kw1sm^bmEv!>Y1()u9w$@(s(Mr#;YL6a|p;aS@SdXnA_1IRAHSP7Zruac=>(#b4XRUXymHFq* z>}c<~_dL&i?)yA@_TIm}_Wxb)de?sUC*iu(qMaxQXmYf2rbbarmJ(kxaw z$2vvMs?cC~>s#)dj26CH+_RZ>4h@=B+H&9k^U;l4Xl45ejCxF}F>85!AbYLa^T%!*gV*%MT8@a~r4(`zWaxoCNzlFk^ILpy(*U=3eHF33*B zr#r)s(`xSzihF)f`)~bVQgP3RW?^!1Pl4&Cf~w-1pV<1rwBnlwYmR(+_oU+99~*-y z#XSej!qnoP$;R@C;?pag;-0q*EiCStX6VtyJ?|Pa-S}VJGh)_?ihKTv7HYh7kzmyH zoj^O_^K?J_8j~>#am=yxNBrowPojUYi^C>Gkm$VehIC& zv;>P!?;*DwhYq&F8ZVz}xm)ffCWlCE?_hDyH)vfd@^YQip0*U)m06vSB1B{_4H&-c5e0!h1~4A{(A!sanp~7i_aO9j-6qE zjy%P^Crl$p``(o}$&Bou&*RL}2HH?AG-%e0MU6Me)%MbeeBBYbLASWKv4GahP#f-F z8`w-K)cbWpkV3t;(=h}o)_X2Bh-<5q;XGecj`fYnxF8Slp;ymssPk0ma9m?LsyR?- zyvJ4z9Pg`aBnI*x@B`GrKH0>3)#u+Umk65!^~R$`0pk#*#v$WWOYzJ(0p7AU8z?+n zeDyn&7s1b!DaMtJ&kl@fF7@lS-;4>?APFXc z;O?QG!L*voHP`mOUEKRFooH&dpULZ@UDIdQOfdHF;XH11X2Ci$M58-Wo8;`M*l8^7 ziOtF5E_9}G@Cu|JKBjA`Qx z4ac}_lW@w6j^Uqj(`e+OB;)&^VJZhQ%yH*@Jx6R z%5zwbIUfytPk$E5>~$ z*}PW#4e912^Qh%C4%7rTlC`t5F4hp(C}#`VqsG&0SzJ7G$4lL0ba-*`njJ53KxygN z9WRZZqPagd=Fh^q7}YQ?3zzjD|D@NN*k;^J*BJc`A9_cvY|qMeacXIQ!ymi>$!wSK zj8G*b|5Ds{K3!UDH)ETI#jJQ?aj6Lth9x(i4u9)^<*x0__1|y{5e(%72g%17-MuRm zy5#A-huj)BLXQqoJy%gWn=Bt-|M^}kch)fN8XduUE>hDyY-)}piO<+^jZfUA+-D_R zugmJQsveeAN*jn`HJ>Z`#*Zea_RsRFTS7L^41~Jlz!q-v{aTozs)^>7Y7~| zjWe^tu|Lj!o_!;?re8Ng`LH=Kr>`b3hf`zv57|kxcew9$@r=&pHPjqlr}KGFU>BK~ z+kjHI8PGUTduQR9aP*4$8W@~fyMiLzD;hPTceg^J~D1xrnz2+9l>@+-=E#ZEoszF+|`cWRU z_{#iwntRCwgNv7#dUWN2kmriqRJ4bO!Er;nHyR#1r!KaC&rxI$8oV^NsFxO;k^SNR zipPz9xc{N^85y0Cf7$e6Xwdj(*7J;~zz?2P7yH-T1;Ayo>0e&~XvUe*?VdXxeqW ztxfCtn*;SG9MU*1T6`CAn0lA*PbF*QSdgLK?83KUGw4==<~#mO7eih?72kM>mU;L& zkn{fO;+|KCN;Y`$A0IZu_Y~#xoX4LK| z-f3i;8x&ip!F({#lLET`;|dG)V4$#x~#wA**t+9 zE;IvTU0?zCYXuLDCB{GX=tuO-$HbjC(Y>D07=A-2B%Rqn&F}qy+8`?}JB#}d(<+VA zJPPvt01egIKsXof(cNC6i+kQynP=N0w9Odq9R3d90~|wQV-w8~V>0oW^4E=&xiMvU zm@W$FdCe+%;MABK2JYuh{z2G8%yAA~Odam!eApZ7?WF3u3&&bSv6J8_Y#lrxPyZNm@{w3hn_a|q|uA8Be z*!pDSRr{#Fw!UA`bx*Sazz&Iqmj>4tPb-~ICf{V<~b*WR#%t~JZ{TX`^FqH za2+zh?=kYnUTPYS%Lw7}2tmU?jiEdi$ndZJXhn1}gx5o%LGz@OPJTU95k+ zBGvJ+6>B@<>DEnd{F-R8D{A&krQP;KN1{D(t+zh0)XI2kS2CJb<5Y`VU$fXHN4jF! zu5^6jooQ=BTRI+XPIR=ov}@GO#6Qy&?})`+YQh+yjE~atR7W=MR!7sxlv}bPk!>5} z{A{1Sa#-3wrp4q*dsi}>=uF1lSgNBXm2Nko$mc_KTRgU&-H&^LY)w;Z;vFBmPis4} z=~QPT=4PVpoksqA#M>}(E`fHY|S5>*OXfj5f$i1Jhi4)3Qmdd(anRv6ia6&WR zjidXAN_}l6+OR6sl6BMn`$@Pwo=Ih5rU%+n$vDS>j-*W;(e^|v)F z|G!k!U7g#$E7!Tb{l8*;qW&ozDT&gwptK~^cFt_GIww)ibWWm-K1`u`OX&Qd zA@k;xl}1Bl1V4EO4=SIe^^#C$JX98}n9Zj1=7cIdgLr6OFjP8+XY*)Ff`3SHzFD3V zT2RtLJC*ZJ3EpXR)r5r32}w7`C$~r@7HOx`OGkWT7EcvHV^=-q{J0@Odo{)7WH?vO zs`2KabH*8GxOG*l8r!?ybVC<}7S=C!n>M+zYoqD-dKPYI zOJuM%H@m4b?h@;u6Hcb9von>>#+x1IoYCUer&DzHZFjTrG*uj>&16ic?qqUPu$q4P zF3+0x}pudEHOTD^Q# z9i4pWLZ^c+6q=2HysvwPxu7~Pla9C0rO<`r3@PUO)nz(K-jzwy!DG;%ECPVG<+|M<%KAq^uavYK=`bnD;j_1YbmP{K( zcFZQz&!gLU&vVBcrIO7iA8Q*{G`J>QE0?dTp1Yfr}t25lJd{&$+$pj@sqQmWMZZfTL z9KP<^kV>!5@Rep~G)?&tPrB{VSX-ha&M>*jd?&^)$9U|(IXwh)_+E#f(9$zCr;sKs zY^!4p&)JUm<$Y9#7DtzXxshFy7xU);TqZe_HqMxSMBz>m{WJ(%HpCKi;HGe6}eSKC6^Q(n!0uBwkbOb`X}?V z*d4~g`?*W}p!${;bx+>P?dHO|51A$J=QVQ^XmrCxv$hrNn7pLOCE-b1rx*kF^9{7m z>DCl=ZZ-8z5yoa!x$R4fc1;?sm*X@C?D$nM7uK%QIf{>F}r#)-H0 z!1l#v>)7pg!FC#gOws+FORB3ca7!+^Z1rrnJXjGt-z_UGJ-@V~w8AY}Nl6%vW<5SP zv|zU51T&l3v(YA+XVc!iO_$Q~WHgwiLDvbI#pY->>I9oI8Cp;A3hxsNhICcu!B{3+ zfh!AWg|*^skro;s<4%yq(0GtsoSUH|bG<`{XnQ-|vq)3^Q!|(L=J43(yh>tRYEJRy z`s-z(OIxmWQ2lh0Ea~)Nyucy}E;JaYrq@g|ldu zul}JvZ~N2I_gp{Mp>kS(NZ7dgKk4mX8HD5^s_DFz zHuCahG@|7NXLz8%a!mbKb3R^pe}2q?Wf2F4O46H+{%WjrekEy&BbbN})9t@~^LT|>;O!tB^tVrJuhY};+JzcAkQHs6;C(b&$zuH#`ZxmhSD}{GkJZAV*r;_GeT=VNVJjk;CF3X-b7dUzr6Jwbb zjP_EF_tN4dibJCySLV0SoO!pbyE4Cr=FE4=x-0WXXwLo&TK+s^_*7?5>|B|@MswB~ zl66<+hiJ~6eoS$_nZqAZGj}b1qVP(K&o;ck8M6FYB%G_@;+kK_Ss~oDc$482ADVM< z&9CEhiG8JIe}nKwi{B=^+v4{L-(~S9gb!N$CE-IB|Fv*UMfLNK!rf_}S$e@Q5qMdL8kQkNp#t{bt$kX&?LN zeE7>g{52o`8z25#AO5}%|BDZwN*$UnZqt4EaX$QHAAY(IFCotT*hzCPdjEHkaQ9@7 z>-|z#cs+lgLPhU+t`t5)>?N(8HsRVhy$|HuK2tBngNt4O>{Ko~CwiNm+k_99H|vh` znxx*n!Uy@|P%3&~_&wn}MQ5?M*?CHJgf|O+o;c=VWuv#@C&csh%m1|OE5!a?AN%)w z_+%RQ^XVV&!%y|$XZ!F{AHIk{n+Q6IkEhi@c~{&e?viE*8e zJ^v%Gd~v&3baWeq-IUvW?7!{99}yi__OF*YpTAXGkeNO0!(Z^>ulw+Ke7HmB#eDT1 zMI7Vy{X?Et$6Gup4@FM*(K*+$KSC-i_p!gghgVrTbG)>2F17d$Ieu6A=v?8$n|yf2 zhi~!WHxS3T%@TihT71zD2~fG!M`yPWzu(f?=yi+pu#f$tKKwZ!{)(ml>?E%NZ~EAO z;KQfUK%FnIPV(U{ag1B3wCil)s-?$WsSm%<(y5gA*IK+g>Q%7J;(R=CX|TBJG+VsE zGk4Zoyi$0l#S7PXiF>WZyANG%_UN_w174%OX3x<*Hg|q$ zg!Wo|!9vge8H?}u+(HxSpIF?H@%DA$+K+lg__k&L`$za=F30(U#e2Tz)%$0Q>!sy1 zda!``Q{kCAGc4|S^3Ey3)gOL7!{sc?zCoS?R#?1nR+X`@viQFp>78GeTf9`p$<-Er zBzYyZ$Z;YTZ>4nH)f7h}!wNQ}O0i9~{>P9)Mge|{vENYXb_ky3hSJ_dw>Wn%%o7aa@eQT|v^ z5u7&`%nP1B7MvfPKNidnE*J|I1Q(743+a9BSP~*%ZD;A3zvV8y#|>EyhsuK?%jHl- zFl0H+Z-_0o=|ywMay&FY7_wXsEeM7z=R*sFWtR74rNJ`G`!b5P<$YOMu*~wltUOp| zd0$o$EVH~Xn-?szye~UHSY~-&Ha}Qqd0)05Shmo)hCW-12FpuzVboK4Rcx}PTpdj* zu-#l3EVtY&FAbJkZkC6F<(8Y}lwg*d<>kS0%gyqNV7V3K@_E4uE6C;N2P;Nh_Y%B( zey~D)mz*zO5UjAgFJBm}u)MD*4OUp*SA>EU=R3{urmogth2?VveRN>?TtP?5LT7o^ z(#s+dhdv|BMzYb&dRpes{L94#}2eSEel#DRpA>AzU)zWFi|f$+**; ziX;;$C+@9z-yt;73t$q;L^9b_r!j1aJBehxBf{n_VoofUpl|jfGz?HLI@wrf7a2s? z(YFOuXMAHk7K!sK_ed%oF&`+9rlIXLRCr6H-;>3aWX)%ay2f7z`iZ3D?d+we812-> z(O23EGW6jZ)uXGiOjH-m{u%nJpflp+Ufpv9+nf1KU5XmqZmMzGI}?!&S^9c`_65^e zG@WHN^B$h&^l4%zzxj_i^vOfIGeH8QZ_3Leoc|H0HJ)mZWK$7dA${))&^Y&DHq}LY zHl-8s7PCZO9Hf)fGWsq=Y9%@PMufQT8ENKinRHi{VlQs+hXVv<&3r*Xt8J7PajKr) z%o}m~{H@F^q}wx*j%X~>(ZN!t@1qI{-GEoz~U`{I-eEsSo#Gn7o6w~>vWF19G-w8YvXPDd&eZ%c7^N1C}Ri5q1KRqK7#K~2;pQrE>uTN9b{ zcgYm`PX0`zy^}V}5@npXiM|;jv*tu6eO_zk$rMG7MdVXvV`w&-z+X!rYNk2IXh-7& z#Vt!wq+_Rr#sT&v6P2-r!YizkUUt(*FVQ4zZ==sT>Cly9lxHkK;i4F%qw7L3`u>A5 zq`ldM&!Om;Z)7;B;uP>`gb;nCc?};y)P;QbnJ9Ip5*-wE+7)8vWayY7M`@=-$9j_t z^%NT{!nI>vYTd8#3qkUrLke90ZO!hlO){G0ys&*w&vi z$=iYTm(is9MZ)d49S0osPw~Da%QF#||?8oashx@VH zlXrT6V;r`F4))_$z`j~Ec=mPRsKf7Vx$q2ib_2(JxF7fm+DGH|BjDVJ%6}?c`*$~O zDES&p` zQ+XFnTpj~^}85+ycCjxcYey@F?)_0B0TVDJT8o zaNtc~&+mD;u%C@IsXo8wFQM%&b$-xqVycxrsMfqgS=SNnb+ z`JPq_~sSfog0DK8>e(%hM{b{60 z?dyTJ0bea#+tn@YS_}5rt`@N8^Fl!Kb3JfuSEt3bT^m3j+qKQI*L>S@h#D0DJEDCDQL#14ln&7T5N!1AT1oHNtt^;PEOz6PM3gI+_pN7T5c`>wWaU z2pr>ZyQQQ0{JxtD_j@x<8nSqpsZFZQut0vzwl_`Nw7yS*zxpWCJ1XKi~O##RDUIRMV z-s^qr`F%PU_8;wU1CH&z1332Yw?LoU<;r+>AJ`**5IDB?QPAP`Zjkow1&;0g0qCIr zKlQPH-N&Ba%X8s4V0+&JUQOFd*oev>Ew0DQ2}gR{HP0Q%^G^t8eH{1B1$%Dqm!-X> zz_GpaEUx3;BGAWiuNpXxODlk{r+W3cUJabvTTc_081N*mXXQJYv~X_knQSO!190}= z6@I@l9(z@FoIuk_1y;26)H7T0**3i=q&ZvsdE?*`sT_3ClAA9x4w z=Y;c&+cn6^LgnXRkL`LB?73avmv+4k9NTr+;@YlBN1JL)eqy_h5ze!JRTOyMkt z`X^aj^XDw#b{>|3J^R03{GSIL^)Ilv`d{Uv9|n&7vI=;L>V03{ORfdpNnHD@33wH8 zEv>>i4jh|7*^mNz8Fau5tJ!=wlp) zfnywg2OQ&2IGw#6fBkukaBZ(6ex3;S++O7ifn$5apo8sNZgD-18bAlz6|?Mh9B#9? zj>8!roiAASs`EvQtIn5wbnf)Azt7^T|Dcb~9^lwt&jQChd;#=1{;u@P&%hq}&w*pV zya_s-hckHKqVhIy?61QX*F5|H^s&G6Wk1VeyN=?@s4&MoJP|m)A2~}n=OLdjDyPv8 zmAPP#?V1nvyr|Cs76He0Rasoy6&7xf=MBR7aH^&$KogfMEFJClt1YhA|8XDvByfyd z8aUVMa-~$ZS^9H4EPsgDi}N~SI_`bR(ouiz70&JAd{h6w3;O!)2Uqbh=wxVJ^}i3C z{ZxN`?4$Dv*k?g!GItUc?sx33BZYInbkU^so&fwB;HLt|y!!9LZT-bykNQ^u=WkuK z-d5lnfp-8;0M7#7M7&2j;985{Ap9QT+%MPC^roE0?*;qMg8sw6n}ELxJO=!iz|qfl zgll|CX&)}X1AEM?4}f#OYhF!}e`vt{h52y2#a-IYB>)`9z1hOqp8}d1WgI92d*t(h zFC}~JuPV^t)YIobOMr7zDrn-e9CVh^y6UX;v5)!KuLE8OI@^TX$K7_&$K!4%=-_d8 zD{zeScYSmo275g29tF-iE=^p10Xi6;gJ6%xOMwg^++Tb?>Xv_peX?-Q2kzfOnz)<} z9PIN|8sz&&UwN$Pr4;f=7T-wiSk9jKM(qgfwTT1nz&qI=?{wjaXQBz`Lp5uS$Cl zgFd$RL*UrnDf|azsOb3Snl;Bc4miePmT--OBhSHIu;(}^KLncntVH;HdM0#a-Hm%R9ogU-bO)KG@@V{4c<{U$h?!jx%!R`kdpxOZsJo za1Jl>6M$pC1V9Jle=gW#{6oNTys8z>`HAPddLRAOpo98tKK3ae`^`S~TYc%_?_>WgaLmsafpcEzIP(kOoDVwAyeVAAnMTQncfp?XLHX~2Zy~OE zew^HZb3d}ajx)1_b6)j;{h7kKUUS`eD=ko&13E3VuHX5TgH9`Pt@i@pc%N7c9P|HD z;o9Co9hbnK+pBynaLoVppo96J27AoUjlePg`+Ri1B-}nOz6m<0zaMlkp3j1P8^rCG zz}EqP4|K3ye*$}~x9|konF{xBFHPDnbA@x9QKt;-QD>=-{bfG(R{_U*TY+Q0CqbY4 z*Oh+X1op^34;=gb2GHU2kzW7z1IPB>3_94}uLH+?xKH@eq>ba@fRFwYmc3rTJq7w$ z?@OS={_FMIufe{WIOhi?&O+x0es{SL5S4?GGy4ZI)tCg2I+J-}1M_5D#l@FuXo6?hEz?ZCNTwA?9N z`(;p`59|he?ic0v1Ls(3dW54XPc-S*{o&kOAmzRZe{5e0{-e#}p z?|WG~m4-Ubkj1s%f9<3HTd-&U_1~Yo2ORzXlf~8l$tQUZaP!gs>B2eAU-V4O@3Fv9 z|3r(c|EKxr2Y@djW$l-9L5Gj%AsHu2!5;hZ0MkbIQw5o6PNda<8l3=a6PUa`MZfzCE(nx<_Hpg6mZOkV&SaA z{oX(mmy>~Wp4=dL^51~7eLWjfITQ3TALanZ{tAJP@zaxW7Jz-6nD*Djz;6P+6gbBD z)4(y#&A@RS?hvkVSR?*)f&DtDce7=$ao7U(=>PS=xqn^J|2lB&-~R#n93TC=nD>A^ z@_T_}|2_;l+>Z}PKYkB5_T!+%H6IRuKKAdAfMfr@ZRu!yeh>Ct>Xgw{iS?2 zaO|&t1Rd_LA?dGw2G0GpmL@LWw|JwWji3z_Gm}!nM7P zVt>Rb-U7SL?QQf{o$0`_y(bE19d57wJFmY1&h1ryT#L7f{@I|9?F|CQ{G10I$L-nd zG!^zgLX*blIEcfez`p=|AMhUm$9gNF-Y3DnUh17hOitmnMAs=6pJpiihwc{V_;Go_ z;%a|rs<&PB<@UjuAqL7%^~{`7iwA`3zc*2P)#1NS$c6c4UXc2}3Y`15RPy@9?nmfW>*t;_|%3dpzv8 zGUs}wsfJWqytBXqjW(D5<7*Nws-u6u_7M+{a{YkdO^fT_oh@VmDypM@ced2x`gd@{ Y7T3S0+h*}j$?qF1zEk*aiw_C^4|QpA$^ZZW diff --git a/source/unres/src_MD/unres.F b/source/unres/src_MD/unres.F index 067f4d8..02f3fb6 100644 --- a/source/unres/src_MD/unres.F +++ b/source/unres/src_MD/unres.F @@ -52,7 +52,7 @@ c call memmon_print_usage() call init_task if (me.eq.king) - & write(iout,*)'### LAST MODIFIED 11/03/09 1:19PM by czarek' + & write(iout,*)'### LAST MODIFIED 03/28/12 23:29 by czarek' if (me.eq.king) call cinfo C Read force field parameters and job setup data call readrtns @@ -754,9 +754,11 @@ c--------------------------------------------------------------------------- C Conformational Space Annealling programmed by Jooyoung Lee. C This method works only with parallel machines! #ifdef MPI - call together +csa call together + write (iout,*) "CSA is not supported in this version" #else - write (iout,*) "CSA works on parallel machines only" +csa write (iout,*) "CSA works on parallel machines only" + write (iout,*) "CSA is not supported in this version" #endif return end -- 1.7.9.5