+++ /dev/null
- 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)
+++ /dev/null
- 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
-
+++ /dev/null
- 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
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)
+++ /dev/null
-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------------------------------------------------------------------------
+++ /dev/null
- 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)
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
& 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
+++ /dev/null
- 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
& 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
+++ /dev/null
- 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
+++ /dev/null
- 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
-
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)
+++ /dev/null
-********************************************************************************
-* 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
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
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
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
t_enegrad=t_enegrad+tcpu()-tt0
#endif
endif
+
+
+
return
end
c-----------------------------------------------------------
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
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
& '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
-Makefile_single_gfortran
\ No newline at end of file
+Makefile_ifort
\ No newline at end of file
+++ /dev/null
-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
+++ /dev/null
-#!/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'
+++ /dev/null
-#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
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
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...'
+++ /dev/null
-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
-
+++ /dev/null
-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
+++ /dev/null
- subroutine make_array
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.CSA'
-
-ccccccccccccccccccccccccc
-c Level-2: group
-ccccccccccccccccccccccccc
-
- indg=0
- do k=1,numch
-ccccccccccccccccccccccccccccccccccccccccc
-! Groups the THETAs and the GAMMAs
- do j=2,nres-1
- indg=indg+1
- if (j.lt.nres-1) then
- ngroup(indg)=2
- else
- ngroup(indg)=1
- endif
- do i=1,ngroup(indg)
- igroup(1,i,indg)=i
- igroup(2,i,indg)=j
- igroup(3,i,indg)=k
- enddo
- enddo
-ccccccccccccccccccccccccccccccccccccccccc
- enddo
-! Groups the ALPHAs and the BETAs
- do k=1,numch
- do j=2,nres-1
- if(itype(j).ne.10) then
- indg=indg+1
- ngroup(indg)=2
- do i=1,ngroup(indg)
- igroup(1,i,indg)=i+2
- igroup(2,i,indg)=j
- igroup(3,i,indg)=k
- enddo
- endif
- enddo
- enddo
-
- ntotgr=indg
- write(iout,*)
- write(iout,*) "# of groups: ",ntotgr
- do i=1,ntotgr
- write(iout,41) i,ngroup(i),((igroup(k,j,i),k=1,3),j=1,ngroup(i))
- enddo
-! close(iout)
-
- 40 format(i3,3x,3i3)
- 41 format(2i3,3x,6(3i3,2x))
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine make_ranvar(n,m,idum)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.BANK'
-c al m=0
- print *,'HOHOHOHO Make_RanVar!!!!!',n,m
- itrial=0
- do while(m.lt.n .and. itrial.le.10000)
- itrial=itrial+1
- jeden=1
- call gen_rand_conf(jeden,*10)
-! call intout
- m=m+1
- do j=2,nres-1
- dihang_in(1,j,1,m)=theta(j+1)
- dihang_in(2,j,1,m)=phi(j+2)
- dihang_in(3,j,1,m)=alph(j)
- dihang_in(4,j,1,m)=omeg(j)
- enddo
- dihang_in(2,nres-1,1,m)=0.0d0
- goto 20
- 10 write (iout,*) 'Failed to generate conformation #',m+1,
- & ' itrial=',itrial
- 20 continue
- enddo
- print *,'Make_RanVar!!!!! m=',m,' itrial=',itrial
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine make_ranvar_reg(n,idum)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.BANK'
- include 'COMMON.GEO'
- m=0
- print *,'HOHOHOHO Make_RanVar!!!!!'
- itrial=0
- do while(m.lt.n .and. itrial.le.10000)
- itrial=itrial+1
- jeden=1
- call gen_rand_conf(jeden,*10)
-! call intout
- m=m+1
- do j=2,nres-1
- dihang_in(1,j,1,m)=theta(j+1)
- dihang_in(2,j,1,m)=phi(j+2)
- dihang_in(3,j,1,m)=alph(j)
- dihang_in(4,j,1,m)=omeg(j)
- if(m.le.n*0.1) then
- dihang_in(1,j,1,m)=90.0*deg2rad
- dihang_in(2,j,1,m)=50.0*deg2rad
- endif
- enddo
- dihang_in(2,nres-1,1,m)=0.0d0
- goto 20
- 10 write (iout,*) 'Failed to generate conformation #',m+1,
- & ' itrial=',itrial
- 20 continue
- enddo
- print *,'Make_RanVar!!!!! m=',m,' itrial=',itrial
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine from_pdb(n,idum)
-c This subroutine stores the UNRES int variables generated from
-c subroutine readpdb into the 1st conformation of in dihang_in.
-c Subsequent n-1 conformations of dihang_in have identical values
-c of theta and phi as the 1st conformation but random values for
-c alph and omeg.
-c The array cref (also generated from subroutine readpdb) is stored
-c to crefjlee to be used for rmsd calculation in CSA, if necessary.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.BANK'
- include 'COMMON.GEO'
-
- m=1
- do j=2,nres-1
- dihang_in(1,j,1,m)=theta(j+1)
- dihang_in(2,j,1,m)=phi(j+2)
- dihang_in(3,j,1,m)=alph(j)
- dihang_in(4,j,1,m)=omeg(j)
- enddo
- dihang_in(2,nres-1,1,k)=0.0d0
-
- do m=2,n
- do k=2,nres-1
- dihang_in(1,k,1,m)=dihang_in(1,k,1,1)
- dihang_in(2,k,1,m)=dihang_in(2,k,1,1)
- if(dabs(dihang_in(3,k,1,1)).gt.1.d-6) then
- dihang_in(3,k,1,m)=90.d0*ran1(idum)+90.d0
- dihang_in(3,k,1,m)=dihang_in(3,k,1,m)*deg2rad
- endif
- if(dabs(dihang_in(4,k,1,1)).gt.1.d-6) then
- dihang_in(4,k,1,m)=360.d0*ran1(idum)-180.d0
- dihang_in(4,k,1,m)=dihang_in(4,k,1,m)*deg2rad
- endif
- enddo
- enddo
-
-c Store cref to crefjlee (they are in COMMON.CHAIN).
- do k=1,2*nres
- do kk=1,3
- crefjlee(kk,k)=cref(kk,k)
- enddo
- enddo
-
- open(icsa_native_int,file=csa_native_int,status="old")
- do m=1,n
- write(icsa_native_int,*) m,e
- write(icsa_native_int,200)
- & (dihang_in(1,k,1,m)*rad2deg,k=2,nres-1)
- write(icsa_native_int,200)
- & (dihang_in(2,k,1,m)*rad2deg,k=2,nres-2)
- write(icsa_native_int,200)
- & (dihang_in(3,k,1,m)*rad2deg,k=2,nres-1)
- write(icsa_native_int,200)
- & (dihang_in(4,k,1,m)*rad2deg,k=2,nres-1)
- enddo
-
- do k=1,nres
- write(icsa_native_int,200) (crefjlee(i,k),i=1,3)
- enddo
- close(icsa_native_int)
-
- 200 format (8f10.4)
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine from_int(n,mm,idum)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.BANK'
- include 'COMMON.GEO'
- include 'COMMON.CONTACTS'
- integer ilen
- external ilen
- logical fail
- double precision energia(0:n_ene)
-
- open(icsa_native_int,file=csa_native_int,status="old")
- read (icsa_native_int,*)
- call read_angles(icsa_native_int,*10)
- goto 11
- 10 write (iout,'(2a)') "CHUJ NASTAPIL - error in ",
- & csa_native_int(:ilen(csa_native_int))
- 11 continue
- call intout
- do j=2,nres-1
- dihang_in(1,j,1,1)=theta(j+1)
- dihang_in(2,j,1,1)=phi(j+2)
- dihang_in(3,j,1,1)=alph(j)
- dihang_in(4,j,1,1)=omeg(j)
- enddo
- dihang_in(2,nres-1,1,1)=0.0d0
-
-c read(icsa_native_int,*) ind,e
-c read(icsa_native_int,200) (dihang_in(1,k,1,1),k=2,nres-1)
-c read(icsa_native_int,200) (dihang_in(2,k,1,1),k=2,nres-2)
-c read(icsa_native_int,200) (dihang_in(3,k,1,1),k=2,nres-1)
-c read(icsa_native_int,200) (dihang_in(4,k,1,1),k=2,nres-1)
-c dihang_in(2,nres-1,1,1)=0.d0
-
- maxsi=100
- maxcount_fail=100
-
- do m=mm+2,n
-c do k=2,nres-1
-c dihang_in(1,k,1,m)=dihang_in(1,k,1,1)
-c dihang_in(2,k,1,m)=dihang_in(2,k,1,1)
-c if(abs(dihang_in(3,k,1,1)).gt.1.d-3) then
-c dihang_in(3,k,1,m)=90.d0*ran1(idum)+90.d0
-c endif
-c if(abs(dihang_in(4,k,1,1)).gt.1.d-3) then
-c dihang_in(4,k,1,m)=360.d0*ran1(idum)-180.d0
-c endif
-c enddo
-c call intout
- fail=.true.
-
- icount_fail=0
-
- DO WHILE (FAIL .AND. ICOUNT_FAIL .LE. MAXCOUNT_FAIL)
-
- do i=nnt,nct
- if (itype(i).ne.10) then
-cd print *,'i=',i,' itype=',itype(i),' theta=',theta(i+1)
- fail=.true.
- ii=0
- do while (fail .and. ii .le. maxsi)
- call gen_side(itype(i),theta(i+1),alph(i),omeg(i),fail)
- ii = ii+1
- enddo
- endif
- enddo
- call chainbuild
- call etotal(energia(0))
- fail = (energia(0).ge.1.0d20)
- icount_fail=icount_fail+1
-
- ENDDO
-
- if (icount_fail.gt.maxcount_fail) then
- write (iout,*)
- & 'Failed to generate non-overlaping near-native conf.',
- & m
- endif
-
- do j=2,nres-1
- dihang_in(1,j,1,m)=theta(j+1)
- dihang_in(2,j,1,m)=phi(j+2)
- dihang_in(3,j,1,m)=alph(j)
- dihang_in(4,j,1,m)=omeg(j)
- enddo
- dihang_in(2,nres-1,1,m)=0.0d0
- enddo
-
-c do m=1,n
-c write(icsa_native_int,*) m,e
-c write(icsa_native_int,200) (dihang_in(1,k,1,m),k=2,nres-1)
-c write(icsa_native_int,200) (dihang_in(2,k,1,m),k=2,nres-2)
-c write(icsa_native_int,200) (dihang_in(3,k,1,m),k=2,nres-1)
-c write(icsa_native_int,200) (dihang_in(4,k,1,m),k=2,nres-1)
-c enddo
-c close(icsa_native_int)
-
-c do m=mm+2,n
-c do i=1,4
-c do j=2,nres-1
-c dihang_in(i,j,1,m)=dihang_in(i,j,1,m)*deg2rad
-c enddo
-c enddo
-c enddo
-
- call dihang_to_c(dihang_in(1,1,1,1))
-
-c Store c to cref (they are in COMMON.CHAIN).
- do k=1,2*nres
- do kk=1,3
- crefjlee(kk,k)=c(kk,k)
- enddo
- enddo
-
- call contact(.true.,ncont_ref,icont_ref,co)
-
-c do k=1,nres
-c write(icsa_native_int,200) (crefjlee(i,k),i=1,3)
-c enddo
- close(icsa_native_int)
-
- 200 format (8f10.4)
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine dihang_to_c(aarray)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
-
- dimension aarray(mxang,maxres,mxch)
-
-c do i=4,nres
-c phi(i)=dihang_in(1,i-2,1,1)
-c enddo
- do i=2,nres-1
- theta(i+1)=aarray(1,i,1)
- phi(i+2)=aarray(2,i,1)
- alph(i)=aarray(3,i,1)
- omeg(i)=aarray(4,i,1)
- enddo
-
- call chainbuild
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
+++ /dev/null
-cccccccccccccccccccccccccccccccccc
- subroutine get_diff12(aarray,barray,diff)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- dimension aarray(mxang,maxres,mxch),
- & barray(mxang,maxres,mxch)
-
- diff=0.d0
- do k=1,numch
- do j=2,nres-1
-c do i=1,4
-c do i=1,2
- do i=1,ndiff
- dif=rad2deg*dabs(aarray(i,j,k)-barray(i,j,k))
- if(dif.gt.180.) dif=360.-dif
- if (dif.gt.diffcut) diff=diff+dif
- enddo
- enddo
- enddo
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
+++ /dev/null
- subroutine distfit(debug,maxit)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- DIMENSION X(MAXRES),DIAGH(MAXRES),phiold(maxres)
- logical debug,sing
-
-cinput------------------------------------
-c NX=NRES-3
-c NY=((NRES-4)*(NRES-5))/2
-cinput------------------------------------
-ctest MAXIT=20
- TOL=0.5
- MAXMAR=10
- RL=100.0
-
- CALL TRANSFER(NRES,phi,phiold)
-
- F0=RDIF()
-
-cd WRITE (IOUT,*) 'DISTFIT: F0=',F0
-
-
- DO IT=1,MAXIT
- CALL RDERIV
- CALL HEVAL
-
- DO I=1,NX
- DIAGH(I)=H(I,I)
- ENDDO
- RL=RL*0.1
-
- DO IMAR=1,MAXMAR
- DO I=1,NX
- H(I,I)=DIAGH(I)+RL
- ENDDO
- CALL TRANSFER(NX,XX,X)
- CALL BANACH(NX,MAXRES,H,X,sing)
- AIN=0.0
- DO I=1,NX
- AIN=AIN+DABS(X(I))
- ENDDO
- IF (AIN.LT.0.1*TOL .AND. RL.LT.1.0E-4) THEN
- if (debug) then
- WRITE (IOUT,*) 'DISTFIT: CONVERGENCE HAS BEEN ACHIEVED'
- WRITE (IOUT,*) 'IT=',it,'F=',F0
- endif
- RETURN
- ENDIF
- DO I=4,NRES
- phi(I)=phiold(I)+mask(i)*X(I-3)
-c print *,X(I-3)
- ENDDO
-
- F1=RDIF()
-cd WRITE (IOUT,*) 'IMAR=',IMAR,' RL=',RL,' F1=',F1
- IF (F1.LT.F0) THEN
- CALL TRANSFER(NRES,phi,phiold)
- F0=F1
- GOTO 1
- ELSE IF (DABS(F1-F0).LT.1.0E-5) THEN
- if (debug) then
- WRITE (IOUT,*) 'DISTFIT: CANNOT IMPROVE DISTANCE FIT'
- WRITE (IOUT,*) 'IT=',it,'F=',F1
- endif
- RETURN
- ENDIF
- RL=RL*10.0
- ENDDO
- WRITE (IOUT,*) 'DISTFIT: MARQUARDT PROCEDURE HAS FAILED'
- WRITE (IOUT,*) 'IT=',it,'F=',F0
- CALL TRANSFER(NRES,phiold,phi)
- RETURN
- 1 continue
-cd write (iout,*) "it",it," imar",imar," f0",f0
- enddo
- WRITE (IOUT,*) 'DISTFIT: FINAL F=',F0,'after MAXIT=',maxit
- return
- END
-
- double precision FUNCTION RDIF()
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DISTFIT'
-
-c print *,'in rdif'
-
- suma=0.0
- ind=0
- call chainbuild
- do i=1,nres-3
- do j=i+3,nres
- ind=ind+1
- if (w(ind).ne.0.0) then
- DIJ=DIST(i,j)
- suma=suma+w(ind)*(DIJ-d0(ind))*(DIJ-d0(ind))
- DD(ind)=DIJ
-c print '(2i3,i4,4f12.2)',i,j,ind,dij,d0(ind),w(ind),suma
- endif
- enddo
- enddo
-
- RDIF=suma
- RETURN
- END
-
- SUBROUTINE RDERIV
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DISTFIT'
- include 'COMMON.GEO'
- DIMENSION E12(3),R13(3),R24(3),PRODU(3)
-
- DO I=1,NY
- DO J=1,NX
- DRDG(I,J)=0.0
- ENDDO
- ENDDO
- DO I=1,NX
- I1=I+1
- I2=I+2
- CALL VEC(I1,I2,E12)
- DO J=1,I
- DO K=1,3
- R13(K)=C(K,J)-C(K,I1)
- ENDDO
- DO K=I2+1,NRES
- DO L=1,3
- R24(L)=C(L,K)-C(L,I2)
- ENDDO
- IND=((J-1)*(2*NRES-J-6))/2+K-3
- PRODU(1)=R13(2)*R24(3)-R13(3)*R24(2)
- PRODU(2)=R13(3)*R24(1)-R13(1)*R24(3)
- PRODU(3)=R13(1)*R24(2)-R13(2)*R24(1)
- DRDG(IND,I)=SCALAR(E12,PRODU)/DIST(J,K)
- ENDDO
- ENDDO
- ENDDO
- RETURN
- END
-
- SUBROUTINE HEVAL
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DISTFIT'
-
- DO I=1,NX
- XI=0.0
- HII=0.0
- DO K=1,NY
- BKI=DRDG(K,I)
- BKIWK=w(K)*BKI
- XI=XI+BKIWK*(D0(K)-DD(K))
- HII=HII+BKI*BKIWK
- ENDDO
- H(I,I)=HII
- XX(I)=XI
- DO J=I+1,NX
- HIJ=0.0
- DO K=1,NY
- HIJ=HIJ+DRDG(K,I)*DRDG(K,J)*w(K)
- ENDDO
- H(I,J)=HIJ
- H(J,I)=HIJ
- ENDDO
- ENDDO
- RETURN
- END
-
-
- SUBROUTINE VEC(I,J,U)
-*
-* Find the unit vector from atom (I) to atom (J). Store in U.
-*
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- DIMENSION U(3)
-
- ANORM=0.0
- DO K=1,3
- UK=C(K,J)-C(K,I)
- ANORM=ANORM+UK*UK
- U(K)=UK
- ENDDO
- ANORM=SQRT(ANORM)
- DO K=1,3
- U(K)=U(K)/ANORM
- ENDDO
- RETURN
- END
-
- SUBROUTINE TRANSFER(N,X1,X2)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- DIMENSION X1(N),X2(N)
- DO 1 I=1,N
- 1 X2(I)=X1(I)
- RETURN
- END
-
+++ /dev/null
-C-----------------------------------------------------------------------
- double precision function sscale(r)
- double precision r,gamm
- include "COMMON.SPLITELE"
- if(r.lt.r_cut-rlamb) then
- sscale=1.0d0
- else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
- gamm=(r-(r_cut-rlamb))/rlamb
- sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
- else
- sscale=0d0
- endif
- return
- end
-C-----------------------------------------------------------------------
- subroutine elj_long(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJ potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (accur=1.0d-10)
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.TORSION'
- include 'COMMON.SBRIDGE'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
- dimension gg(3)
-c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
-cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
-cd & 'iend=',iend(i,iint)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rij=xj*xj+yj*yj+zj*zj
- sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
- if (sss.lt.1.0d0) then
- rrij=1.0D0/rij
- eps0ij=eps(itypi,itypj)
- fac=rrij**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e1+e2
- evdw=evdw+(1.0d0-sss)*evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-rrij*(e1+evdwij)*(1.0d0-sss)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
-C******************************************************************************
-C
-C N O T E !!!
-C
-C To save time, the factor of 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 elj_short(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJ potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (accur=1.0d-10)
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.TORSION'
- include 'COMMON.SBRIDGE'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
- dimension gg(3)
-c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C Change 12/1/95
- num_conti=0
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
-cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
-cd & 'iend=',iend(i,iint)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
-C Change 12/1/95 to calculate four-body interactions
- rij=xj*xj+yj*yj+zj*zj
- sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
- if (sss.gt.0.0d0) then
- rrij=1.0D0/rij
- eps0ij=eps(itypi,itypj)
- fac=rrij**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e1+e2
- evdw=evdw+sss*evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-rrij*(e1+evdwij)*sss
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
-C******************************************************************************
-C
-C N O T E !!!
-C
-C To save time, the factor of 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 eljk_long(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJK potential of interaction.
-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.IOUNITS'
- include 'COMMON.NAMES'
- dimension gg(3)
- logical scheck
-c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- r_inv_ij=dsqrt(rrij)
- rij=1.0D0/r_inv_ij
- sss=sscale(rij/sigma(itypi,itypj))
- if (sss.lt.1.0d0) then
- r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
- fac=r_shift_inv**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e_augm+e1+e2
-cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
-cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
-cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
-cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- evdw=evdw+(1.0d0-sss)*evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
- fac=fac*(1.0d0-sss)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
- return
- end
-C-----------------------------------------------------------------------------
- subroutine eljk_short(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJK potential of interaction.
-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.IOUNITS'
- include 'COMMON.NAMES'
- dimension gg(3)
- logical scheck
-c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- r_inv_ij=dsqrt(rrij)
- rij=1.0D0/r_inv_ij
- sss=sscale(rij/sigma(itypi,itypj))
- if (sss.gt.0.0d0) then
- r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
- fac=r_shift_inv**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e_augm+e1+e2
-cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
-cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
-cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
-cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- evdw=evdw+sss*evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
- fac=fac*sss
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
- return
- end
-C-----------------------------------------------------------------------------
- subroutine ebp_long(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Berne-Pechukas potential of interaction.
-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.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
-c double precision rrsave(maxdim)
- logical lprn
- evdw=0.0D0
-c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
-c if (icall.eq.0) then
-c lprn=.true.
-c else
- lprn=.false.
-c endif
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- 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(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- 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)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.lt.1.0d0) then
-
-C Calculate the angle-dependent terms of energy & contributions to derivatives.
- call sc_angular
-C Calculate whole angle-dependent part of epsilon and contributions
-C to its derivatives
- fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*(1.0d0-sss)
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & epsi,sigm,chi1,chi2,chip1,chip2,
-cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
-cd & om1,om2,om12,1.0D0/dsqrt(rrij),
-cd & evdwij
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)
- sigder=fac/sigsq
- fac=rrij*fac
-C Calculate radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate the angular part of the gradient and sum add the contributions
-C to the appropriate components of the Cartesian gradient.
- call sc_grad_scale(1.0d0-sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
-c stop
- return
- end
-C-----------------------------------------------------------------------------
- subroutine ebp_short(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Berne-Pechukas potential of interaction.
-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.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
-c double precision rrsave(maxdim)
- logical lprn
- evdw=0.0D0
-c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
-c if (icall.eq.0) then
-c lprn=.true.
-c else
- lprn=.false.
-c endif
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- 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(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- 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)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.gt.0.0d0) then
-
-C Calculate the angle-dependent terms of energy & contributions to derivatives.
- call sc_angular
-C Calculate whole angle-dependent part of epsilon and contributions
-C to its derivatives
- fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*sss
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & epsi,sigm,chi1,chi2,chip1,chip2,
-cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
-cd & om1,om2,om12,1.0D0/dsqrt(rrij),
-cd & evdwij
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)
- sigder=fac/sigsq
- fac=rrij*fac
-C Calculate radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate the angular part of the gradient and sum add the contributions
-C to the appropriate components of the Cartesian gradient.
- call sc_grad_scale(sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
-c stop
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egb_long(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne potential of interaction.
-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.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- include 'COMMON.CONTROL'
- logical lprn
- evdw=0.0D0
-ccccc energy_dec=.false.
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.false.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- 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(i+nres)
-c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
-c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
-c & 1.0d0/vbld(j+nres)
-c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
- sig0ij=sigma(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- 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)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.lt.1.0d0) then
-
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
-c for diagnostics; uncomment
-c rij_shift=1.2*sig0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
-cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
-c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*(1.0d0-sss)
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij
- endif
-
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw',i,j,evdwij
-
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac
-c fac=0.0d0
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
- call sc_grad_scale(1.0d0-sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
-c write (iout,*) "Number of loop steps in EGB:",ind
-cccc energy_dec=.false.
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egb_short(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne potential of interaction.
-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.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- include 'COMMON.CONTROL'
- logical lprn
- evdw=0.0D0
-ccccc energy_dec=.false.
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.false.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- 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(i+nres)
-c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
-c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
-c & 1.0d0/vbld(j+nres)
-c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
- sig0ij=sigma(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- 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)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.gt.0.0d0) then
-
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
-c for diagnostics; uncomment
-c rij_shift=1.2*sig0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
-cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
-c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*sss
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij
- endif
-
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw',i,j,evdwij
-
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac
-c fac=0.0d0
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
- call sc_grad_scale(sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
-c write (iout,*) "Number of loop steps in EGB:",ind
-cccc energy_dec=.false.
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egbv_long(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne-Vorobjev potential of interaction.
-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.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
- logical lprn
- evdw=0.0D0
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.true.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- 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(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- sig0ij=sigma(itypi,itypj)
- r0ij=r0(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- 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)
-
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.lt.1.0d0) then
-
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+r0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
- & chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij+e_augm
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac-2*expon*rrij*e_augm
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
- call sc_grad_scale(1.0d0-sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- end
-C-----------------------------------------------------------------------------
- subroutine egbv_short(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne-Vorobjev potential of interaction.
-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.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
- logical lprn
- evdw=0.0D0
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.true.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- 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(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- sig0ij=sigma(itypi,itypj)
- r0ij=r0(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- 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)
-
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.gt.0.0d0) then
-
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+r0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+(evdwij+e_augm)*sss
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
- & chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij+e_augm
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac-2*expon*rrij*e_augm
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
- call sc_grad_scale(sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- end
-C----------------------------------------------------------------------------
- subroutine sc_grad_scale(scalfac)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.CALC'
- include 'COMMON.IOUNITS'
- double precision dcosom1(3),dcosom2(3)
- double precision scalfac
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
- eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
- & -2.0D0*alf12*eps3der+sigder*sigsq_om12
-c diagnostics only
-c eom1=0.0d0
-c eom2=0.0d0
-c eom12=evdwij*eps1_om12
-c end diagnostics
-c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
-c & " sigder",sigder
-c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
-c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
- 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
- do k=1,3
- gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac
- enddo
-c write (iout,*) "gg",(gg(k),k=1,3)
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
- & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
- & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac
-c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
-c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
-c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
-c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- enddo
-C
-C Calculate the components of the gradient in DC and X
-C
- do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
- enddo
- return
- end
-C--------------------------------------------------------------------------
- subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
-C
-C This subroutine calculates the average interaction energy and its gradient
-C in the virtual-bond vectors between non-adjacent peptide groups, based on
-C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
-C The potential depends both on the distance of peptide-group centers and on
-C the orientation of the CA-CA virtual bonds.
-C
- implicit real*8 (a-h,o-z)
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.TIME1'
- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
- & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
- double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
-c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- double precision scal_el /1.0d0/
-#else
- double precision scal_el /0.5d0/
-#endif
-C 12/13/98
-C 13-go grudnia roku pamietnego...
- double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
- & 0.0d0,1.0d0,0.0d0,
- & 0.0d0,0.0d0,1.0d0/
-cd write(iout,*) 'In EELEC'
-cd do i=1,nloctyp
-cd write(iout,*) 'Type',i
-cd write(iout,*) 'B1',B1(:,i)
-cd write(iout,*) 'B2',B2(:,i)
-cd write(iout,*) 'CC',CC(:,:,i)
-cd write(iout,*) 'DD',DD(:,:,i)
-cd write(iout,*) 'EE',EE(:,:,i)
-cd enddo
-cd call check_vecgrad
-cd stop
- if (icheckgrad.eq.1) then
- do i=1,nres-1
- fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
- do k=1,3
- dc_norm(k,i)=dc(k,i)*fac
- enddo
-c write (iout,*) 'i',i,' fac',fac
- enddo
- endif
- if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
- & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
- & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
-c call vec_and_deriv
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
- call set_matrices
-#ifdef TIMING
- time_mat=time_mat+MPI_Wtime()-time01
-#endif
- endif
-cd do i=1,nres-1
-cd write (iout,*) 'i=',i
-cd do k=1,3
-cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
-cd enddo
-cd do k=1,3
-cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
-cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
-cd enddo
-cd enddo
- t_eelecij=0.0d0
- ees=0.0D0
- evdw1=0.0D0
- eel_loc=0.0d0
- eello_turn3=0.0d0
- eello_turn4=0.0d0
- ind=0
- do i=1,nres
- num_cont_hb(i)=0
- enddo
-cd print '(a)','Enter EELEC'
-cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
- do i=1,nres
- gel_loc_loc(i)=0.0d0
- gcorr_loc(i)=0.0d0
- enddo
-c
-c
-c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
-C
-C Loop over i,i+2 and i,i+3 pairs of the peptide groups
-C
- do i=iturn3_start,iturn3_end
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=0
- call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
- if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
- num_cont_hb(i)=num_conti
- enddo
- do i=iturn4_start,iturn4_end
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=num_cont_hb(i)
- call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
- if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
- num_cont_hb(i)=num_conti
- enddo ! i
-c
-c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
-c
- do i=iatel_s,iatel_e
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
-c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
- num_conti=num_cont_hb(i)
- do j=ielstart(i),ielend(i)
- call eelecij_scale(i,j,ees,evdw1,eel_loc)
- enddo ! j
- num_cont_hb(i)=num_conti
- enddo ! i
-c write (iout,*) "Number of loop steps in EELEC:",ind
-cd do i=1,nres
-cd write (iout,'(i3,3f10.5,5x,3f10.5)')
-cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
-cd enddo
-c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
-ccc eel_loc=eel_loc+eello_turn3
-cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
- return
- end
-C-------------------------------------------------------------------------------
- subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.TIME1'
- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
- & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
- double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
-c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- double precision scal_el /1.0d0/
-#else
- double precision scal_el /0.5d0/
-#endif
-C 12/13/98
-C 13-go grudnia roku pamietnego...
- double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
- & 0.0d0,1.0d0,0.0d0,
- & 0.0d0,0.0d0,1.0d0/
-c time00=MPI_Wtime()
-cd write (iout,*) "eelecij",i,j
- ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- aaa=app(iteli,itelj)
- bbb=bpp(iteli,itelj)
- ael6i=ael6(iteli,itelj)
- ael3i=ael3(iteli,itelj)
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- dx_normj=dc_norm(1,j)
- dy_normj=dc_norm(2,j)
- dz_normj=dc_norm(3,j)
- xj=c(1,j)+0.5D0*dxj-xmedi
- yj=c(2,j)+0.5D0*dyj-ymedi
- zj=c(3,j)+0.5D0*dzj-zmedi
- rij=xj*xj+yj*yj+zj*zj
- rrmij=1.0D0/rij
- rij=dsqrt(rij)
- rmij=1.0D0/rij
-c For extracting the short-range part of Evdwpp
- sss=sscale(rij/rpp(iteli,itelj))
-
- r3ij=rrmij*rmij
- r6ij=r3ij*r3ij
- cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
- cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
- cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
- fac=cosa-3.0D0*cosb*cosg
- ev1=aaa*r6ij*r6ij
-c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
- if (j.eq.i+2) ev1=scal_el*ev1
- ev2=bbb*r6ij
- fac3=ael6i*r6ij
- fac4=ael3i*r3ij
- evdwij=ev1+ev2
- el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
- el2=fac4*fac
- eesij=el1+el2
-C 12/26/95 - for the evaluation of multi-body H-bonding interactions
- ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
- ees=ees+eesij
- evdw1=evdw1+evdwij*(1.0d0-sss)
-cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
-cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
-cd & xmedi,ymedi,zmedi,xj,yj,zj
-
- if (energy_dec) then
- write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
- write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
- endif
-
-C
-C Calculate contributions to the Cartesian gradient.
-C
-#ifdef SPLITELE
- facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
- facel=-3*rrmij*(el1+eesij)
- fac1=fac
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
-*
-* Radial derivatives. First process both termini of the fragment (i,j)
-*
- ggg(1)=facel*xj
- ggg(2)=facel*yj
- ggg(3)=facel*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c gelc(k,j)=gelc(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
-c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-#else
- facvdw=ev1+evdwij*(1.0d0-sss)
- facel=el1+eesij
- fac1=fac
- fac=-3*rrmij*(facvdw+facvdw+facel)
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
-*
-* Radial derivatives. First process both termini of the fragment (i,j)
-*
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c gelc(k,j)=gelc(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gelc_long(k,j)=gelc(k,j)+ggg(k)
- gelc_long(k,i)=gelc(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
-#endif
-*
-* Angular part
-*
- ecosa=2.0D0*fac3*fac1+fac4
- fac4=-3.0D0*fac4
- fac3=-6.0D0*fac3
- ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
- ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
-cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
-cd & (dcosg(k),k=1,3)
- do k=1,3
- ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
- enddo
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
-c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
-c gelc(k,j)=gelc(k,j)+ghalf
-c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
-c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
-c enddo
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
- do k=1,3
- gelc(k,i)=gelc(k,i)
- & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gelc(k,j)=gelc(k,j)
- & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
- enddo
- IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
- & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
- & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
-C
-C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
-C energy of a peptide unit is assumed in the form of a second-order
-C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
-C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
-C are computed for EVERY pair of non-contiguous peptide groups.
-C
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- kkk=0
- do k=1,2
- do l=1,2
- kkk=kkk+1
- muij(kkk)=mu(k,i)*mu(l,j)
- enddo
- enddo
-cd write (iout,*) 'EELEC: i',i,' j',j
-cd write (iout,*) 'j',j,' j1',j1,' j2',j2
-cd write(iout,*) 'muij',muij
- ury=scalar(uy(1,i),erij)
- urz=scalar(uz(1,i),erij)
- vry=scalar(uy(1,j),erij)
- vrz=scalar(uz(1,j),erij)
- a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
- a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
- a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
- a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
- fac=dsqrt(-ael6i)*r3ij
- a22=a22*fac
- a23=a23*fac
- a32=a32*fac
- a33=a33*fac
-cd write (iout,'(4i5,4f10.5)')
-cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
-cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
-cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
-cd & uy(:,j),uz(:,j)
-cd write (iout,'(4f10.5)')
-cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
-cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
-cd write (iout,'(4f10.5)') ury,urz,vry,vrz
-cd write (iout,'(9f10.5/)')
-cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
-C Derivatives of the elements of A in virtual-bond vectors
- call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
- do k=1,3
- uryg(k,1)=scalar(erder(1,k),uy(1,i))
- uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
- uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
- urzg(k,1)=scalar(erder(1,k),uz(1,i))
- urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
- urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
- vryg(k,1)=scalar(erder(1,k),uy(1,j))
- vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
- vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
- vrzg(k,1)=scalar(erder(1,k),uz(1,j))
- vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
- vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
- enddo
-C Compute radial contributions to the gradient
- facr=-3.0d0*rrmij
- a22der=a22*facr
- a23der=a23*facr
- a32der=a32*facr
- a33der=a33*facr
- agg(1,1)=a22der*xj
- agg(2,1)=a22der*yj
- agg(3,1)=a22der*zj
- agg(1,2)=a23der*xj
- agg(2,2)=a23der*yj
- agg(3,2)=a23der*zj
- agg(1,3)=a32der*xj
- agg(2,3)=a32der*yj
- agg(3,3)=a32der*zj
- agg(1,4)=a33der*xj
- agg(2,4)=a33der*yj
- agg(3,4)=a33der*zj
-C Add the contributions coming from er
- fac3=-3.0d0*fac
- do k=1,3
- agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
- agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
- agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
- agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
- enddo
- do k=1,3
-C Derivatives in DC(i)
-cgrad ghalf1=0.5d0*agg(k,1)
-cgrad ghalf2=0.5d0*agg(k,2)
-cgrad ghalf3=0.5d0*agg(k,3)
-cgrad ghalf4=0.5d0*agg(k,4)
- aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
- & -3.0d0*uryg(k,2)*vry)!+ghalf1
- aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
- & -3.0d0*uryg(k,2)*vrz)!+ghalf2
- aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
- & -3.0d0*urzg(k,2)*vry)!+ghalf3
- aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
- & -3.0d0*urzg(k,2)*vrz)!+ghalf4
-C Derivatives in DC(i+1)
- aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
- & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
- aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
- & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
- aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
- & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
- aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
- & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
-C Derivatives in DC(j)
- aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
- & -3.0d0*vryg(k,2)*ury)!+ghalf1
- aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
- & -3.0d0*vrzg(k,2)*ury)!+ghalf2
- aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
- & -3.0d0*vryg(k,2)*urz)!+ghalf3
- aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
- & -3.0d0*vrzg(k,2)*urz)!+ghalf4
-C Derivatives in DC(j+1) or DC(nres-1)
- aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
- & -3.0d0*vryg(k,3)*ury)
- aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
- & -3.0d0*vrzg(k,3)*ury)
- aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
- & -3.0d0*vryg(k,3)*urz)
- aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
- & -3.0d0*vrzg(k,3)*urz)
-cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
-cgrad do l=1,4
-cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
-cgrad enddo
-cgrad endif
- enddo
- acipa(1,1)=a22
- acipa(1,2)=a23
- acipa(2,1)=a32
- acipa(2,2)=a33
- a22=-a22
- a23=-a23
- do l=1,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- if (j.lt.nres-1) then
- a22=-a22
- a32=-a32
- do l=1,3,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- else
- a22=-a22
- a23=-a23
- a32=-a32
- a33=-a33
- do l=1,4
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- endif
- ENDIF ! WCORR
- IF (wel_loc.gt.0.0d0) THEN
-C Contribution to the local-electrostatic energy coming from the i-j pair
- eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
- & +a33*muij(4)
-cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
-
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'eelloc',i,j,eel_loc_ij
-
- eel_loc=eel_loc+eel_loc_ij
-C Partial derivatives in virtual-bond dihedral angles gamma
- if (i.gt.1)
- & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
- & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
- & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
- gel_loc_loc(j-1)=gel_loc_loc(j-1)+
- & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
- & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
-C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
- do l=1,3
- ggg(l)=agg(l,1)*muij(1)+
- & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
- gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
- gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
-cgrad ghalf=0.5d0*ggg(l)
-cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
-cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
- enddo
-cgrad do k=i+1,j2
-cgrad do l=1,3
-cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-C Remaining derivatives of eello
- do l=1,3
- gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
- & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
- gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
- & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
- gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
- & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
- gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
- & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
- enddo
- ENDIF
-C Change 12/26/95 to calculate four-body contributions to H-bonding energy
-c if (j.gt.i+1 .and. num_conti.le.maxconts) then
- if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
- & .and. num_conti.le.maxconts) then
-c write (iout,*) i,j," entered corr"
-C
-C Calculate the contact function. The ith column of the array JCONT will
-C contain the numbers of atoms that make contacts with the atom I (of numbers
-C greater than I). The arrays FACONT and GACONT will contain the values of
-C the contact function and its derivative.
-c r0ij=1.02D0*rpp(iteli,itelj)
-c r0ij=1.11D0*rpp(iteli,itelj)
- r0ij=2.20D0*rpp(iteli,itelj)
-c r0ij=1.55D0*rpp(iteli,itelj)
- call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
- if (fcont.gt.0.0D0) then
- num_conti=num_conti+1
- if (num_conti.gt.maxconts) then
- write (iout,*) 'WARNING - max. # of contacts exceeded;',
- & ' will skip next contacts for this conf.'
- else
- jcont_hb(num_conti,i)=j
-cd write (iout,*) "i",i," j",j," num_conti",num_conti,
-cd & " jcont_hb",jcont_hb(num_conti,i)
- IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
- & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
-C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
-C terms.
- d_cont(num_conti,i)=rij
-cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
-C --- Electrostatic-interaction matrix ---
- a_chuj(1,1,num_conti,i)=a22
- a_chuj(1,2,num_conti,i)=a23
- a_chuj(2,1,num_conti,i)=a32
- a_chuj(2,2,num_conti,i)=a33
-C --- Gradient of rij
- do kkk=1,3
- grij_hb_cont(kkk,num_conti,i)=erij(kkk)
- enddo
- kkll=0
- do k=1,2
- do l=1,2
- kkll=kkll+1
- do m=1,3
- a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
- a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
- a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
- a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
- a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
- enddo
- enddo
- enddo
- ENDIF
- IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
-C Calculate contact energies
- cosa4=4.0D0*cosa
- wij=cosa-3.0D0*cosb*cosg
- cosbg1=cosb+cosg
- cosbg2=cosb-cosg
-c fac3=dsqrt(-ael6i)/r0ij**3
- fac3=dsqrt(-ael6i)*r3ij
-c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
- ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
- if (ees0tmp.gt.0) then
- ees0pij=dsqrt(ees0tmp)
- else
- ees0pij=0
- endif
-c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
- ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
- if (ees0tmp.gt.0) then
- ees0mij=dsqrt(ees0tmp)
- else
- ees0mij=0
- endif
-c ees0mij=0.0D0
- ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
- ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
-C Diagnostics. Comment out or remove after debugging!
-c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
-c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
-c ees0m(num_conti,i)=0.0D0
-C End diagnostics.
-c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
-c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
-C Angular derivatives of the contact function
- ees0pij1=fac3/ees0pij
- ees0mij1=fac3/ees0mij
- fac3p=-3.0D0*fac3*rrmij
- ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
- ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
-c ees0mij1=0.0D0
- ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
- ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
- ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
- ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
- ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
- ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
- ecosap=ecosa1+ecosa2
- ecosbp=ecosb1+ecosb2
- ecosgp=ecosg1+ecosg2
- ecosam=ecosa1-ecosa2
- ecosbm=ecosb1-ecosb2
- ecosgm=ecosg1-ecosg2
-C Diagnostics
-c ecosap=ecosa1
-c ecosbp=ecosb1
-c ecosgp=ecosg1
-c ecosam=0.0D0
-c ecosbm=0.0D0
-c ecosgm=0.0D0
-C End diagnostics
- facont_hb(num_conti,i)=fcont
- fprimcont=fprimcont/rij
-cd facont_hb(num_conti,i)=1.0D0
-C Following line is for diagnostics.
-cd fprimcont=0.0D0
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
- do k=1,3
- gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
- gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
- enddo
- gggp(1)=gggp(1)+ees0pijp*xj
- gggp(2)=gggp(2)+ees0pijp*yj
- gggp(3)=gggp(3)+ees0pijp*zj
- gggm(1)=gggm(1)+ees0mijp*xj
- gggm(2)=gggm(2)+ees0mijp*yj
- gggm(3)=gggm(3)+ees0mijp*zj
-C Derivatives due to the contact function
- gacont_hbr(1,num_conti,i)=fprimcont*xj
- gacont_hbr(2,num_conti,i)=fprimcont*yj
- gacont_hbr(3,num_conti,i)=fprimcont*zj
- do k=1,3
-c
-c 10/24/08 cgrad and ! comments indicate the parts of the code removed
-c following the change of gradient-summation algorithm.
-c
-cgrad ghalfp=0.5D0*gggp(k)
-cgrad ghalfm=0.5D0*gggm(k)
- gacontp_hb1(k,num_conti,i)=!ghalfp
- & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gacontp_hb2(k,num_conti,i)=!ghalfp
- & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gacontp_hb3(k,num_conti,i)=gggp(k)
- gacontm_hb1(k,num_conti,i)=!ghalfm
- & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gacontm_hb2(k,num_conti,i)=!ghalfm
- & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gacontm_hb3(k,num_conti,i)=gggm(k)
- enddo
- ENDIF ! wcorr
- endif ! num_conti.le.maxconts
- endif ! fcont.gt.0
- endif ! j.gt.i+1
- if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
- do k=1,4
- do l=1,3
- ghalf=0.5d0*agg(l,k)
- aggi(l,k)=aggi(l,k)+ghalf
- aggi1(l,k)=aggi1(l,k)+agg(l,k)
- aggj(l,k)=aggj(l,k)+ghalf
- enddo
- enddo
- if (j.eq.nres-1 .and. i.lt.j-2) then
- do k=1,4
- do l=1,3
- aggj1(l,k)=aggj1(l,k)+agg(l,k)
- enddo
- enddo
- endif
- endif
-c t_eelecij=t_eelecij+MPI_Wtime()-time00
- return
- end
-C-----------------------------------------------------------------------
- subroutine evdwpp_short(evdw1)
-C
-C Compute Evdwpp
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- dimension ggg(3)
-c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- double precision scal_el /1.0d0/
-#else
- double precision scal_el /0.5d0/
-#endif
- evdw1=0.0D0
-c write (iout,*) "iatel_s_vdw",iatel_s_vdw,
-c & " iatel_e_vdw",iatel_e_vdw
- call flush(iout)
- do i=iatel_s_vdw,iatel_e_vdw
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=0
-c write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
-c & ' ielend',ielend_vdw(i)
- call flush(iout)
- do j=ielstart_vdw(i),ielend_vdw(i)
- ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- aaa=app(iteli,itelj)
- bbb=bpp(iteli,itelj)
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- dx_normj=dc_norm(1,j)
- dy_normj=dc_norm(2,j)
- dz_normj=dc_norm(3,j)
- xj=c(1,j)+0.5D0*dxj-xmedi
- yj=c(2,j)+0.5D0*dyj-ymedi
- zj=c(3,j)+0.5D0*dzj-zmedi
- rij=xj*xj+yj*yj+zj*zj
- rrmij=1.0D0/rij
- rij=dsqrt(rij)
- sss=sscale(rij/rpp(iteli,itelj))
- if (sss.gt.0.0d0) then
- rmij=1.0D0/rij
- r3ij=rrmij*rmij
- r6ij=r3ij*r3ij
- ev1=aaa*r6ij*r6ij
-c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
- if (j.eq.i+2) ev1=scal_el*ev1
- ev2=bbb*r6ij
- evdwij=ev1+ev2
- if (energy_dec) then
- write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
- endif
- evdw1=evdw1+evdwij*sss
-C
-C Calculate contributions to the Cartesian gradient.
-C
- facvdw=-6*rrmij*(ev1+evdwij)*sss
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
- endif
- enddo ! j
- enddo ! i
- return
- end
-C-----------------------------------------------------------------------------
- subroutine escp_long(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)
-
- sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
-
- if (sss.lt.1.0d0) then
-
- 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)*(1.0d0-sss)
- endif
- evdwij=e1+e2
- evdw2=evdw2+evdwij*(1.0d0-sss)
- 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*(1.0d0-sss)
- ggg(1)=xj*fac
- ggg(2)=yj*fac
- ggg(3)=zj*fac
-C Uncomment following three lines for SC-p interactions
-c do k=1,3
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-c enddo
-C Uncomment following line for SC-p interactions
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
- 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
- endif
- 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 escp_short(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)
-
- sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
-
- if (sss.gt.0.0d0) then
-
- 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)*sss
- endif
- evdwij=e1+e2
- evdw2=evdw2+evdwij*sss
- 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*sss
- ggg(1)=xj*fac
- ggg(2)=yj*fac
- ggg(3)=zj*fac
-C Uncomment following three lines for SC-p interactions
-c do k=1,3
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-c enddo
-C Uncomment following line for SC-p interactions
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
- 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
- endif
- 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
#ifdef DEBUG
write (iout,*) "sum_gradient gvdwc, gvdwx"
do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
- & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
+ write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
+ & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
+ & (gvdwcT(j,i),j=1,3)
enddo
call flush(iout)
#endif
call flush(iout)
#endif
#ifdef SPLITELE
+#ifdef TSCSC
+ do i=1,nct
+ do j=1,3
+ gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
+ & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
+ & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
+ & wel_loc*gel_loc_long(j,i)+
+ & wcorr*gradcorr_long(j,i)+
+ & wcorr5*gradcorr5_long(j,i)+
+ & wcorr6*gradcorr6_long(j,i)+
+ & wturn6*gcorr6_turn_long(j,i)+
+ & wstrain*ghpbc(j,i)
+ enddo
+ enddo
+#else
do i=1,nct
do j=1,3
gradbufc(j,i)=wsc*gvdwc(j,i)+
& wstrain*ghpbc(j,i)
enddo
enddo
+#endif
#else
do i=1,nct
do j=1,3
gradbufc_sum(j,i)=gradbufc(j,i)
enddo
enddo
+c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
+c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
+c time_reduce=time_reduce+MPI_Wtime()-time00
+#ifdef DEBUG
+c write (iout,*) "gradbufc_sum after allreduce"
+c do i=1,nres
+c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
+c enddo
+c call flush(iout)
+#endif
#ifdef TIMING
c time_allreduce=time_allreduce+MPI_Wtime()-time00
#endif
& " jgrad_end ",jgrad_end(i),
& i=igrad_start,igrad_end)
#endif
+c
+c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
+c do not parallelize this part.
+c
+c do i=igrad_start,igrad_end
+c do j=jgrad_start(i),jgrad_end(i)
+c do k=1,3
+c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
+c enddo
+c enddo
+c enddo
do j=1,3
gradbufc(j,nres-1)=gradbufc_sum(j,nres)
enddo
gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
enddo
enddo
+c do i=nnt,nres-1
+c do k=1,3
+c gradbufc(k,i)=0.0d0
+c enddo
+c do j=i+1,nres
+c do k=1,3
+c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
+c enddo
+c enddo
+c enddo
#ifdef DEBUG
write (iout,*) "gradbufc after summing"
do i=1,nres
& wsccor*gsccorc(j,i)
& +wscloc*gscloc(j,i)
#endif
+#ifdef TSCSC
+ gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
+ & wscp*gradx_scp(j,i)+
+ & wbond*gradbx(j,i)+
+ & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
+ & wsccor*gsccorx(j,i)
+ & +wscloc*gsclocx(j,i)
+#else
gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
& wbond*gradbx(j,i)+
& wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
& wsccor*gsccorx(j,i)
& +wscloc*gsclocx(j,i)
+#endif
enddo
enddo
#ifdef DEBUG
do i=1,nct
gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
+#ifdef TSCSC
+ gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
+ if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
+#endif
gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
if (gvdwc_scp_norm.gt.gvdwc_scp_max)
& gvdwc_scp_max=gvdwc_scp_norm
if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
+#ifdef TSCSC
+ gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
+ if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
+#endif
gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
if (gradx_scp_norm.gt.gradx_scp_max)
& gradx_scp_max=gradx_scp_norm
+++ /dev/null
- subroutine etotal(energia)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#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.LOCAL'
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CONTROL'
- include 'COMMON.TIME1'
-#ifdef MPI
-c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
-c & " nfgtasks",nfgtasks
- 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(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
-c print *,"Processor",myrank," BROADCAST iorder"
-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
- time_Bcast=time_Bcast+MPI_Wtime()-time00
- time_Bcastw=time_Bcastw+MPI_Wtime()-time00
-c call chainbuild_cart
- endif
-c print *,'Processor',myrank,' calling etotal ipot=',ipot
-c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
-#else
-c if (modecalc.eq.12.or.modecalc.eq.14) then
-c call int_from_cart1(.false.)
-c endif
-#endif
-#ifdef TIMING
- time00=MPI_Wtime()
-#endif
-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(evdw)
-cd print '(a)','Exit ELJ'
- goto 107
-C Lennard-Jones-Kihara potential (shifted).
- 102 call eljk(evdw)
- goto 107
-C Berne-Pechukas potential (dilated LJ, angular dependence).
- 103 call ebp(evdw)
- goto 107
-C Gay-Berne potential (shifted LJ, angular dependence).
- 104 call egb(evdw)
- goto 107
-C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
- 105 call egbv(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
-c print *,"Processor",myrank," computed USCSC"
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
- call vec_and_deriv
-#ifdef TIMING
- time_vec=time_vec+MPI_Wtime()-time01
-#endif
-c print *,"Processor",myrank," left 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(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
- else
- ees=0.0d0
- evdw1=0.0d0
- eel_loc=0.0d0
- eello_turn3=0.0d0
- eello_turn4=0.0d0
- endif
- else
-c write (iout,*) "Soft-spheer ELEC potential"
- call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
- & eello_turn4)
- endif
-c print *,"Processor",myrank," computed UELEC"
-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(evdw2,evdw2_14)
- else
- evdw2=0
- evdw2_14=0
- endif
- else
-c write (iout,*) "Soft-sphere SCP potential"
- call escp_soft_sphere(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.
-cd print *,'Calling EHPB'
- call edis(ehpb)
-cd print *,'EHPB exitted succesfully.'
-C
-C Calculate the virtual-bond-angle energy.
-C
- if (wang.gt.0d0) then
- call ebend(ebe)
- else
- ebe=0
- endif
-c print *,"Processor",myrank," computed UB"
-C
-C Calculate the SC local energy.
-C
- call esc(escloc)
-c print *,"Processor",myrank," computed USC"
-C
-C Calculate the virtual-bond torsional energy.
-C
-cd print *,'nterm=',nterm
- if (wtor.gt.0) then
- call etor(etors,edihcnstr)
- else
- etors=0
- edihcnstr=0
- endif
-c print *,"Processor",myrank," computed Utor"
-C
-C 6/23/01 Calculate double-torsional energy
-C
- if (wtor_d.gt.0) then
- call etor_d(etors_d)
- else
- etors_d=0
- endif
-c print *,"Processor",myrank," computed Utord"
-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 print *,"Processor",myrank," computed Usccorr"
-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)
-cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
-cd &" 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)
-cd write (iout,*) "multibody_hb ecorr",ecorr
- endif
-c print *,"Processor",myrank," computed Ucorr"
-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
-#ifdef TIMING
- time_enecalc=time_enecalc+MPI_Wtime()-time00
-#endif
-c print *,"Processor",myrank," computed Uconstr"
-#ifdef TIMING
- time00=MPI_Wtime()
-#endif
-c
-C Sum the energies
-C
- 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(11)=ebe
- energia(12)=escloc
- energia(13)=etors
- energia(14)=etors_d
- energia(15)=ehpb
- energia(19)=edihcnstr
- energia(17)=estr
- energia(20)=Uconst+Uconst_back
- energia(21)=esccor
-c print *," Processor",myrank," calls SUM_ENERGY"
- call sum_energy(energia,.true.)
-c print *," Processor",myrank," left SUM_ENERGY"
-#ifdef TIMING
- time_sumene=time_sumene+MPI_Wtime()-time00
-#endif
- return
- end
-c-------------------------------------------------------------------------------
- subroutine sum_energy(energia,reduce)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-cMS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision energia(0:n_ene),enebuff(0:n_ene+1)
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.CONTROL'
- include 'COMMON.TIME1'
- logical reduce
-#ifdef MPI
- if (nfgtasks.gt.1 .and. reduce) then
-#ifdef DEBUG
- write (iout,*) "energies before REDUCE"
- call enerprint(energia)
- call flush(iout)
-#endif
- do i=0,n_ene
- enebuff(i)=energia(i)
- enddo
- time00=MPI_Wtime()
- call MPI_Barrier(FG_COMM,IERR)
- time_barrier_e=time_barrier_e+MPI_Wtime()-time00
- time00=MPI_Wtime()
- call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
- & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
-#ifdef DEBUG
- write (iout,*) "energies after REDUCE"
- call enerprint(energia)
- call flush(iout)
-#endif
- time_Reduce=time_Reduce+MPI_Wtime()-time00
- endif
- if (fg_rank.eq.0) then
-#endif
- evdw=energia(1)
-#ifdef SCP14
- evdw2=energia(2)+energia(18)
- evdw2_14=energia(18)
-#else
- evdw2=energia(2)
-#endif
-#ifdef SPLITELE
- ees=energia(3)
- evdw1=energia(16)
-#else
- ees=energia(3)
- evdw1=0.0d0
-#endif
- ecorr=energia(4)
- ecorr5=energia(5)
- ecorr6=energia(6)
- eel_loc=energia(7)
- eello_turn3=energia(8)
- eello_turn4=energia(9)
- eturn6=energia(10)
- ebe=energia(11)
- escloc=energia(12)
- etors=energia(13)
- etors_d=energia(14)
- ehpb=energia(15)
- edihcnstr=energia(19)
- estr=energia(17)
- Uconst=energia(20)
- esccor=energia(21)
-#ifdef SPLITELE
- etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
- & +wang*ebe+wtor*etors+wscloc*escloc
- & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
- & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
- & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
- & +wbond*estr+Uconst+wsccor*esccor
-#else
- etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
- & +wang*ebe+wtor*etors+wscloc*escloc
- & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
- & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
- & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
- & +wbond*estr+Uconst+wsccor*esccor
-#endif
- energia(0)=etot
-c detecting NaNQ
-#ifdef ISNAN
-#ifdef AIX
- if (isnan(etot).ne.0) energia(0)=1.0d+99
-#else
- if (isnan(etot)) energia(0)=1.0d+99
-#endif
-#else
- i=0
-#ifdef WINPGI
- idumm=proc_proc(etot,i)
-#else
- call proc_proc(etot,i)
-#endif
- if(i.eq.1)energia(0)=1.0d+99
-#endif
-#ifdef MPI
- endif
-#endif
- return
- end
-c-------------------------------------------------------------------------------
- subroutine sum_gradient
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-cMS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
-#ifdef MPI
- include 'mpif.h'
- double precision gradbufc(3,maxres),gradbufx(3,maxres),
- & glocbuf(4*maxres),gradbufc_sum(3,maxres)
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.CONTROL'
- include 'COMMON.TIME1'
- include 'COMMON.MAXGRAD'
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
-#ifdef DEBUG
- write (iout,*) "sum_gradient gvdwc, gvdwx"
- do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
- & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
-#ifdef MPI
-C FG slaves call the following matching MPI_Bcast in ERGASTULUM
- if (nfgtasks.gt.1 .and. fg_rank.eq.0)
- & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
-#endif
-C
-C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
-C in virtual-bond-vector coordinates
-C
-#ifdef DEBUG
-c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
-c do i=1,nres-1
-c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
-c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
-c enddo
-c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
-c do i=1,nres-1
-c write (iout,'(i5,3f10.5,2x,f10.5)')
-c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
-c enddo
- write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
- do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
- & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
- & g_corr5_loc(i)
- enddo
- call flush(iout)
-#endif
-#ifdef SPLITELE
- do i=1,nct
- do j=1,3
- gradbufc(j,i)=wsc*gvdwc(j,i)+
- & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
- & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
- & wel_loc*gel_loc_long(j,i)+
- & wcorr*gradcorr_long(j,i)+
- & wcorr5*gradcorr5_long(j,i)+
- & wcorr6*gradcorr6_long(j,i)+
- & wturn6*gcorr6_turn_long(j,i)+
- & wstrain*ghpbc(j,i)
- enddo
- enddo
-#else
- do i=1,nct
- do j=1,3
- gradbufc(j,i)=wsc*gvdwc(j,i)+
- & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
- & welec*gelc_long(j,i)+
- & wbond*gradb(j,i)+
- & wel_loc*gel_loc_long(j,i)+
- & wcorr*gradcorr_long(j,i)+
- & wcorr5*gradcorr5_long(j,i)+
- & wcorr6*gradcorr6_long(j,i)+
- & wturn6*gcorr6_turn_long(j,i)+
- & wstrain*ghpbc(j,i)
- enddo
- enddo
-#endif
-#ifdef MPI
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
-#ifdef DEBUG
- write (iout,*) "gradbufc before allreduce"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
- call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
- & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
- time_reduce=time_reduce+MPI_Wtime()-time00
-#ifdef DEBUG
- write (iout,*) "gradbufc_sum after allreduce"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
-#ifdef TIMING
- time_allreduce=time_allreduce+MPI_Wtime()-time00
-#endif
- do i=nnt,nres
- do k=1,3
- gradbufc(k,i)=0.0d0
- enddo
- enddo
- do i=igrad_start,igrad_end
- do j=jgrad_start(i),jgrad_end(i)
- do k=1,3
- gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
- enddo
- enddo
- enddo
- else
-#endif
-#ifdef DEBUG
- write (iout,*) "gradbufc"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
- do i=nnt,nres-1
- do k=1,3
- gradbufc(k,i)=0.0d0
- enddo
- do j=i+1,nres
- do k=1,3
- gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
- enddo
- enddo
- enddo
-#ifdef MPI
- endif
-#endif
- do k=1,3
- gradbufc(k,nres)=0.0d0
- enddo
- do i=1,nct
- do j=1,3
-#ifdef SPLITELE
- gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
- & wel_loc*gel_loc(j,i)+
- & 0.5d0*(wscp*gvdwc_scpp(j,i)+
- & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
- & wel_loc*gel_loc_long(j,i)+
- & wcorr*gradcorr_long(j,i)+
- & wcorr5*gradcorr5_long(j,i)+
- & wcorr6*gradcorr6_long(j,i)+
- & wturn6*gcorr6_turn_long(j,i))+
- & wbond*gradb(j,i)+
- & wcorr*gradcorr(j,i)+
- & wturn3*gcorr3_turn(j,i)+
- & wturn4*gcorr4_turn(j,i)+
- & wcorr5*gradcorr5(j,i)+
- & wcorr6*gradcorr6(j,i)+
- & wturn6*gcorr6_turn(j,i)+
- & wsccor*gsccorc(j,i)
- & +wscloc*gscloc(j,i)
-#else
- gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
- & wel_loc*gel_loc(j,i)+
- & 0.5d0*(wscp*gvdwc_scpp(j,i)+
- & welec*gelc_long(j,i)
- & wel_loc*gel_loc_long(j,i)+
- & wcorr*gcorr_long(j,i)+
- & wcorr5*gradcorr5_long(j,i)+
- & wcorr6*gradcorr6_long(j,i)+
- & wturn6*gcorr6_turn_long(j,i))+
- & wbond*gradb(j,i)+
- & wcorr*gradcorr(j,i)+
- & wturn3*gcorr3_turn(j,i)+
- & wturn4*gcorr4_turn(j,i)+
- & wcorr5*gradcorr5(j,i)+
- & wcorr6*gradcorr6(j,i)+
- & wturn6*gcorr6_turn(j,i)+
- & wsccor*gsccorc(j,i)
- & +wscloc*gscloc(j,i)
-#endif
- gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
- & wbond*gradbx(j,i)+
- & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
- & wsccor*gsccorx(j,i)
- & +wscloc*gsclocx(j,i)
- enddo
- enddo
-#ifdef DEBUG
- write (iout,*) "gloc before adding corr"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
- enddo
-#endif
- do i=1,nres-3
- gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
- & +wcorr5*g_corr5_loc(i)
- & +wcorr6*g_corr6_loc(i)
- & +wturn4*gel_loc_turn4(i)
- & +wturn3*gel_loc_turn3(i)
- & +wturn6*gel_loc_turn6(i)
- & +wel_loc*gel_loc_loc(i)
- & +wsccor*gsccor_loc(i)
- enddo
-#ifdef DEBUG
- write (iout,*) "gloc after adding corr"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
- enddo
-#endif
-#ifdef MPI
- if (nfgtasks.gt.1) then
- do j=1,3
- do i=1,nres
- gradbufc(j,i)=gradc(j,i,icg)
- gradbufx(j,i)=gradx(j,i,icg)
- enddo
- enddo
- do i=1,4*nres
- glocbuf(i)=gloc(i,icg)
- enddo
- time00=MPI_Wtime()
- call MPI_Barrier(FG_COMM,IERR)
- time_barrier_g=time_barrier_g+MPI_Wtime()-time00
- time00=MPI_Wtime()
- call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
- & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
- & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
- & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- time_reduce=time_reduce+MPI_Wtime()-time00
-#ifdef DEBUG
- write (iout,*) "gloc after reduce"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
- enddo
-#endif
- endif
-#endif
- if (gnorm_check) then
-c
-c Compute the maximum elements of the gradient
-c
- gvdwc_max=0.0d0
- gvdwc_scp_max=0.0d0
- gelc_max=0.0d0
- gvdwpp_max=0.0d0
- gradb_max=0.0d0
- ghpbc_max=0.0d0
- gradcorr_max=0.0d0
- gel_loc_max=0.0d0
- gcorr3_turn_max=0.0d0
- gcorr4_turn_max=0.0d0
- gradcorr5_max=0.0d0
- gradcorr6_max=0.0d0
- gcorr6_turn_max=0.0d0
- gsccorc_max=0.0d0
- gscloc_max=0.0d0
- gvdwx_max=0.0d0
- gradx_scp_max=0.0d0
- ghpbx_max=0.0d0
- gradxorr_max=0.0d0
- gsccorx_max=0.0d0
- gsclocx_max=0.0d0
- do i=1,nct
- gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
- if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
- gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
- if (gvdwc_scp_norm.gt.gvdwc_scp_max)
- & gvdwc_scp_max=gvdwc_scp_norm
- gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
- if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
- gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
- if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
- gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
- if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
- ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
- if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
- gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
- if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
- gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
- if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
- gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
- & gcorr3_turn(1,i)))
- if (gcorr3_turn_norm.gt.gcorr3_turn_max)
- & gcorr3_turn_max=gcorr3_turn_norm
- gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
- & gcorr4_turn(1,i)))
- if (gcorr4_turn_norm.gt.gcorr4_turn_max)
- & gcorr4_turn_max=gcorr4_turn_norm
- gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
- if (gradcorr5_norm.gt.gradcorr5_max)
- & gradcorr5_max=gradcorr5_norm
- gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
- if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
- gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
- & gcorr6_turn(1,i)))
- if (gcorr6_turn_norm.gt.gcorr6_turn_max)
- & gcorr6_turn_max=gcorr6_turn_norm
- gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
- if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
- gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
- if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
- gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
- if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
- gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
- if (gradx_scp_norm.gt.gradx_scp_max)
- & gradx_scp_max=gradx_scp_norm
- ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
- if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
- gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
- if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
- gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
- if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
- gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
- if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
- enddo
- if (gradout) then
-#ifdef AIX
- open(istat,file=statname,position="append")
-#else
- open(istat,file=statname,access="append")
-#endif
- write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
- & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
- & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
- & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
- & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
- & gsccorx_max,gsclocx_max
- close(istat)
- if (gvdwc_max.gt.1.0d4) then
- write (iout,*) "gvdwc gvdwx gradb gradbx"
- do i=nnt,nct
- write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
- & gradb(j,i),gradbx(j,i),j=1,3)
- enddo
- call pdbout(0.0d0,'cipiszcze',iout)
- call flush(iout)
- endif
- endif
- endif
-#ifdef DEBUG
- write (iout,*) "gradc gradx gloc"
- do i=1,nres
- write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
- & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
- enddo
-#endif
-#ifdef TIMING
- time_sumgradient=time_sumgradient+MPI_Wtime()-time01
-#endif
- return
- end
-c-------------------------------------------------------------------------------
- subroutine rescale_weights(t_bath)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- double precision kfac /2.4d0/
- double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
-c facT=temp0/t_bath
-c facT=2*temp0/(t_bath+temp0)
- if (rescale_mode.eq.0) then
- facT=1.0d0
- facT2=1.0d0
- facT3=1.0d0
- facT4=1.0d0
- facT5=1.0d0
- else if (rescale_mode.eq.1) then
- facT=kfac/(kfac-1.0d0+t_bath/temp0)
- facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
- facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
- facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
- facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
- else if (rescale_mode.eq.2) then
- x=t_bath/temp0
- x2=x*x
- x3=x2*x
- x4=x3*x
- x5=x4*x
- facT=licznik/dlog(dexp(x)+dexp(-x))
- facT2=licznik/dlog(dexp(x2)+dexp(-x2))
- facT3=licznik/dlog(dexp(x3)+dexp(-x3))
- facT4=licznik/dlog(dexp(x4)+dexp(-x4))
- facT5=licznik/dlog(dexp(x5)+dexp(-x5))
- else
- write (iout,*) "Wrong RESCALE_MODE",rescale_mode
- write (*,*) "Wrong RESCALE_MODE",rescale_mode
-#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,IERROR)
-#endif
- stop 555
- endif
- welec=weights(3)*fact
- wcorr=weights(4)*fact3
- wcorr5=weights(5)*fact4
- wcorr6=weights(6)*fact5
- wel_loc=weights(7)*fact2
- wturn3=weights(8)*fact2
- wturn4=weights(9)*fact3
- wturn6=weights(10)*fact5
- wtor=weights(13)*fact
- wtor_d=weights(14)*fact2
- wsccor=weights(21)*fact
-
- return
- end
-C------------------------------------------------------------------------
- subroutine enerprint(energia)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.MD'
- double precision energia(0:n_ene)
- etot=energia(0)
- evdw=energia(1)
- evdw2=energia(2)
-#ifdef SCP14
- evdw2=energia(2)+energia(18)
-#else
- evdw2=energia(2)
-#endif
- ees=energia(3)
-#ifdef SPLITELE
- evdw1=energia(16)
-#endif
- ecorr=energia(4)
- ecorr5=energia(5)
- ecorr6=energia(6)
- eel_loc=energia(7)
- eello_turn3=energia(8)
- eello_turn4=energia(9)
- eello_turn6=energia(10)
- ebe=energia(11)
- escloc=energia(12)
- etors=energia(13)
- etors_d=energia(14)
- ehpb=energia(15)
- edihcnstr=energia(19)
- estr=energia(17)
- Uconst=energia(20)
- esccor=energia(21)
-#ifdef SPLITELE
- write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
- & estr,wbond,ebe,wang,
- & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
- & ecorr,wcorr,
- & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
- & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
- & edihcnstr,ebr*nss,
- & Uconst,etot
- 10 format (/'Virtual-chain energies:'//
- & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
- & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
- & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
- & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
- & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
- & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
- & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
- & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
- & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
- & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
- & ' (SS bridges & dist. cnstr.)'/
- & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
- & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
- & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
- & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
- & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
- & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
- & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
- & 'UCONST= ',1pE16.6,' (Constraint energy)'/
- & 'ETOT= ',1pE16.6,' (total)')
-#else
- write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
- & estr,wbond,ebe,wang,
- & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
- & ecorr,wcorr,
- & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
- & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
- & ebr*nss,Uconst,etot
- 10 format (/'Virtual-chain energies:'//
- & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
- & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
- & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
- & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
- & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
- & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
- & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
- & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
- & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
- & ' (SS bridges & dist. cnstr.)'/
- & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
- & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
- & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
- & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
- & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
- & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
- & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
- & 'UCONST=',1pE16.6,' (Constraint energy)'/
- & 'ETOT= ',1pE16.6,' (total)')
-#endif
- return
- end
-C-----------------------------------------------------------------------
- subroutine elj(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJ potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (accur=1.0d-10)
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.TORSION'
- include 'COMMON.SBRIDGE'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
- dimension gg(3)
-c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C Change 12/1/95
- num_conti=0
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
-cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
-cd & 'iend=',iend(i,iint)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
-C Change 12/1/95 to calculate four-body interactions
- rij=xj*xj+yj*yj+zj*zj
- rrij=1.0D0/rij
-c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
- eps0ij=eps(itypi,itypj)
- fac=rrij**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e1+e2
-cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
-cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
-cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- evdw=evdw+evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-rrij*(e1+evdwij)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
-C
-C 12/1/95, revised on 5/20/97
-C
-C Calculate the contact function. The ith column of the array JCONT will
-C contain the numbers of atoms that make contacts with the atom I (of numbers
-C greater than I). The arrays FACONT and GACONT will contain the values of
-C the contact function and its derivative.
-C
-C Uncomment next line, if the correlation interactions include EVDW explicitly.
-c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
-C Uncomment next line, if the correlation interactions are contact function only
- if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
- rij=dsqrt(rij)
- sigij=sigma(itypi,itypj)
- r0ij=rs0(itypi,itypj)
-C
-C Check whether the SC's are not too far to make a contact.
-C
- rcut=1.5d0*r0ij
- call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
-C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
-C
- if (fcont.gt.0.0D0) then
-C If the SC-SC distance if close to sigma, apply spline.
-cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
-cAdam & fcont1,fprimcont1)
-cAdam fcont1=1.0d0-fcont1
-cAdam if (fcont1.gt.0.0d0) then
-cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
-cAdam fcont=fcont*fcont1
-cAdam endif
-C Uncomment following 4 lines to have the geometric average of the epsilon0's
-cga eps0ij=1.0d0/dsqrt(eps0ij)
-cga do k=1,3
-cga gg(k)=gg(k)*eps0ij
-cga enddo
-cga eps0ij=-evdwij*eps0ij
-C Uncomment for AL's type of SC correlation interactions.
-cadam eps0ij=-evdwij
- num_conti=num_conti+1
- jcont(num_conti,i)=j
- facont(num_conti,i)=fcont*eps0ij
- fprimcont=eps0ij*fprimcont/rij
- fcont=expon*fcont
-cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
-cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
-cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
-C Uncomment following 3 lines for Skolnick's type of SC correlation.
- gacont(1,num_conti,i)=-fprimcont*xj
- gacont(2,num_conti,i)=-fprimcont*yj
- gacont(3,num_conti,i)=-fprimcont*zj
-cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
-cd write (iout,'(2i3,3f10.5)')
-cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
- endif
- endif
- enddo ! j
- enddo ! iint
-C Change 12/1/95
- num_cont(i)=num_conti
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
-C******************************************************************************
-C
-C N O T E !!!
-C
-C To save time, the factor of 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 eljk(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJK potential of interaction.
-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.IOUNITS'
- include 'COMMON.NAMES'
- dimension gg(3)
- logical scheck
-c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- r_inv_ij=dsqrt(rrij)
- rij=1.0D0/r_inv_ij
- r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
- fac=r_shift_inv**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e_augm+e1+e2
-cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
-cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
-cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
-cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- evdw=evdw+evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
- return
- end
-C-----------------------------------------------------------------------------
- subroutine ebp(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Berne-Pechukas potential of interaction.
-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.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
-c double precision rrsave(maxdim)
- logical lprn
- evdw=0.0D0
-c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
-c if (icall.eq.0) then
-c lprn=.true.
-c else
- lprn=.false.
-c endif
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- 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(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-C For diagnostics only!!!
-c chi1=0.0D0
-c chi2=0.0D0
-c chi12=0.0D0
-c chip1=0.0D0
-c chip2=0.0D0
-c chip12=0.0D0
-c alf1=0.0D0
-c alf2=0.0D0
-c alf12=0.0D0
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- 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)
-cd if (icall.eq.0) then
-cd rrsave(ind)=rrij
-cd else
-cd rrij=rrsave(ind)
-cd endif
- rij=dsqrt(rrij)
-C Calculate the angle-dependent terms of energy & contributions to derivatives.
- call sc_angular
-C Calculate whole angle-dependent part of epsilon and contributions
-C to its derivatives
- fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & epsi,sigm,chi1,chi2,chip1,chip2,
-cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
-cd & om1,om2,om12,1.0D0/dsqrt(rrij),
-cd & evdwij
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)
- sigder=fac/sigsq
- fac=rrij*fac
-C Calculate radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate the angular part of the gradient and sum add the contributions
-C to the appropriate components of the Cartesian gradient.
- call sc_grad
- enddo ! j
- enddo ! iint
- enddo ! i
-c stop
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egb(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne potential of interaction.
-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.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- include 'COMMON.CONTROL'
- logical lprn
- evdw=0.0D0
-ccccc energy_dec=.false.
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.false.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- 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(i+nres)
-c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
-c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
-c & 1.0d0/vbld(j+nres)
-c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
- sig0ij=sigma(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-C For diagnostics only!!!
-c chi1=0.0D0
-c chi2=0.0D0
-c chi12=0.0D0
-c chip1=0.0D0
-c chip2=0.0D0
-c chip12=0.0D0
-c alf1=0.0D0
-c alf2=0.0D0
-c alf12=0.0D0
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
-c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
-c write (iout,*) "j",j," dc_norm",
-c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
-c for diagnostics; uncomment
-c rij_shift=1.2*sig0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
-cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
-c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij
- endif
-
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw',i,j,evdwij
-
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac
-c fac=0.0d0
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
- call sc_grad
- enddo ! j
- enddo ! iint
- enddo ! i
-c write (iout,*) "Number of loop steps in EGB:",ind
-cccc energy_dec=.false.
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egbv(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne-Vorobjev potential of interaction.
-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.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
- logical lprn
- evdw=0.0D0
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.true.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- 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(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- sig0ij=sigma(itypi,itypj)
- r0ij=r0(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-C For diagnostics only!!!
-c chi1=0.0D0
-c chi2=0.0D0
-c chi12=0.0D0
-c chip1=0.0D0
-c chip2=0.0D0
-c chip12=0.0D0
-c alf1=0.0D0
-c alf2=0.0D0
-c alf12=0.0D0
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- 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)
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+r0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij+e_augm
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
- & chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij+e_augm
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac-2*expon*rrij*e_augm
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
- call sc_grad
- enddo ! j
- enddo ! iint
- enddo ! i
- end
-C-----------------------------------------------------------------------------
- subroutine sc_angular
-C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
-C om12. Called by ebp, egb, and egbv.
- implicit none
- include 'COMMON.CALC'
- include 'COMMON.IOUNITS'
- 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
- chiom12=chi12*om12
-C Calculate eps1(om12) and its derivative in om12
- faceps1=1.0D0-om12*chiom12
- faceps1_inv=1.0D0/faceps1
- eps1=dsqrt(faceps1_inv)
-C Following variable is eps1*deps1/dom12
- eps1_om12=faceps1_inv*chiom12
-c diagnostics only
-c faceps1_inv=om12
-c eps1=om12
-c eps1_om12=1.0d0
-c write (iout,*) "om12",om12," eps1",eps1
-C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
-C and om12.
- om1om2=om1*om2
- chiom1=chi1*om1
- chiom2=chi2*om2
- facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
- sigsq=1.0D0-facsig*faceps1_inv
- sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
- sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
- sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
-c diagnostics only
-c sigsq=1.0d0
-c sigsq_om1=0.0d0
-c sigsq_om2=0.0d0
-c sigsq_om12=0.0d0
-c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
-c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
-c & " eps1",eps1
-C Calculate eps2 and its derivatives in om1, om2, and om12.
- chipom1=chip1*om1
- chipom2=chip2*om2
- chipom12=chip12*om12
- facp=1.0D0-om12*chipom12
- facp_inv=1.0D0/facp
- facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
-c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
-c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
-C Following variable is the square root of eps2
- eps2rt=1.0D0-facp1*facp_inv
-C Following three variables are the derivatives of the square root of eps
-C in om1, om2, and om12.
- eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
- eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
- eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
-C Evaluate the "asymmetric" factor in the VDW constant, eps3
- eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
-c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
-c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
-c & " eps2rt_om12",eps2rt_om12
-C Calculate whole angle-dependent part of epsilon and contributions
-C to its derivatives
- return
- end
-C----------------------------------------------------------------------------
- subroutine sc_grad
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.CALC'
- include 'COMMON.IOUNITS'
- double precision dcosom1(3),dcosom2(3)
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
- eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
- & -2.0D0*alf12*eps3der+sigder*sigsq_om12
-c diagnostics only
-c eom1=0.0d0
-c eom2=0.0d0
-c eom12=evdwij*eps1_om12
-c end diagnostics
-c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
-c & " sigder",sigder
-c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
-c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
- 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
- do k=1,3
- gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
- enddo
-c write (iout,*) "gg",(gg(k),k=1,3)
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
- & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
- & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
-c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
-c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
-c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
-c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- 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 gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
- do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
- enddo
- return
- end
-C-----------------------------------------------------------------------
- subroutine e_softsphere(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJ potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (accur=1.0d-10)
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.TORSION'
- include 'COMMON.SBRIDGE'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
- dimension gg(3)
-cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
-cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
-cd & 'iend=',iend(i,iint)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rij=xj*xj+yj*yj+zj*zj
-c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
- r0ij=r0(itypi,itypj)
- r0ijsq=r0ij*r0ij
-c print *,i,j,r0ij,dsqrt(rij)
- if (rij.lt.r0ijsq) then
- evdwij=0.25d0*(rij-r0ijsq)**2
- fac=rij-r0ijsq
- else
- evdwij=0.0d0
- fac=0.0d0
- endif
- evdw=evdw+evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
- enddo ! j
- enddo ! iint
- enddo ! i
- return
- end
-C--------------------------------------------------------------------------
- subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
- & eello_turn4)
-C
-C Soft-sphere potential of p-p interaction
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- dimension ggg(3)
-cd write(iout,*) 'In EELEC_soft_sphere'
- ees=0.0D0
- evdw1=0.0D0
- eel_loc=0.0d0
- eello_turn3=0.0d0
- eello_turn4=0.0d0
- ind=0
- do i=iatel_s,iatel_e
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=0
-c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
- do j=ielstart(i),ielend(i)
- ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- r0ij=rpp(iteli,itelj)
- r0ijsq=r0ij*r0ij
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- xj=c(1,j)+0.5D0*dxj-xmedi
- yj=c(2,j)+0.5D0*dyj-ymedi
- zj=c(3,j)+0.5D0*dzj-zmedi
- rij=xj*xj+yj*yj+zj*zj
- if (rij.lt.r0ijsq) then
- evdw1ij=0.25d0*(rij-r0ijsq)**2
- fac=rij-r0ijsq
- else
- evdw1ij=0.0d0
- fac=0.0d0
- endif
- evdw1=evdw1+evdw1ij
-C
-C Calculate contributions to the Cartesian gradient.
-C
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
- do k=1,3
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
- enddo ! j
- enddo ! i
-cgrad do i=nnt,nct-1
-cgrad do k=1,3
-cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
-cgrad enddo
-cgrad do j=i+1,nct-1
-cgrad do k=1,3
-cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
-cgrad enddo
-cgrad enddo
-cgrad enddo
- return
- end
-c------------------------------------------------------------------------------
- subroutine vec_and_deriv
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.VECTORS'
- include 'COMMON.SETUP'
- include 'COMMON.TIME1'
- dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
-C Compute the local reference systems. For reference system (i), the
-C X-axis points from CA(i) to CA(i+1), the Y axis is in the
-C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
-#ifdef PARVEC
- do i=ivec_start,ivec_end
-#else
- do i=1,nres-1
-#endif
- if (i.eq.nres-1) then
-C Case of the last full residue
-C Compute the Z-axis
- call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
- costh=dcos(pi-theta(nres))
- fac=1.0d0/dsqrt(1.0d0-costh*costh)
- do k=1,3
- uz(k,i)=fac*uz(k,i)
- enddo
-C Compute the derivatives of uz
- uzder(1,1,1)= 0.0d0
- uzder(2,1,1)=-dc_norm(3,i-1)
- uzder(3,1,1)= dc_norm(2,i-1)
- uzder(1,2,1)= dc_norm(3,i-1)
- uzder(2,2,1)= 0.0d0
- uzder(3,2,1)=-dc_norm(1,i-1)
- uzder(1,3,1)=-dc_norm(2,i-1)
- uzder(2,3,1)= dc_norm(1,i-1)
- uzder(3,3,1)= 0.0d0
- uzder(1,1,2)= 0.0d0
- uzder(2,1,2)= dc_norm(3,i)
- uzder(3,1,2)=-dc_norm(2,i)
- uzder(1,2,2)=-dc_norm(3,i)
- uzder(2,2,2)= 0.0d0
- uzder(3,2,2)= dc_norm(1,i)
- uzder(1,3,2)= dc_norm(2,i)
- uzder(2,3,2)=-dc_norm(1,i)
- uzder(3,3,2)= 0.0d0
-C Compute the Y-axis
- facy=fac
- do k=1,3
- uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
- enddo
-C Compute the derivatives of uy
- do j=1,3
- do k=1,3
- uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
- & -dc_norm(k,i)*dc_norm(j,i-1)
- uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
- enddo
- uyder(j,j,1)=uyder(j,j,1)-costh
- uyder(j,j,2)=1.0d0+uyder(j,j,2)
- enddo
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=uyder(l,k,j)
- uzgrad(l,k,j,i)=uzder(l,k,j)
- enddo
- enddo
- enddo
- call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
- call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
- call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
- call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
- else
-C Other residues
-C Compute the Z-axis
- call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
- costh=dcos(pi-theta(i+2))
- fac=1.0d0/dsqrt(1.0d0-costh*costh)
- do k=1,3
- uz(k,i)=fac*uz(k,i)
- enddo
-C Compute the derivatives of uz
- uzder(1,1,1)= 0.0d0
- uzder(2,1,1)=-dc_norm(3,i+1)
- uzder(3,1,1)= dc_norm(2,i+1)
- uzder(1,2,1)= dc_norm(3,i+1)
- uzder(2,2,1)= 0.0d0
- uzder(3,2,1)=-dc_norm(1,i+1)
- uzder(1,3,1)=-dc_norm(2,i+1)
- uzder(2,3,1)= dc_norm(1,i+1)
- uzder(3,3,1)= 0.0d0
- uzder(1,1,2)= 0.0d0
- uzder(2,1,2)= dc_norm(3,i)
- uzder(3,1,2)=-dc_norm(2,i)
- uzder(1,2,2)=-dc_norm(3,i)
- uzder(2,2,2)= 0.0d0
- uzder(3,2,2)= dc_norm(1,i)
- uzder(1,3,2)= dc_norm(2,i)
- uzder(2,3,2)=-dc_norm(1,i)
- uzder(3,3,2)= 0.0d0
-C Compute the Y-axis
- facy=fac
- do k=1,3
- uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
- enddo
-C Compute the derivatives of uy
- do j=1,3
- do k=1,3
- uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
- & -dc_norm(k,i)*dc_norm(j,i+1)
- uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
- enddo
- uyder(j,j,1)=uyder(j,j,1)-costh
- uyder(j,j,2)=1.0d0+uyder(j,j,2)
- enddo
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=uyder(l,k,j)
- uzgrad(l,k,j,i)=uzder(l,k,j)
- enddo
- enddo
- enddo
- call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
- call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
- call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
- call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
- endif
- enddo
- do i=1,nres-1
- vbld_inv_temp(1)=vbld_inv(i+1)
- if (i.lt.nres-1) then
- vbld_inv_temp(2)=vbld_inv(i+2)
- else
- vbld_inv_temp(2)=vbld_inv(i)
- endif
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
- uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
- enddo
- enddo
- enddo
- enddo
-#if defined(PARVEC) && defined(MPI)
- if (nfgtasks1.gt.1) then
- time00=MPI_Wtime()
-c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
-c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
-c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
- call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
- & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
- & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
- & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
- & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
- call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
- & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
- & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
- time_gather=time_gather+MPI_Wtime()-time00
- endif
-c if (fg_rank.eq.0) then
-c write (iout,*) "Arrays UY and UZ"
-c do i=1,nres-1
-c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
-c & (uz(k,i),k=1,3)
-c enddo
-c endif
-#endif
- return
- end
-C-----------------------------------------------------------------------------
- subroutine check_vecgrad
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.VECTORS'
- dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
- dimension uyt(3,maxres),uzt(3,maxres)
- dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
- double precision delta /1.0d-7/
- call vec_and_deriv
-cd do i=1,nres
-crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
-crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
-crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
-cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
-cd & (dc_norm(if90,i),if90=1,3)
-cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
-cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
-cd write(iout,'(a)')
-cd enddo
- do i=1,nres
- do j=1,2
- do k=1,3
- do l=1,3
- uygradt(l,k,j,i)=uygrad(l,k,j,i)
- uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
- enddo
- enddo
- enddo
- enddo
- call vec_and_deriv
- do i=1,nres
- do j=1,3
- uyt(j,i)=uy(j,i)
- uzt(j,i)=uz(j,i)
- enddo
- enddo
- do i=1,nres
-cd write (iout,*) 'i=',i
- do k=1,3
- erij(k)=dc_norm(k,i)
- enddo
- do j=1,3
- do k=1,3
- dc_norm(k,i)=erij(k)
- enddo
- dc_norm(j,i)=dc_norm(j,i)+delta
-c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
-c do k=1,3
-c dc_norm(k,i)=dc_norm(k,i)/fac
-c enddo
-c write (iout,*) (dc_norm(k,i),k=1,3)
-c write (iout,*) (erij(k),k=1,3)
- call vec_and_deriv
- do k=1,3
- uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
- uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
- uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
- uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
- enddo
-c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
-c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
- enddo
- do k=1,3
- dc_norm(k,i)=erij(k)
- enddo
-cd do k=1,3
-cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
-cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
-cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
-cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
-cd write (iout,'(a)')
-cd enddo
- enddo
- return
- end
-C--------------------------------------------------------------------------
- subroutine set_matrices
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
- include "COMMON.SETUP"
- integer IERR
- integer status(MPI_STATUS_SIZE)
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- double precision auxvec(2),auxmat(2,2)
-C
-C Compute the virtual-bond-torsional-angle dependent quantities needed
-C to calculate the el-loc multibody terms of various order.
-C
-#ifdef PARMAT
- do i=ivec_start+2,ivec_end+2
-#else
- do i=3,nres+1
-#endif
- if (i .lt. nres+1) then
- sin1=dsin(phi(i))
- cos1=dcos(phi(i))
- sintab(i-2)=sin1
- costab(i-2)=cos1
- obrot(1,i-2)=cos1
- obrot(2,i-2)=sin1
- sin2=dsin(2*phi(i))
- cos2=dcos(2*phi(i))
- sintab2(i-2)=sin2
- costab2(i-2)=cos2
- obrot2(1,i-2)=cos2
- obrot2(2,i-2)=sin2
- Ug(1,1,i-2)=-cos1
- Ug(1,2,i-2)=-sin1
- Ug(2,1,i-2)=-sin1
- Ug(2,2,i-2)= cos1
- Ug2(1,1,i-2)=-cos2
- Ug2(1,2,i-2)=-sin2
- Ug2(2,1,i-2)=-sin2
- Ug2(2,2,i-2)= cos2
- else
- costab(i-2)=1.0d0
- sintab(i-2)=0.0d0
- obrot(1,i-2)=1.0d0
- obrot(2,i-2)=0.0d0
- obrot2(1,i-2)=0.0d0
- obrot2(2,i-2)=0.0d0
- Ug(1,1,i-2)=1.0d0
- Ug(1,2,i-2)=0.0d0
- Ug(2,1,i-2)=0.0d0
- Ug(2,2,i-2)=1.0d0
- Ug2(1,1,i-2)=0.0d0
- Ug2(1,2,i-2)=0.0d0
- Ug2(2,1,i-2)=0.0d0
- Ug2(2,2,i-2)=0.0d0
- endif
- if (i .gt. 3 .and. i .lt. nres+1) then
- obrot_der(1,i-2)=-sin1
- obrot_der(2,i-2)= cos1
- Ugder(1,1,i-2)= sin1
- Ugder(1,2,i-2)=-cos1
- Ugder(2,1,i-2)=-cos1
- Ugder(2,2,i-2)=-sin1
- dwacos2=cos2+cos2
- dwasin2=sin2+sin2
- obrot2_der(1,i-2)=-dwasin2
- obrot2_der(2,i-2)= dwacos2
- Ug2der(1,1,i-2)= dwasin2
- Ug2der(1,2,i-2)=-dwacos2
- Ug2der(2,1,i-2)=-dwacos2
- Ug2der(2,2,i-2)=-dwasin2
- else
- obrot_der(1,i-2)=0.0d0
- obrot_der(2,i-2)=0.0d0
- Ugder(1,1,i-2)=0.0d0
- Ugder(1,2,i-2)=0.0d0
- Ugder(2,1,i-2)=0.0d0
- Ugder(2,2,i-2)=0.0d0
- obrot2_der(1,i-2)=0.0d0
- obrot2_der(2,i-2)=0.0d0
- Ug2der(1,1,i-2)=0.0d0
- Ug2der(1,2,i-2)=0.0d0
- Ug2der(2,1,i-2)=0.0d0
- Ug2der(2,2,i-2)=0.0d0
- endif
-c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
- if (i.gt. nnt+2 .and. i.lt.nct+2) then
- iti = itortyp(itype(i-2))
- else
- iti=ntortyp+1
- endif
-c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
- if (i.gt. nnt+1 .and. i.lt.nct+1) then
- iti1 = itortyp(itype(i-1))
- else
- iti1=ntortyp+1
- endif
-cd write (iout,*) '*******i',i,' iti1',iti
-cd write (iout,*) 'b1',b1(:,iti)
-cd write (iout,*) 'b2',b2(:,iti)
-cd write (iout,*) 'Ug',Ug(:,:,i-2)
-c if (i .gt. iatel_s+2) then
- if (i .gt. nnt+2) then
- call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
- call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
- & then
- call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
- call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
- call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
- call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
- call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
- endif
- else
- do k=1,2
- Ub2(k,i-2)=0.0d0
- Ctobr(k,i-2)=0.0d0
- Dtobr2(k,i-2)=0.0d0
- do l=1,2
- EUg(l,k,i-2)=0.0d0
- CUg(l,k,i-2)=0.0d0
- DUg(l,k,i-2)=0.0d0
- DtUg2(l,k,i-2)=0.0d0
- enddo
- enddo
- endif
- call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
- call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
- do k=1,2
- muder(k,i-2)=Ub2der(k,i-2)
- enddo
-c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
- if (i.gt. nnt+1 .and. i.lt.nct+1) then
- iti1 = itortyp(itype(i-1))
- else
- iti1=ntortyp+1
- endif
- do k=1,2
- mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
- enddo
-cd write (iout,*) 'mu ',mu(:,i-2)
-cd write (iout,*) 'mu1',mu1(:,i-2)
-cd write (iout,*) 'mu2',mu2(:,i-2)
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
- & then
- call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
- call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
- call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
- call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
- call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
-C Vectors and matrices dependent on a single virtual-bond dihedral.
- call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
- call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
- call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
- call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
- call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
- call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
- call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
- call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
- call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
- endif
- enddo
-C Matrices dependent on two consecutive virtual-bond dihedrals.
-C The order of matrices is from left to right.
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
- &then
-c do i=max0(ivec_start,2),ivec_end
- do i=2,nres-1
- call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
- call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
- call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
- call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
- call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
- call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
- call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
- call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
- enddo
- endif
-#if defined(MPI) && defined(PARMAT)
-#ifdef DEBUG
-c if (fg_rank.eq.0) then
- write (iout,*) "Arrays UG and UGDER before GATHER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & ((ug(l,k,i),l=1,2),k=1,2),
- & ((ugder(l,k,i),l=1,2),k=1,2)
- enddo
- write (iout,*) "Arrays UG2 and UG2DER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & ((ug2(l,k,i),l=1,2),k=1,2),
- & ((ug2der(l,k,i),l=1,2),k=1,2)
- enddo
- write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
- & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
- enddo
- write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & costab(i),sintab(i),costab2(i),sintab2(i)
- enddo
- write (iout,*) "Array MUDER"
- do i=1,nres-1
- write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
- enddo
-c endif
-#endif
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
-c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
-c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
-c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
-#ifdef MATGATHER
- call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
- call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
- call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
- call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
- & then
- call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
- & MPI_MAT2,FG_COMM1,IERR)
- call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
- & MPI_MAT2,FG_COMM1,IERR)
- endif
-#else
-c Passes matrix info through the ring
- isend=fg_rank1
- irecv=fg_rank1-1
- if (irecv.lt.0) irecv=nfgtasks1-1
- iprev=irecv
- inext=fg_rank1+1
- if (inext.ge.nfgtasks1) inext=0
- do i=1,nfgtasks1-1
-c write (iout,*) "isend",isend," irecv",irecv
-c call flush(iout)
- lensend=lentyp(isend)
- lenrecv=lentyp(irecv)
-c write (iout,*) "lensend",lensend," lenrecv",lenrecv
-c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
-c & MPI_ROTAT1(lensend),inext,2200+isend,
-c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
-c & iprev,2200+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather ROTAT1"
-c call flush(iout)
-c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
-c & MPI_ROTAT2(lensend),inext,3300+isend,
-c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
-c & iprev,3300+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather ROTAT2"
-c call flush(iout)
- call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
- & MPI_ROTAT_OLD(lensend),inext,4400+isend,
- & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
- & iprev,4400+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather ROTAT_OLD"
-c call flush(iout)
- call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
- & MPI_PRECOMP11(lensend),inext,5500+isend,
- & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
- & iprev,5500+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP11"
-c call flush(iout)
- call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
- & MPI_PRECOMP12(lensend),inext,6600+isend,
- & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
- & iprev,6600+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP12"
-c call flush(iout)
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
- & then
- call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
- & MPI_ROTAT2(lensend),inext,7700+isend,
- & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
- & iprev,7700+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP21"
-c call flush(iout)
- call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
- & MPI_PRECOMP22(lensend),inext,8800+isend,
- & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
- & iprev,8800+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP22"
-c call flush(iout)
- call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
- & MPI_PRECOMP23(lensend),inext,9900+isend,
- & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
- & MPI_PRECOMP23(lenrecv),
- & iprev,9900+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP23"
-c call flush(iout)
- endif
- isend=irecv
- irecv=irecv-1
- if (irecv.lt.0) irecv=nfgtasks1-1
- enddo
-#endif
- time_gather=time_gather+MPI_Wtime()-time00
- endif
-#ifdef DEBUG
-c if (fg_rank.eq.0) then
- write (iout,*) "Arrays UG and UGDER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & ((ug(l,k,i),l=1,2),k=1,2),
- & ((ugder(l,k,i),l=1,2),k=1,2)
- enddo
- write (iout,*) "Arrays UG2 and UG2DER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & ((ug2(l,k,i),l=1,2),k=1,2),
- & ((ug2der(l,k,i),l=1,2),k=1,2)
- enddo
- write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
- & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
- enddo
- write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & costab(i),sintab(i),costab2(i),sintab2(i)
- enddo
- write (iout,*) "Array MUDER"
- do i=1,nres-1
- write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
- enddo
-c endif
-#endif
-#endif
-cd do i=1,nres
-cd iti = itortyp(itype(i))
-cd write (iout,*) i
-cd do j=1,2
-cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
-cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
-cd enddo
-cd enddo
- return
- end
-C--------------------------------------------------------------------------
- subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
-C
-C This subroutine calculates the average interaction energy and its gradient
-C in the virtual-bond vectors between non-adjacent peptide groups, based on
-C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
-C The potential depends both on the distance of peptide-group centers and on
-C the orientation of the CA-CA virtual bonds.
-C
- implicit real*8 (a-h,o-z)
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.TIME1'
- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
- & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
- double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
-c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- double precision scal_el /1.0d0/
-#else
- double precision scal_el /0.5d0/
-#endif
-C 12/13/98
-C 13-go grudnia roku pamietnego...
- double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
- & 0.0d0,1.0d0,0.0d0,
- & 0.0d0,0.0d0,1.0d0/
-cd write(iout,*) 'In EELEC'
-cd do i=1,nloctyp
-cd write(iout,*) 'Type',i
-cd write(iout,*) 'B1',B1(:,i)
-cd write(iout,*) 'B2',B2(:,i)
-cd write(iout,*) 'CC',CC(:,:,i)
-cd write(iout,*) 'DD',DD(:,:,i)
-cd write(iout,*) 'EE',EE(:,:,i)
-cd enddo
-cd call check_vecgrad
-cd stop
- if (icheckgrad.eq.1) then
- do i=1,nres-1
- fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
- do k=1,3
- dc_norm(k,i)=dc(k,i)*fac
- enddo
-c write (iout,*) 'i',i,' fac',fac
- enddo
- endif
- if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
- & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
- & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
-c call vec_and_deriv
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
- call set_matrices
-#ifdef TIMING
- time_mat=time_mat+MPI_Wtime()-time01
-#endif
- endif
-cd do i=1,nres-1
-cd write (iout,*) 'i=',i
-cd do k=1,3
-cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
-cd enddo
-cd do k=1,3
-cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
-cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
-cd enddo
-cd enddo
- t_eelecij=0.0d0
- ees=0.0D0
- evdw1=0.0D0
- eel_loc=0.0d0
- eello_turn3=0.0d0
- eello_turn4=0.0d0
- ind=0
- do i=1,nres
- num_cont_hb(i)=0
- enddo
-cd print '(a)','Enter EELEC'
-cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
- do i=1,nres
- gel_loc_loc(i)=0.0d0
- gcorr_loc(i)=0.0d0
- enddo
-c
-c
-c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
-C
-C Loop over i,i+2 and i,i+3 pairs of the peptide groups
-C
- do i=iturn3_start,iturn3_end
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=0
- call eelecij(i,i+2,ees,evdw1,eel_loc)
- if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
- num_cont_hb(i)=num_conti
- enddo
- do i=iturn4_start,iturn4_end
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=num_cont_hb(i)
- call eelecij(i,i+3,ees,evdw1,eel_loc)
- if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
- num_cont_hb(i)=num_conti
- enddo ! i
-c
-c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
-c
- do i=iatel_s,iatel_e
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
-c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
- num_conti=num_cont_hb(i)
- do j=ielstart(i),ielend(i)
- call eelecij(i,j,ees,evdw1,eel_loc)
- enddo ! j
- num_cont_hb(i)=num_conti
- enddo ! i
-c write (iout,*) "Number of loop steps in EELEC:",ind
-cd do i=1,nres
-cd write (iout,'(i3,3f10.5,5x,3f10.5)')
-cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
-cd enddo
-c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
-ccc eel_loc=eel_loc+eello_turn3
-cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
- return
- end
-C-------------------------------------------------------------------------------
- subroutine eelecij(i,j,ees,evdw1,eel_loc)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.TIME1'
- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
- & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
- double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
-c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- double precision scal_el /1.0d0/
-#else
- double precision scal_el /0.5d0/
-#endif
-C 12/13/98
-C 13-go grudnia roku pamietnego...
- double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
- & 0.0d0,1.0d0,0.0d0,
- & 0.0d0,0.0d0,1.0d0/
-c time00=MPI_Wtime()
-cd write (iout,*) "eelecij",i,j
- ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- aaa=app(iteli,itelj)
- bbb=bpp(iteli,itelj)
- ael6i=ael6(iteli,itelj)
- ael3i=ael3(iteli,itelj)
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- dx_normj=dc_norm(1,j)
- dy_normj=dc_norm(2,j)
- dz_normj=dc_norm(3,j)
- xj=c(1,j)+0.5D0*dxj-xmedi
- yj=c(2,j)+0.5D0*dyj-ymedi
- zj=c(3,j)+0.5D0*dzj-zmedi
- rij=xj*xj+yj*yj+zj*zj
- rrmij=1.0D0/rij
- rij=dsqrt(rij)
- rmij=1.0D0/rij
- r3ij=rrmij*rmij
- r6ij=r3ij*r3ij
- cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
- cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
- cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
- fac=cosa-3.0D0*cosb*cosg
- ev1=aaa*r6ij*r6ij
-c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
- if (j.eq.i+2) ev1=scal_el*ev1
- ev2=bbb*r6ij
- fac3=ael6i*r6ij
- fac4=ael3i*r3ij
- evdwij=ev1+ev2
- el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
- el2=fac4*fac
- eesij=el1+el2
-C 12/26/95 - for the evaluation of multi-body H-bonding interactions
- ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
- ees=ees+eesij
- evdw1=evdw1+evdwij
-cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
-cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
-cd & xmedi,ymedi,zmedi,xj,yj,zj
-
- if (energy_dec) then
- write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
- write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
- endif
-
-C
-C Calculate contributions to the Cartesian gradient.
-C
-#ifdef SPLITELE
- facvdw=-6*rrmij*(ev1+evdwij)
- facel=-3*rrmij*(el1+eesij)
- fac1=fac
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
-*
-* Radial derivatives. First process both termini of the fragment (i,j)
-*
- ggg(1)=facel*xj
- ggg(2)=facel*yj
- ggg(3)=facel*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c gelc(k,j)=gelc(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
-c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-#else
- facvdw=ev1+evdwij
- facel=el1+eesij
- fac1=fac
- fac=-3*rrmij*(facvdw+facvdw+facel)
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
-*
-* Radial derivatives. First process both termini of the fragment (i,j)
-*
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c gelc(k,j)=gelc(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gelc_long(k,j)=gelc(k,j)+ggg(k)
- gelc_long(k,i)=gelc(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
-#endif
-*
-* Angular part
-*
- ecosa=2.0D0*fac3*fac1+fac4
- fac4=-3.0D0*fac4
- fac3=-6.0D0*fac3
- ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
- ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
-cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
-cd & (dcosg(k),k=1,3)
- do k=1,3
- ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
- enddo
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
-c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
-c gelc(k,j)=gelc(k,j)+ghalf
-c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
-c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
-c enddo
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
- do k=1,3
- gelc(k,i)=gelc(k,i)
- & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gelc(k,j)=gelc(k,j)
- & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
- enddo
- IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
- & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
- & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
-C
-C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
-C energy of a peptide unit is assumed in the form of a second-order
-C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
-C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
-C are computed for EVERY pair of non-contiguous peptide groups.
-C
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- kkk=0
- do k=1,2
- do l=1,2
- kkk=kkk+1
- muij(kkk)=mu(k,i)*mu(l,j)
- enddo
- enddo
-cd write (iout,*) 'EELEC: i',i,' j',j
-cd write (iout,*) 'j',j,' j1',j1,' j2',j2
-cd write(iout,*) 'muij',muij
- ury=scalar(uy(1,i),erij)
- urz=scalar(uz(1,i),erij)
- vry=scalar(uy(1,j),erij)
- vrz=scalar(uz(1,j),erij)
- a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
- a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
- a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
- a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
- fac=dsqrt(-ael6i)*r3ij
- a22=a22*fac
- a23=a23*fac
- a32=a32*fac
- a33=a33*fac
-cd write (iout,'(4i5,4f10.5)')
-cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
-cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
-cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
-cd & uy(:,j),uz(:,j)
-cd write (iout,'(4f10.5)')
-cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
-cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
-cd write (iout,'(4f10.5)') ury,urz,vry,vrz
-cd write (iout,'(9f10.5/)')
-cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
-C Derivatives of the elements of A in virtual-bond vectors
- call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
- do k=1,3
- uryg(k,1)=scalar(erder(1,k),uy(1,i))
- uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
- uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
- urzg(k,1)=scalar(erder(1,k),uz(1,i))
- urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
- urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
- vryg(k,1)=scalar(erder(1,k),uy(1,j))
- vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
- vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
- vrzg(k,1)=scalar(erder(1,k),uz(1,j))
- vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
- vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
- enddo
-C Compute radial contributions to the gradient
- facr=-3.0d0*rrmij
- a22der=a22*facr
- a23der=a23*facr
- a32der=a32*facr
- a33der=a33*facr
- agg(1,1)=a22der*xj
- agg(2,1)=a22der*yj
- agg(3,1)=a22der*zj
- agg(1,2)=a23der*xj
- agg(2,2)=a23der*yj
- agg(3,2)=a23der*zj
- agg(1,3)=a32der*xj
- agg(2,3)=a32der*yj
- agg(3,3)=a32der*zj
- agg(1,4)=a33der*xj
- agg(2,4)=a33der*yj
- agg(3,4)=a33der*zj
-C Add the contributions coming from er
- fac3=-3.0d0*fac
- do k=1,3
- agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
- agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
- agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
- agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
- enddo
- do k=1,3
-C Derivatives in DC(i)
-cgrad ghalf1=0.5d0*agg(k,1)
-cgrad ghalf2=0.5d0*agg(k,2)
-cgrad ghalf3=0.5d0*agg(k,3)
-cgrad ghalf4=0.5d0*agg(k,4)
- aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
- & -3.0d0*uryg(k,2)*vry)!+ghalf1
- aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
- & -3.0d0*uryg(k,2)*vrz)!+ghalf2
- aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
- & -3.0d0*urzg(k,2)*vry)!+ghalf3
- aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
- & -3.0d0*urzg(k,2)*vrz)!+ghalf4
-C Derivatives in DC(i+1)
- aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
- & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
- aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
- & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
- aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
- & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
- aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
- & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
-C Derivatives in DC(j)
- aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
- & -3.0d0*vryg(k,2)*ury)!+ghalf1
- aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
- & -3.0d0*vrzg(k,2)*ury)!+ghalf2
- aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
- & -3.0d0*vryg(k,2)*urz)!+ghalf3
- aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
- & -3.0d0*vrzg(k,2)*urz)!+ghalf4
-C Derivatives in DC(j+1) or DC(nres-1)
- aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
- & -3.0d0*vryg(k,3)*ury)
- aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
- & -3.0d0*vrzg(k,3)*ury)
- aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
- & -3.0d0*vryg(k,3)*urz)
- aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
- & -3.0d0*vrzg(k,3)*urz)
-cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
-cgrad do l=1,4
-cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
-cgrad enddo
-cgrad endif
- enddo
- acipa(1,1)=a22
- acipa(1,2)=a23
- acipa(2,1)=a32
- acipa(2,2)=a33
- a22=-a22
- a23=-a23
- do l=1,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- if (j.lt.nres-1) then
- a22=-a22
- a32=-a32
- do l=1,3,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- else
- a22=-a22
- a23=-a23
- a32=-a32
- a33=-a33
- do l=1,4
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- endif
- ENDIF ! WCORR
- IF (wel_loc.gt.0.0d0) THEN
-C Contribution to the local-electrostatic energy coming from the i-j pair
- eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
- & +a33*muij(4)
-cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
-
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'eelloc',i,j,eel_loc_ij
-
- eel_loc=eel_loc+eel_loc_ij
-C Partial derivatives in virtual-bond dihedral angles gamma
- if (i.gt.1)
- & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
- & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
- & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
- gel_loc_loc(j-1)=gel_loc_loc(j-1)+
- & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
- & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
-C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
- do l=1,3
- ggg(l)=agg(l,1)*muij(1)+
- & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
- gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
- gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
-cgrad ghalf=0.5d0*ggg(l)
-cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
-cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
- enddo
-cgrad do k=i+1,j2
-cgrad do l=1,3
-cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-C Remaining derivatives of eello
- do l=1,3
- gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
- & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
- gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
- & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
- gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
- & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
- gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
- & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
- enddo
- ENDIF
-C Change 12/26/95 to calculate four-body contributions to H-bonding energy
-c if (j.gt.i+1 .and. num_conti.le.maxconts) then
- if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
- & .and. num_conti.le.maxconts) then
-c write (iout,*) i,j," entered corr"
-C
-C Calculate the contact function. The ith column of the array JCONT will
-C contain the numbers of atoms that make contacts with the atom I (of numbers
-C greater than I). The arrays FACONT and GACONT will contain the values of
-C the contact function and its derivative.
-c r0ij=1.02D0*rpp(iteli,itelj)
-c r0ij=1.11D0*rpp(iteli,itelj)
- r0ij=2.20D0*rpp(iteli,itelj)
-c r0ij=1.55D0*rpp(iteli,itelj)
- call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
- if (fcont.gt.0.0D0) then
- num_conti=num_conti+1
- if (num_conti.gt.maxconts) then
- write (iout,*) 'WARNING - max. # of contacts exceeded;',
- & ' will skip next contacts for this conf.'
- else
- jcont_hb(num_conti,i)=j
-cd write (iout,*) "i",i," j",j," num_conti",num_conti,
-cd & " jcont_hb",jcont_hb(num_conti,i)
- IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
- & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
-C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
-C terms.
- d_cont(num_conti,i)=rij
-cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
-C --- Electrostatic-interaction matrix ---
- a_chuj(1,1,num_conti,i)=a22
- a_chuj(1,2,num_conti,i)=a23
- a_chuj(2,1,num_conti,i)=a32
- a_chuj(2,2,num_conti,i)=a33
-C --- Gradient of rij
- do kkk=1,3
- grij_hb_cont(kkk,num_conti,i)=erij(kkk)
- enddo
- kkll=0
- do k=1,2
- do l=1,2
- kkll=kkll+1
- do m=1,3
- a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
- a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
- a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
- a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
- a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
- enddo
- enddo
- enddo
- ENDIF
- IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
-C Calculate contact energies
- cosa4=4.0D0*cosa
- wij=cosa-3.0D0*cosb*cosg
- cosbg1=cosb+cosg
- cosbg2=cosb-cosg
-c fac3=dsqrt(-ael6i)/r0ij**3
- fac3=dsqrt(-ael6i)*r3ij
-c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
- ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
- if (ees0tmp.gt.0) then
- ees0pij=dsqrt(ees0tmp)
- else
- ees0pij=0
- endif
-c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
- ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
- if (ees0tmp.gt.0) then
- ees0mij=dsqrt(ees0tmp)
- else
- ees0mij=0
- endif
-c ees0mij=0.0D0
- ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
- ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
-C Diagnostics. Comment out or remove after debugging!
-c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
-c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
-c ees0m(num_conti,i)=0.0D0
-C End diagnostics.
-c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
-c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
-C Angular derivatives of the contact function
- ees0pij1=fac3/ees0pij
- ees0mij1=fac3/ees0mij
- fac3p=-3.0D0*fac3*rrmij
- ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
- ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
-c ees0mij1=0.0D0
- ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
- ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
- ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
- ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
- ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
- ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
- ecosap=ecosa1+ecosa2
- ecosbp=ecosb1+ecosb2
- ecosgp=ecosg1+ecosg2
- ecosam=ecosa1-ecosa2
- ecosbm=ecosb1-ecosb2
- ecosgm=ecosg1-ecosg2
-C Diagnostics
-c ecosap=ecosa1
-c ecosbp=ecosb1
-c ecosgp=ecosg1
-c ecosam=0.0D0
-c ecosbm=0.0D0
-c ecosgm=0.0D0
-C End diagnostics
- facont_hb(num_conti,i)=fcont
- fprimcont=fprimcont/rij
-cd facont_hb(num_conti,i)=1.0D0
-C Following line is for diagnostics.
-cd fprimcont=0.0D0
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
- do k=1,3
- gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
- gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
- enddo
- gggp(1)=gggp(1)+ees0pijp*xj
- gggp(2)=gggp(2)+ees0pijp*yj
- gggp(3)=gggp(3)+ees0pijp*zj
- gggm(1)=gggm(1)+ees0mijp*xj
- gggm(2)=gggm(2)+ees0mijp*yj
- gggm(3)=gggm(3)+ees0mijp*zj
-C Derivatives due to the contact function
- gacont_hbr(1,num_conti,i)=fprimcont*xj
- gacont_hbr(2,num_conti,i)=fprimcont*yj
- gacont_hbr(3,num_conti,i)=fprimcont*zj
- do k=1,3
-c
-c 10/24/08 cgrad and ! comments indicate the parts of the code removed
-c following the change of gradient-summation algorithm.
-c
-cgrad ghalfp=0.5D0*gggp(k)
-cgrad ghalfm=0.5D0*gggm(k)
- gacontp_hb1(k,num_conti,i)=!ghalfp
- & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gacontp_hb2(k,num_conti,i)=!ghalfp
- & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gacontp_hb3(k,num_conti,i)=gggp(k)
- gacontm_hb1(k,num_conti,i)=!ghalfm
- & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gacontm_hb2(k,num_conti,i)=!ghalfm
- & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gacontm_hb3(k,num_conti,i)=gggm(k)
- enddo
-C Diagnostics. Comment out or remove after debugging!
-cdiag do k=1,3
-cdiag gacontp_hb1(k,num_conti,i)=0.0D0
-cdiag gacontp_hb2(k,num_conti,i)=0.0D0
-cdiag gacontp_hb3(k,num_conti,i)=0.0D0
-cdiag gacontm_hb1(k,num_conti,i)=0.0D0
-cdiag gacontm_hb2(k,num_conti,i)=0.0D0
-cdiag gacontm_hb3(k,num_conti,i)=0.0D0
-cdiag enddo
- ENDIF ! wcorr
- endif ! num_conti.le.maxconts
- endif ! fcont.gt.0
- endif ! j.gt.i+1
- if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
- do k=1,4
- do l=1,3
- ghalf=0.5d0*agg(l,k)
- aggi(l,k)=aggi(l,k)+ghalf
- aggi1(l,k)=aggi1(l,k)+agg(l,k)
- aggj(l,k)=aggj(l,k)+ghalf
- enddo
- enddo
- if (j.eq.nres-1 .and. i.lt.j-2) then
- do k=1,4
- do l=1,3
- aggj1(l,k)=aggj1(l,k)+agg(l,k)
- enddo
- enddo
- endif
- endif
-c t_eelecij=t_eelecij+MPI_Wtime()-time00
- return
- end
-C-----------------------------------------------------------------------------
- subroutine eturn3(i,eello_turn3)
-C Third- and fourth-order contributions from turns
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- dimension ggg(3)
- double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
- & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
- & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
- double precision agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
- j=i+2
-c write (iout,*) "eturn3",i,j,j1,j2
- a_temp(1,1)=a22
- a_temp(1,2)=a23
- a_temp(2,1)=a32
- a_temp(2,2)=a33
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C Third-order contributions
-C
-C (i+2)o----(i+3)
-C | |
-C | |
-C (i+1)o----i
-C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd call checkint_turn3(i,a_temp,eello_turn3_num)
- call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
- call transpose2(auxmat(1,1),auxmat1(1,1))
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
-cd write (2,*) 'i,',i,' j',j,'eello_turn3',
-cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
-cd & ' eello_turn3_num',4*eello_turn3_num
-C Derivatives in gamma(i)
- call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
- call transpose2(auxmat2(1,1),auxmat3(1,1))
- call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
- gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
-C Derivatives in gamma(i+1)
- call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
- call transpose2(auxmat2(1,1),auxmat3(1,1))
- call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
- gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
-C Cartesian derivatives
- do l=1,3
-c ghalf1=0.5d0*agg(l,1)
-c ghalf2=0.5d0*agg(l,2)
-c ghalf3=0.5d0*agg(l,3)
-c ghalf4=0.5d0*agg(l,4)
- a_temp(1,1)=aggi(l,1)!+ghalf1
- a_temp(1,2)=aggi(l,2)!+ghalf2
- a_temp(2,1)=aggi(l,3)!+ghalf3
- a_temp(2,2)=aggi(l,4)!+ghalf4
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,i)=gcorr3_turn(l,i)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- a_temp(1,1)=aggi1(l,1)!+agg(l,1)
- a_temp(1,2)=aggi1(l,2)!+agg(l,2)
- a_temp(2,1)=aggi1(l,3)!+agg(l,3)
- a_temp(2,2)=aggi1(l,4)!+agg(l,4)
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- a_temp(1,1)=aggj(l,1)!+ghalf1
- a_temp(1,2)=aggj(l,2)!+ghalf2
- a_temp(2,1)=aggj(l,3)!+ghalf3
- a_temp(2,2)=aggj(l,4)!+ghalf4
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,j)=gcorr3_turn(l,j)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- a_temp(1,1)=aggj1(l,1)
- a_temp(1,2)=aggj1(l,2)
- a_temp(2,1)=aggj1(l,3)
- a_temp(2,2)=aggj1(l,4)
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- enddo
- return
- end
-C-------------------------------------------------------------------------------
- subroutine eturn4(i,eello_turn4)
-C Third- and fourth-order contributions from turns
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- dimension ggg(3)
- double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
- & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
- & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
- double precision agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
- j=i+3
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C Fourth-order contributions
-C
-C (i+3)o----(i+4)
-C / |
-C (i+2)o |
-C \ |
-C (i+1)o----i
-C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd call checkint_turn4(i,a_temp,eello_turn4_num)
-c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
- a_temp(1,1)=a22
- a_temp(1,2)=a23
- a_temp(2,1)=a32
- a_temp(2,2)=a33
- iti1=itortyp(itype(i+1))
- iti2=itortyp(itype(i+2))
- iti3=itortyp(itype(i+3))
-c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
- call transpose2(EUg(1,1,i+1),e1t(1,1))
- call transpose2(Eug(1,1,i+2),e2t(1,1))
- call transpose2(Eug(1,1,i+3),e3t(1,1))
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- eello_turn4=eello_turn4-(s1+s2+s3)
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'eturn4',i,j,-(s1+s2+s3)
-cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
-cd & ' eello_turn4_num',8*eello_turn4_num
-C Derivatives in gamma(i)
- call transpose2(EUgder(1,1,i+1),e1tder(1,1))
- call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
-C Derivatives in gamma(i+1)
- call transpose2(EUgder(1,1,i+2),e2tder(1,1))
- call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
- call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
-C Derivatives in gamma(i+2)
- call transpose2(EUgder(1,1,i+3),e3tder(1,1))
- call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
- call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
-C Cartesian derivatives
-C Derivatives of this turn contributions in DC(i+2)
- if (j.lt.nres-1) then
- do l=1,3
- a_temp(1,1)=agg(l,1)
- a_temp(1,2)=agg(l,2)
- a_temp(2,1)=agg(l,3)
- a_temp(2,2)=agg(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- ggg(l)=-(s1+s2+s3)
- gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
- enddo
- endif
-C Remaining derivatives of this turn contribution
- do l=1,3
- a_temp(1,1)=aggi(l,1)
- a_temp(1,2)=aggi(l,2)
- a_temp(2,1)=aggi(l,3)
- a_temp(2,2)=aggi(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
- a_temp(1,1)=aggi1(l,1)
- a_temp(1,2)=aggi1(l,2)
- a_temp(2,1)=aggi1(l,3)
- a_temp(2,2)=aggi1(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
- a_temp(1,1)=aggj(l,1)
- a_temp(1,2)=aggj(l,2)
- a_temp(2,1)=aggj(l,3)
- a_temp(2,2)=aggj(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
- a_temp(1,1)=aggj1(l,1)
- a_temp(1,2)=aggj1(l,2)
- a_temp(2,1)=aggj1(l,3)
- a_temp(2,2)=aggj1(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
-c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
- gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
- enddo
- return
- end
-C-----------------------------------------------------------------------------
- subroutine vecpr(u,v,w)
- implicit real*8(a-h,o-z)
- dimension u(3),v(3),w(3)
- w(1)=u(2)*v(3)-u(3)*v(2)
- w(2)=-u(1)*v(3)+u(3)*v(1)
- w(3)=u(1)*v(2)-u(2)*v(1)
- return
- end
-C-----------------------------------------------------------------------------
- subroutine unormderiv(u,ugrad,unorm,ungrad)
-C This subroutine computes the derivatives of a normalized vector u, given
-C the derivatives computed without normalization conditions, ugrad. Returns
-C ungrad.
- implicit none
- double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
- double precision vec(3)
- double precision scalar
- integer i,j
-c write (2,*) 'ugrad',ugrad
-c write (2,*) 'u',u
- do i=1,3
- vec(i)=scalar(ugrad(1,i),u(1))
- enddo
-c write (2,*) 'vec',vec
- do i=1,3
- do j=1,3
- ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
- enddo
- enddo
-c write (2,*) 'ungrad',ungrad
- return
- end
-C-----------------------------------------------------------------------------
- subroutine escp_soft_sphere(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
- r0_scp=4.5d0
-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
- rij=xj*xj+yj*yj+zj*zj
- r0ij=r0_scp
- r0ijsq=r0ij*r0ij
- if (rij.lt.r0ijsq) then
- evdwij=0.25d0*(rij-r0ijsq)**2
- fac=rij-r0ijsq
- else
- evdwij=0.0d0
- fac=0.0d0
- endif
- evdw2=evdw2+evdwij
-C
-C Calculate contributions to the gradient in the virtual-bond and SC vectors.
-C
- ggg(1)=xj*fac
- ggg(2)=yj*fac
- ggg(3)=zj*fac
-cgrad if (j.lt.i) then
-cd write (iout,*) 'j<i'
-C Uncomment following three lines for SC-p interactions
-c do k=1,3
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-c enddo
-cgrad else
-cd write (iout,*) 'j>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,*) 'j<i'
-C Uncomment following three lines for SC-p interactions
-c do k=1,3
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-c enddo
-cgrad else
-cd write (iout,*) 'j>i'
-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
-
+++ /dev/null
- 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
#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),
+++ /dev/null
- 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%.
igeom= 8
intin= 9
ithep= 11
+ ithep_pdb=51
irotam=12
+ irotam_pdb=52
itorp= 13
itordp= 23
ielep= 14
+++ /dev/null
-#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
external func,gradient,fdum
external func_restr,grad_restr
logical not_done,change,reduce
- common /przechowalnia/ v
+c common /przechowalnia/ v
icall = 1
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
+++ /dev/null
-#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
+++ /dev/null
- text data bss dec hex filename
- 342 80 0 422 1a6 add.o
- text data bss dec hex filename
- 104 44 0 148 94 arcos.o
- text data bss dec hex filename
- 2316 352 0 2668 a6c banach.o
- text data bss dec hex filename
- 42120 5468 772 48360 bce8 bank.o
- text data bss dec hex filename
- 9994 764 8 10766 2a0e blas.o
- text data bss dec hex filename
- 5016 680 272 5968 1750 bond_move.o
- text data bss dec hex filename
- 4144 196 259392 263732 40634 cartder.o
- text data bss dec hex filename
- 1040 224 0 1264 4f0 cartprint.o
- text data bss dec hex filename
- 2572 404 40 3016 bc8 chainbuild.o
- text data bss dec hex filename
- 368 132 184 684 2ac check_bond.o
- text data bss dec hex filename
- 16364 2264 390656 409284 63ec4 checkder_p.o
- text data bss dec hex filename
- 696 236 32 964 3c4 check_sc_distr.o
- text data bss dec hex filename
- 2640 832 0 3472 d90 cinfo.o
- text data bss dec hex filename
- 6036 980 43352 50368 c4c0 compare_s1.o
- text data bss dec hex filename
- 5032 672 86456 92160 16800 contact.o
- text data bss dec hex filename
- 3576 484 43216 47276 b8ac convert.o
- text data bss dec hex filename
- 28680 5840 1240 35760 8bb0 cored.o
- text data bss dec hex filename
- 7372 1448 264 9084 237c csa.o
- text data bss dec hex filename
- 632 52 0 684 2ac diff12.o
- text data bss dec hex filename
- 5276 768 248 6292 1894 dihed_cons.o
- text data bss dec hex filename
- 5840 884 21744 28468 6f34 distfit.o
- text data bss dec hex filename
- 4276 256 1256 5788 169c djacob.o
- text data bss dec hex filename
- 2200 240 0 2440 988 econstr_local.o
- text data bss dec hex filename
- 35258 3508 320 39086 98ae eigen.o
- text data bss dec hex filename
- 17660 1744 191000 210404 335e4 elecont.o
- text data bss dec hex filename
- 150482 10704 429408 590594 90302 energy_p_new.o
- text data bss dec hex filename
- 44420 4204 1136 49760 c260 energy_p_new-sep.o
- text data bss dec hex filename
- 3276 304 600 4180 1054 energy_split-sep.o
- text data bss dec hex filename
- 27800 2828 86956 117584 1cb50 entmcm.o
- text data bss dec hex filename
- 9964 764 568 11296 2c20 fitsq.o
- text data bss dec hex filename
- 2604 136 0 2740 ab4 gauss.o
- text data bss dec hex filename
- 15888 3224 6056 25168 6250 gen_rand_conf.o
- text data bss dec hex filename
- 21996 2892 26120 51008 c740 geomout.o
- text data bss dec hex filename
- 272 156 0 428 1ac gnmr1.o
- text data bss dec hex filename
- 5564 464 24 6052 17a4 gradient_p.o
- text data bss dec hex filename
- 1202 116 2000 3318 cf6 indexx.o
- text data bss dec hex filename
- 9528 16928 8308 34764 87cc initialize_p.o
- text data bss dec hex filename
- 12732 1176 633768 647676 9e1fc intcartderiv.o
- text data bss dec hex filename
- 1300 192 72 1564 61c intcor.o
- text data bss dec hex filename
- 11628 1740 384 13752 35b8 intlocal.o
- text data bss dec hex filename
- 4732 180 0 4912 1330 int_to_cart.o
- text data bss dec hex filename
- 2116 132 48 2296 8f8 kinetic_lesyng.o
- text data bss dec hex filename
- 21386 2700 39369688 39393774 25919ee lagrangian_lesyng.o
- text data bss dec hex filename
- 12394 1692 624 14710 3976 local_move.o
- text data bss dec hex filename
- 3802 412 86768 90982 16366 map.o
- text data bss dec hex filename
- 648 60 72 780 30c matmult.o
- text data bss dec hex filename
- 32904 4732 218020 255656 3e6a8 mcm.o
- text data bss dec hex filename
- 25172 2412 130332 157916 268dc mc.o
- text data bss dec hex filename
- 51422 5916 865520 922858 e14ea MD_A-MTS.o
- text data bss dec hex filename
- 8328 764 260456 269548 41cec minimize_p.o
- text data bss dec hex filename
- 11376 1464 3406284 3419124 342bf4 minim_jlee.o
- text data bss dec hex filename
- 1384 164 86728 88276 158d4 minim_mcmf.o
- text data bss dec hex filename
- 5170 878 216 6264 1878 misc.o
- text data bss dec hex filename
- 6752 368 712 7832 1e98 moments.o
- text data bss dec hex filename
- 19346 3576 8716 31638 7b96 MP.o
- text data bss dec hex filename
- 42300 4512 14380584 14427396 dc2504 MREMD.o
- text data bss dec hex filename
- 8912 1368 20568 30848 7880 muca_md.o
- text data bss dec hex filename
- 50648 2904 24272 77824 13000 newconf.o
- text data bss dec hex filename
- 42598 4892 208 47698 ba52 parmread.o
- text data bss dec hex filename
- 124 40 0 164 a4 pinorm.o
- text data bss dec hex filename
- 1256 332 0 1588 634 printmat.o
- text data bss dec hex filename
- 1184 16588 0 17772 456c prng.o
- text data bss dec hex filename
- 11748 896 194728 207372 32a0c q_measure.o
- text data bss dec hex filename
- 2190 448 8840 11478 2cd6 randgens.o
- text data bss dec hex filename
- 3104 228 524 3856 f10 ran.o
- text data bss dec hex filename
- 23134 1992 129688 154814 25cbe rattle.o
- text data bss dec hex filename
- 10440 1176 896 12512 30e0 readpdb.o
- text data bss dec hex filename
- 114098 11732 14564 140394 2246a readrtns_CSA.o
- text data bss dec hex filename
- 1816 244 0 2060 80c refsys.o
- text data bss dec hex filename
- 3852 492 3272720 3277064 320108 regularize.o
- text data bss dec hex filename
- 896 140 0 1036 40c rescode.o
- text data bss dec hex filename
- 444 188 0 632 278 rmdd.o
- text data bss dec hex filename
- 4944 776 173320 179040 2bb60 rmsd.o
- text data bss dec hex filename
- 9152 1292 173700 184144 2cf50 sc_move.o
- text data bss dec hex filename
- 5960 1888 0 7848 1ea8 shift.o
- text data bss dec hex filename
- 5894 920 768 7582 1d9e sort.o
- text data bss dec hex filename
- 17784 1960 288280 308024 4b338 stochfric.o
- text data bss dec hex filename
- 10248 928 120 11296 2c20 sumsld.o
- text data bss dec hex filename
- 4894 524 67240 72658 11bd2 surfatom.o
- text data bss dec hex filename
- 55640 6124 8813080 8874844 876b5c test.o
- text data bss dec hex filename
- 16436 1876 1048 19360 4ba0 thread.o
- text data bss dec hex filename
- 1820 404 28 2252 8cc timing.o
- text data bss dec hex filename
- 31980 4560 220320 256860 3eb5c together.o
- text data bss dec hex filename
- 15850 3704 44640 64194 fac2 unres.o
enddo
call flush(iout)
endif
+ write (2,*) "Start reading THETA_PDB"
+ do i=1,ntyp
+ read (ithep_pdb,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2),
+ & (bthet(j,i),j=1,2)
+ read (ithep_pdb,*,err=111,end=111) (polthet(j,i),j=0,3)
+ read (ithep_pdb,*,err=111,end=111) (gthet(j,i),j=1,3)
+ read (ithep_pdb,*,err=111,end=111) theta0(i),sig0(i),sigc0(i)
+ sigc0(i)=sigc0(i)**2
+ enddo
+ write (2,*) "End reading THETA_PDB"
+ close (ithep_pdb)
#endif
close(ithep)
#ifdef CRYST_SC
enddo
endif
enddo
+C
+C Read the parameters of the probability distribution/energy expression
+C of the side chains.
+C
+ do i=1,ntyp
+ read (irotam_pdb,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i)
+ if (i.eq.10) then
+ dsc_inv(i)=0.0D0
+ else
+ dsc_inv(i)=1.0D0/dsc(i)
+ endif
+ if (i.ne.10) then
+ do j=1,nlob(i)
+ do k=1,3
+ do l=1,3
+ blower(l,k,j)=0.0D0
+ enddo
+ enddo
+ enddo
+ bsc(1,i)=0.0D0
+ read(irotam_pdb,*,end=112,err=112)(censc(k,1,i),k=1,3),
+ & ((blower(k,l,1),l=1,k),k=1,3)
+ do j=2,nlob(i)
+ read (irotam_pdb,*,end=112,err=112) bsc(j,i)
+ read (irotam_pdb,*,end=112,err=112) (censc(k,j,i),k=1,3),
+ & ((blower(k,l,j),l=1,k),k=1,3)
+ enddo
+ do j=1,nlob(i)
+ do k=1,3
+ do l=1,k
+ akl=0.0D0
+ do m=1,3
+ akl=akl+blower(k,m,j)*blower(l,m,j)
+ enddo
+ gaussc(k,l,j,i)=akl
+ gaussc(l,k,j,i)=akl
+ enddo
+ enddo
+ enddo
+ endif
+ enddo
+ close (irotam_pdb)
#endif
close(irotam)
+++ /dev/null
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- FUNCTION ran0(idum)
- INTEGER idum,IA,IM,IQ,IR,MASK
- REAL ran0,AM
- PARAMETER (IA=16807,IM=2147483647,AM=1./IM,IQ=127773,IR=2836,
- *MASK=123459876)
- INTEGER k
- idum=ieor(idum,MASK)
- k=idum/IQ
- idum=IA*(idum-k*IQ)-IR*k
- if (idum.lt.0) idum=idum+IM
- ran0=AM*idum
- idum=ieor(idum,MASK)
- return
- END
-C (C) Copr. 1986-92 Numerical Recipes Software *11915
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- FUNCTION ran1(idum)
- INTEGER idum,IA,IM,IQ,IR,NTAB,NDIV
- REAL ran1,AM,EPS,RNMX
- PARAMETER (IA=16807,IM=2147483647,AM=1./IM,IQ=127773,IR=2836,
- *NTAB=32,NDIV=1+(IM-1)/NTAB,EPS=1.2e-7,RNMX=1.-EPS)
- INTEGER j,k,iv(NTAB),iy
- SAVE iv,iy
- DATA iv /NTAB*0/, iy /0/
- if (idum.le.0.or.iy.eq.0) then
- idum=max(-idum,1)
- do 11 j=NTAB+8,1,-1
- k=idum/IQ
- idum=IA*(idum-k*IQ)-IR*k
- if (idum.lt.0) idum=idum+IM
- if (j.le.NTAB) iv(j)=idum
-11 continue
- iy=iv(1)
- endif
- k=idum/IQ
- idum=IA*(idum-k*IQ)-IR*k
- if (idum.lt.0) idum=idum+IM
- j=1+iy/NDIV
- iy=iv(j)
- iv(j)=idum
- ran1=min(AM*iy,RNMX)
- return
- END
-C (C) Copr. 1986-92 Numerical Recipes Software *11915
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- FUNCTION ran2(idum)
- INTEGER idum,IM1,IM2,IMM1,IA1,IA2,IQ1,IQ2,IR1,IR2,NTAB,NDIV
- REAL ran2,AM,EPS,RNMX
- PARAMETER (IM1=2147483563,IM2=2147483399,AM=1./IM1,IMM1=IM1-1,
- *IA1=40014,IA2=40692,IQ1=53668,IQ2=52774,IR1=12211,IR2=3791,
- *NTAB=32,NDIV=1+IMM1/NTAB,EPS=1.2e-7,RNMX=1.-EPS)
- INTEGER idum2,j,k,iv(NTAB),iy
- SAVE iv,iy,idum2
- DATA idum2/123456789/, iv/NTAB*0/, iy/0/
- if (idum.le.0) then
- idum=max(-idum,1)
- idum2=idum
- do 11 j=NTAB+8,1,-1
- k=idum/IQ1
- idum=IA1*(idum-k*IQ1)-k*IR1
- if (idum.lt.0) idum=idum+IM1
- if (j.le.NTAB) iv(j)=idum
-11 continue
- iy=iv(1)
- endif
- k=idum/IQ1
- idum=IA1*(idum-k*IQ1)-k*IR1
- if (idum.lt.0) idum=idum+IM1
- k=idum2/IQ2
- idum2=IA2*(idum2-k*IQ2)-k*IR2
- if (idum2.lt.0) idum2=idum2+IM2
- j=1+iy/NDIV
- iy=iv(j)-idum2
- iv(j)=idum
- if(iy.lt.1)iy=iy+IMM1
- ran2=min(AM*iy,RNMX)
- return
- END
-C (C) Copr. 1986-92 Numerical Recipes Software *11915
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- FUNCTION ran3(idum)
- INTEGER idum
- INTEGER MBIG,MSEED,MZ
-C REAL MBIG,MSEED,MZ
- REAL ran3,FAC
- PARAMETER (MBIG=1000000000,MSEED=161803398,MZ=0,FAC=1./MBIG)
-C PARAMETER (MBIG=4000000.,MSEED=1618033.,MZ=0.,FAC=1./MBIG)
- INTEGER i,iff,ii,inext,inextp,k
- INTEGER mj,mk,ma(55)
-C REAL mj,mk,ma(55)
- SAVE iff,inext,inextp,ma
- DATA iff /0/
- if(idum.lt.0.or.iff.eq.0)then
- iff=1
- mj=MSEED-iabs(idum)
- mj=mod(mj,MBIG)
- ma(55)=mj
- mk=1
- do 11 i=1,54
- ii=mod(21*i,55)
- ma(ii)=mk
- mk=mj-mk
- if(mk.lt.MZ)mk=mk+MBIG
- mj=ma(ii)
-11 continue
- do 13 k=1,4
- do 12 i=1,55
- ma(i)=ma(i)-ma(1+mod(i+30,55))
- if(ma(i).lt.MZ)ma(i)=ma(i)+MBIG
-12 continue
-13 continue
- inext=0
- inextp=31
- idum=1
- endif
- inext=inext+1
- if(inext.eq.56)inext=1
- inextp=inextp+1
- if(inextp.eq.56)inextp=1
- mj=ma(inext)-ma(inextp)
- if(mj.lt.MZ)mj=mj+MBIG
- ma(inext)=mj
- ran3=mj*FAC
- return
- END
-C (C) Copr. 1986-92 Numerical Recipes Software *11915
-ccccccccccccccccccccccccccccccccccccccccccccccccc
+++ /dev/null
- subroutine readrtns
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.SBRIDGE'
- include 'COMMON.IOUNITS'
- logical file_exist
-C Read force-field parameters except weights
- call parmread
-C Read job setup parameters
- call read_control
-C Read control parameters for energy minimzation if required
- if (minim) call read_minim
-C Read MCM control parameters if required
- if (modecalc.eq.3 .or. modecalc.eq.6) call mcmread
-C Read MD control parameters if reqjuired
- if (modecalc.eq.12) call read_MDpar
-C Read MREMD control parameters if required
- if (modecalc.eq.14) then
- call read_MDpar
- call read_REMDpar
- endif
-C Read MUCA control parameters if required
- if (lmuca) call read_muca
-C Read CSA control parameters if required (from fort.40 if exists
-C otherwise from general input file)
- if (modecalc.eq.8) then
- inquire (file="fort.40",exist=file_exist)
- if (.not.file_exist) call csaread
- endif
-cfmc if (modecalc.eq.10) call mcmfread
-C Read molecule information, molecule geometry, energy-term weights, and
-C restraints if requested
- call molread
-C Print restraint information
-#ifdef MPI
- if (.not. out1file .or. me.eq.king) then
-#endif
- if (nhpb.gt.nss)
- &write (iout,'(a,i5,a)') "The following",nhpb-nss,
- & " distance constraints have been imposed"
- do i=nss+1,nhpb
- write (iout,'(3i6,f10.5)') i-nss,ihpb(i),jhpb(i),forcon(i)
- enddo
-#ifdef MPI
- endif
-#endif
-c print *,"Processor",myrank," leaves READRTNS"
- return
- end
-C-------------------------------------------------------------------------------
- subroutine read_control
-C
-C Read contorl data
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MP
- include 'mpif.h'
- logical OKRandom, prng_restart
- real*8 r1
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- include 'COMMON.THREAD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CONTROL'
- include 'COMMON.MCM'
- include 'COMMON.MAP'
- include 'COMMON.HEADER'
- include 'COMMON.CSA'
- include 'COMMON.CHAIN'
- include 'COMMON.MUCA'
- include 'COMMON.MD'
- include 'COMMON.FFIELD'
- include 'COMMON.SETUP'
- COMMON /MACHSW/ KDIAG,ICORFL,IXDR
- character*8 diagmeth(0:3) /'Library','EVVRSP','Givens','Jacobi'/
- character*80 ucase
- character*320 controlcard
-
- nglob_csa=0
- eglob_csa=1d99
- nmin_csa=0
- read (INP,'(a)') titel
- call card_concat(controlcard)
-c out1file=index(controlcard,'OUT1FILE').gt.0 .or. fg_rank.gt.0
-c print *,"Processor",me," fg_rank",fg_rank," out1file",out1file
- call reada(controlcard,'SEED',seed,0.0D0)
- call random_init(seed)
-C Set up the time limit (caution! The time must be input in minutes!)
- read_cart=index(controlcard,'READ_CART').gt.0
- call readi(controlcard,'CONSTR_DIST',constr_dist,0)
- call reada(controlcard,'TIMLIM',timlim,960.0D0) ! default 16 hours
- unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0
- call reada(controlcard,'SAFETY',safety,30.0D0) ! default 30 minutes
- call reada(controlcard,'RMSDBC',rmsdbc,3.0D0)
- call reada(controlcard,'RMSDBC1',rmsdbc1,0.5D0)
- call reada(controlcard,'RMSDBC1MAX',rmsdbc1max,1.5D0)
- call reada(controlcard,'RMSDBCM',rmsdbcm,3.0D0)
- call reada(controlcard,'DRMS',drms,0.1D0)
- if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
- write (iout,'(a,f10.1)')'RMSDBC = ',rmsdbc
- write (iout,'(a,f10.1)')'RMSDBC1 = ',rmsdbc1
- write (iout,'(a,f10.1)')'RMSDBC1MAX = ',rmsdbc1max
- write (iout,'(a,f10.1)')'DRMS = ',drms
- write (iout,'(a,f10.1)')'RMSDBCM = ',rmsdbcm
- write (iout,'(a,f10.1)') 'Time limit (min):',timlim
- endif
- call readi(controlcard,'NZ_START',nz_start,0)
- call readi(controlcard,'NZ_END',nz_end,0)
- call readi(controlcard,'IZ_SC',iz_sc,0)
- timlim=60.0D0*timlim
- safety = 60.0d0*safety
- timem=timlim
- modecalc=0
- call reada(controlcard,"T_BATH",t_bath,300.0d0)
- minim=(index(controlcard,'MINIMIZE').gt.0)
- dccart=(index(controlcard,'CART').gt.0)
- overlapsc=(index(controlcard,'OVERLAP').gt.0)
- overlapsc=.not.overlapsc
- searchsc=(index(controlcard,'NOSEARCHSC').gt.0)
- searchsc=.not.searchsc
- sideadd=(index(controlcard,'SIDEADD').gt.0)
- energy_dec=(index(controlcard,'ENERGY_DEC').gt.0)
- outpdb=(index(controlcard,'PDBOUT').gt.0)
- outmol2=(index(controlcard,'MOL2OUT').gt.0)
- pdbref=(index(controlcard,'PDBREF').gt.0)
- refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0)
- indpdb=index(controlcard,'PDBSTART')
- extconf=(index(controlcard,'EXTCONF').gt.0)
- call readi(controlcard,'IPRINT',iprint,0)
- call readi(controlcard,'MAXGEN',maxgen,10000)
- call readi(controlcard,'MAXOVERLAP',maxoverlap,1000)
- call readi(controlcard,"KDIAG",kdiag,0)
- call readi(controlcard,"RESCALE_MODE",rescale_mode,1)
- if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0)
- & write (iout,*) "RESCALE_MODE",rescale_mode
- split_ene=index(controlcard,'SPLIT_ENE').gt.0
- if (index(controlcard,'REGULAR').gt.0.0D0) then
- call reada(controlcard,'WEIDIS',weidis,0.1D0)
- modecalc=1
- refstr=.true.
- endif
- if (index(controlcard,'CHECKGRAD').gt.0) then
- modecalc=5
- if (index(controlcard,'CART').gt.0) then
- icheckgrad=1
- elseif (index(controlcard,'CARINT').gt.0) then
- icheckgrad=2
- else
- icheckgrad=3
- endif
- elseif (index(controlcard,'THREAD').gt.0) then
- modecalc=2
- call readi(controlcard,'THREAD',nthread,0)
- if (nthread.gt.0) then
- call reada(controlcard,'WEIDIS',weidis,0.1D0)
- else
- if (fg_rank.eq.0)
- & write (iout,'(a)')'A number has to follow the THREAD keyword.'
- stop 'Error termination in Read_Control.'
- endif
- else if (index(controlcard,'MCMA').gt.0) then
- modecalc=3
- else if (index(controlcard,'MCEE').gt.0) then
- modecalc=6
- else if (index(controlcard,'MULTCONF').gt.0) then
- modecalc=4
- else if (index(controlcard,'MAP').gt.0) then
- modecalc=7
- call readi(controlcard,'MAP',nmap,0)
- else if (index(controlcard,'CSA').gt.0) then
- modecalc=8
-crc else if (index(controlcard,'ZSCORE').gt.0) then
-crc
-crc ZSCORE is rm from UNRES, modecalc=9 is available
-crc
-crc modecalc=9
-cfcm else if (index(controlcard,'MCMF').gt.0) then
-cfmc modecalc=10
- else if (index(controlcard,'SOFTREG').gt.0) then
- modecalc=11
- else if (index(controlcard,'CHECK_BOND').gt.0) then
- modecalc=-1
- else if (index(controlcard,'TEST').gt.0) then
- modecalc=-2
- else if (index(controlcard,'MD').gt.0) then
- modecalc=12
- else if (index(controlcard,'RE ').gt.0) then
- modecalc=14
- endif
-
- lmuca=index(controlcard,'MUCA').gt.0
- call readi(controlcard,'MUCADYN',mucadyn,0)
- call readi(controlcard,'MUCASMOOTH',muca_smooth,0)
- if (lmuca .and. (me.eq.king .or. .not.out1file ))
- & then
- write (iout,*) 'MUCADYN=',mucadyn
- write (iout,*) 'MUCASMOOTH=',muca_smooth
- endif
-
- iscode=index(controlcard,'ONE_LETTER')
- indphi=index(controlcard,'PHI')
- indback=index(controlcard,'BACK')
- iranconf=index(controlcard,'RAND_CONF')
- i2ndstr=index(controlcard,'USE_SEC_PRED')
- gradout=index(controlcard,'GRADOUT').gt.0
- gnorm_check=index(controlcard,'GNORM_CHECK').gt.0
-
- if(me.eq.king.or..not.out1file)
- & write (iout,'(2a)') diagmeth(kdiag),
- & ' routine used to diagonalize matrices.'
- return
- end
-c--------------------------------------------------------------------------
- subroutine read_REMDpar
-C
-C Read REMD settings
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.GEO'
- include 'COMMON.REMD'
- include 'COMMON.CONTROL'
- include 'COMMON.SETUP'
- character*80 ucase
- character*320 controlcard
- character*3200 controlcard1
- integer iremd_m_total
-
- if(me.eq.king.or..not.out1file)
- & write (iout,*) "REMD setup"
-
- call card_concat(controlcard)
- call readi(controlcard,"NREP",nrep,3)
- call readi(controlcard,"NSTEX",nstex,1000)
- call reada(controlcard,"RETMIN",retmin,10.0d0)
- call reada(controlcard,"RETMAX",retmax,1000.0d0)
- mremdsync=(index(controlcard,'SYNC').gt.0)
- call readi(controlcard,"NSYN",i_sync_step,100)
- restart1file=(index(controlcard,'REST1FILE').gt.0)
- traj1file=(index(controlcard,'TRAJ1FILE').gt.0)
- call readi(controlcard,"TRAJCACHE",max_cache_traj_use,1)
- if(max_cache_traj_use.gt.max_cache_traj)
- & max_cache_traj_use=max_cache_traj
- if(me.eq.king.or..not.out1file) then
-cd if (traj1file) then
-crc caching is in testing - NTWX is not ignored
-cd write (iout,*) "NTWX value is ignored"
-cd write (iout,*) " trajectory is stored to one file by master"
-cd write (iout,*) " before exchange at NSTEX intervals"
-cd endif
- write (iout,*) "NREP= ",nrep
- write (iout,*) "NSTEX= ",nstex
- write (iout,*) "SYNC= ",mremdsync
- write (iout,*) "NSYN= ",i_sync_step
- write (iout,*) "TRAJCACHE= ",max_cache_traj_use
- endif
-
- t_exchange_only=(index(controlcard,'TONLY').gt.0)
- call readi(controlcard,"HREMD",hremd,0)
- if((me.eq.king.or..not.out1file).and.hremd.gt.0) then
- write (iout,*) "Hamiltonian REMD with ",hremd," sets of weights"
- endif
- if(usampl.and.hremd.gt.0) then
- write (iout,'(//a)')
- & "========== ERROR: USAMPL and HREMD cannot be used together"
-#ifdef MPI
- call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE)
-#endif
- stop
- endif
-
-
- remd_tlist=.false.
- if (index(controlcard,'TLIST').gt.0) then
- remd_tlist=.true.
- call card_concat(controlcard1)
- read(controlcard1,*) (remd_t(i),i=1,nrep)
- if(me.eq.king.or..not.out1file)
- & write (iout,*)'tlist',(remd_t(i),i=1,nrep)
- endif
- remd_mlist=.false.
- if (index(controlcard,'MLIST').gt.0) then
- remd_mlist=.true.
- call card_concat(controlcard1)
- read(controlcard1,*) (remd_m(i),i=1,nrep)
- if(me.eq.king.or..not.out1file) then
- write (iout,*)'mlist',(remd_m(i),i=1,nrep)
- iremd_m_total=0
- do i=1,nrep
- iremd_m_total=iremd_m_total+remd_m(i)
- enddo
- if(hremd.gt.1)then
- write (iout,*) 'Total number of replicas ',
- & iremd_m_total*hremd
- else
- write (iout,*) 'Total number of replicas ',iremd_m_total
- endif
- endif
- endif
- if(me.eq.king.or..not.out1file)
- & write (iout,'(/30(1h=),a,29(1h=)/)') " End of REMD run setup "
- return
- end
-c--------------------------------------------------------------------------
- subroutine read_MDpar
-C
-C Read MD settings
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.GEO'
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.SPLITELE'
- character*80 ucase
- character*320 controlcard
-
- call card_concat(controlcard)
- call readi(controlcard,"NSTEP",n_timestep,1000000)
- call readi(controlcard,"NTWE",ntwe,100)
- call readi(controlcard,"NTWX",ntwx,1000)
- call reada(controlcard,"DT",d_time,1.0d-1)
- call reada(controlcard,"DVMAX",dvmax,2.0d1)
- call reada(controlcard,"DAMAX",damax,1.0d1)
- call reada(controlcard,"EDRIFTMAX",edriftmax,1.0d+1)
- call readi(controlcard,"LANG",lang,0)
- RESPA = index(controlcard,"RESPA") .gt. 0
- call readi(controlcard,"NTIME_SPLIT",ntime_split,1)
- ntime_split0=ntime_split
- call readi(controlcard,"MAXTIME_SPLIT",maxtime_split,64)
- ntime_split0=ntime_split
- call reada(controlcard,"R_CUT",r_cut,2.0d0)
- call reada(controlcard,"LAMBDA",rlamb,0.3d0)
- rest = index(controlcard,"REST").gt.0
- tbf = index(controlcard,"TBF").gt.0
- tnp = index(controlcard,"NOSEPOINCARE99").gt.0
- tnp1 = index(controlcard,"NOSEPOINCARE01").gt.0
- tnh = index(controlcard,"NOSEHOOVER96").gt.0
- if (RESPA.and.tnh)then
- xiresp = index(controlcard,"XIRESP").gt.0
- endif
- call reada(controlcard,"Q_NP",Q_np,0.1d0)
- usampl = index(controlcard,"USAMPL").gt.0
-
- mdpdb = index(controlcard,"MDPDB").gt.0
- call reada(controlcard,"T_BATH",t_bath,300.0d0)
- call reada(controlcard,"TAU_BATH",tau_bath,1.0d-1)
- call reada(controlcard,"EQ_TIME",eq_time,1.0d+4)
- call readi(controlcard,"RESET_MOMENT",count_reset_moment,1000)
- if (count_reset_moment.eq.0) count_reset_moment=1000000000
- call readi(controlcard,"RESET_VEL",count_reset_vel,1000)
- reset_moment=lang.eq.0 .and. tbf .and. count_reset_moment.gt.0
- reset_vel=lang.eq.0 .and. tbf .and. count_reset_vel.gt.0
- if (count_reset_vel.eq.0) count_reset_vel=1000000000
- large = index(controlcard,"LARGE").gt.0
- print_compon = index(controlcard,"PRINT_COMPON").gt.0
- rattle = index(controlcard,"RATTLE").gt.0
-c if performing umbrella sampling, fragments constrained are read from the fragment file
- nset=0
- if(usampl) then
- call read_fragments
- endif
-
- if(me.eq.king.or..not.out1file) then
- write (iout,*)
- write (iout,'(27(1h=),a26,27(1h=))') " Parameters of the MD run "
- write (iout,*)
- write (iout,'(a)') "The units are:"
- write (iout,'(a)') "positions: angstrom, time: 48.9 fs"
- write (iout,'(2a)') "velocity: angstrom/(48.9 fs),",
- & " acceleration: angstrom/(48.9 fs)**2"
- write (iout,'(a)') "energy: kcal/mol, temperature: K"
- write (iout,*)
- write (iout,'(a60,i10)') "Number of time steps:",n_timestep
- write (iout,'(a60,f10.5,a)')
- & "Initial time step of numerical integration:",d_time,
- & " natural units"
- write (iout,'(60x,f10.5,a)') d_time*48.9," fs"
- if (RESPA) then
- write (iout,'(2a,i4,a)')
- & "A-MTS algorithm used; initial time step for fast-varying",
- & " short-range forces split into",ntime_split," steps."
- write (iout,'(a,f5.2,a,f5.2)') "Short-range force cutoff",
- & r_cut," lambda",rlamb
- endif
- write (iout,'(2a,f10.5)')
- & "Maximum acceleration threshold to reduce the time step",
- & "/increase split number:",damax
- write (iout,'(2a,f10.5)')
- & "Maximum predicted energy drift to reduce the timestep",
- & "/increase split number:",edriftmax
- write (iout,'(a60,f10.5)')
- & "Maximum velocity threshold to reduce velocities:",dvmax
- write (iout,'(a60,i10)') "Frequency of property output:",ntwe
- write (iout,'(a60,i10)') "Frequency of coordinate output:",ntwx
- if (rattle) write (iout,'(a60)')
- & "Rattle algorithm used to constrain the virtual bonds"
- endif
- reset_fricmat=1000
- if (lang.gt.0) then
- call reada(controlcard,"ETAWAT",etawat,0.8904d0)
- call reada(controlcard,"RWAT",rwat,1.4d0)
- call reada(controlcard,"SCAL_FRIC",scal_fric,2.0d-2)
- surfarea=index(controlcard,"SURFAREA").gt.0
- call readi(controlcard,"RESET_FRICMAT",reset_fricmat,1000)
- if(me.eq.king.or..not.out1file)then
- write (iout,'(/a,$)') "Langevin dynamics calculation"
- if (lang.eq.1) then
- write (iout,'(a/)')
- & " with direct integration of Langevin equations"
- else if (lang.eq.2) then
- write (iout,'(a/)') " with TINKER stochasic MD integrator"
- else if (lang.eq.3) then
- write (iout,'(a/)') " with Ciccotti's stochasic MD integrator"
- else if (lang.eq.4) then
- write (iout,'(a/)') " in overdamped mode"
- else
- write (iout,'(//a,i5)')
- & "=========== ERROR: Unknown Langevin dynamics mode:",lang
- stop
- endif
- write (iout,'(a60,f10.5)') "Temperature:",t_bath
- write (iout,'(a60,f10.5)') "Viscosity of the solvent:",etawat
- write (iout,'(a60,f10.5)') "Radius of solvent molecule:",rwat
- write (iout,'(a60,f10.5)')
- & "Scaling factor of the friction forces:",scal_fric
- if (surfarea) write (iout,'(2a,i10,a)')
- & "Friction coefficients will be scaled by solvent-accessible",
- & " surface area every",reset_fricmat," steps."
- endif
-c Calculate friction coefficients and bounds of stochastic forces
- eta=6*pi*cPoise*etawat
- if(me.eq.king.or..not.out1file)
- & write(iout,'(a60,f10.5)')"Eta of the solvent in natural units:"
- & ,eta
- gamp=scal_fric*(pstok+rwat)*eta
- stdfp=dsqrt(2*Rb*t_bath/d_time)
- do i=1,ntyp
- gamsc(i)=scal_fric*(restok(i)+rwat)*eta
- stdfsc(i)=dsqrt(2*Rb*t_bath/d_time)
- enddo
- if(me.eq.king.or..not.out1file)then
- write (iout,'(/2a/)')
- & "Radii of site types and friction coefficients and std's of",
- & " stochastic forces of fully exposed sites"
- write (iout,'(a5,f5.2,2f10.5)')'p',pstok,gamp,stdfp*dsqrt(gamp)
- do i=1,ntyp
- write (iout,'(a5,f5.2,2f10.5)') restyp(i),restok(i),
- & gamsc(i),stdfsc(i)*dsqrt(gamsc(i))
- enddo
- endif
- else if (tbf) then
- if(me.eq.king.or..not.out1file)then
- write (iout,'(a)') "Berendsen bath calculation"
- write (iout,'(a60,f10.5)') "Temperature:",t_bath
- write (iout,'(a60,f10.5)') "Coupling constant (tau):",tau_bath
- if (reset_moment)
- & write (iout,'(a,i10,a)') "Momenta will be reset at zero every",
- & count_reset_moment," steps"
- if (reset_vel)
- & write (iout,'(a,i10,a)')
- & "Velocities will be reset at random every",count_reset_vel,
- & " steps"
- endif
- else if (tnp .or. tnp1 .or. tnh) then
- if (tnp .or. tnp1) then
- write (iout,'(a)') "Nose-Poincare bath calculation"
- if (tnp) write (iout,'(a)')
- & "J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird"
- if (tnp1) write (iout,'(a)') "JPSJ 70 75 (2001) S. Nose"
- else
- write (iout,'(a)') "Nose-Hoover bath calculation"
- write (iout,'(a)') "Mol.Phys. 87 1117 (1996) Martyna et al."
- nresn=1
- nyosh=1
- nnos=1
- do i=1,nnos
- qmass(i)=Q_np
- xlogs(i)=1.0
- vlogs(i)=0.0
- enddo
- do i=1,nyosh
- WDTI(i) = 1.0*d_time/nresn
- WDTI2(i)=WDTI(i)/2
- WDTI4(i)=WDTI(i)/4
- WDTI8(i)=WDTI(i)/8
- enddo
- if (RESPA) then
- if(xiresp) then
- write (iout,'(a)') "NVT-XI-RESPA algorithm"
- else
- write (iout,'(a)') "NVT-XO-RESPA algorithm"
- endif
- do i=1,nyosh
- WDTIi(i) = 1.0*d_time/nresn/ntime_split
- WDTIi2(i)=WDTIi(i)/2
- WDTIi4(i)=WDTIi(i)/4
- WDTIi8(i)=WDTIi(i)/8
- enddo
- endif
- endif
-
- write (iout,'(a60,f10.5)') "Temperature:",t_bath
- write (iout,'(a60,f10.5)') "Q =",Q_np
- if (reset_moment)
- & write (iout,'(a,i10,a)') "Momenta will be reset at zero every",
- & count_reset_moment," steps"
- if (reset_vel)
- & write (iout,'(a,i10,a)')
- & "Velocities will be reset at random every",count_reset_vel,
- & " steps"
-
- else
- if(me.eq.king.or..not.out1file)
- & write (iout,'(a31)') "Microcanonical mode calculation"
- endif
- if(me.eq.king.or..not.out1file)then
- if (rest) write (iout,'(/a/)') "===== Calculation restarted ===="
- if (usampl) then
- write(iout,*) "MD running with constraints."
- write(iout,*) "Equilibration time ", eq_time, " mtus."
- write(iout,*) "Constraining ", nfrag," fragments."
- write(iout,*) "Length of each fragment, weight and q0:"
- do iset=1,nset
- write (iout,*) "Set of restraints #",iset
- do i=1,nfrag
- write(iout,'(2i5,f8.1,f7.4)') ifrag(1,i,iset),
- & ifrag(2,i,iset),wfrag(i,iset),qinfrag(i,iset)
- enddo
- write(iout,*) "constraints between ", npair, "fragments."
- write(iout,*) "constraint pairs, weights and q0:"
- do i=1,npair
- write(iout,'(2i5,f8.1,f7.4)') ipair(1,i,iset),
- & ipair(2,i,iset),wpair(i,iset),qinpair(i,iset)
- enddo
- write(iout,*) "angle constraints within ", nfrag_back,
- & "backbone fragments."
- write(iout,*) "fragment, weights:"
- do i=1,nfrag_back
- write(iout,'(2i5,3f8.1)') ifrag_back(1,i,iset),
- & ifrag_back(2,i,iset),wfrag_back(1,i,iset),
- & wfrag_back(2,i,iset),wfrag_back(3,i,iset)
- enddo
- enddo
- iset=mod(kolor,nset)+1
- endif
- endif
- if(me.eq.king.or..not.out1file)
- & write (iout,'(/30(1h=),a,29(1h=)/)') " End of MD run setup "
- return
- end
-c------------------------------------------------------------------------------
- subroutine molread
-C
-C Read molecular data.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- integer error_msg
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.NAMES'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.DBASE'
- include 'COMMON.THREAD'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORCNSTR'
- include 'COMMON.TIME1'
- include 'COMMON.BOUNDS'
- include 'COMMON.MD'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- character*4 sequence(maxres)
- integer rescode
- double precision x(maxvar)
- character*256 pdbfile
- character*320 weightcard
- character*80 weightcard_t,ucase
- dimension itype_pdb(maxres)
- common /pizda/ itype_pdb
- logical seq_comp,fail
- double precision energia(0:n_ene)
- integer ilen
- external ilen
-C
-C Body
-C
-C Read weights of the subsequent energy terms.
- if(hremd.gt.0) then
-
- k=0
- do il=1,hremd
- do i=1,nrep
- do j=1,remd_m(i)
- i2set(k)=il
- k=k+1
- enddo
- enddo
- enddo
-
- if(me.eq.king.or..not.out1file) then
- write (iout,*) 'Reading ',hremd,' sets of weights for HREMD'
- write (iout,*) 'Current weights for processor ',
- & me,' set ',i2set(me)
- endif
-
- do i=1,hremd
- call card_concat(weightcard)
- call reada(weightcard,'WLONG',wlong,1.0D0)
- call reada(weightcard,'WSC',wsc,wlong)
- call reada(weightcard,'WSCP',wscp,wlong)
- call reada(weightcard,'WELEC',welec,1.0D0)
- call reada(weightcard,'WVDWPP',wvdwpp,welec)
- call reada(weightcard,'WEL_LOC',wel_loc,1.0D0)
- call reada(weightcard,'WCORR4',wcorr4,0.0D0)
- call reada(weightcard,'WCORR5',wcorr5,0.0D0)
- call reada(weightcard,'WCORR6',wcorr6,0.0D0)
- call reada(weightcard,'WTURN3',wturn3,1.0D0)
- call reada(weightcard,'WTURN4',wturn4,1.0D0)
- call reada(weightcard,'WTURN6',wturn6,1.0D0)
- call reada(weightcard,'WSCCOR',wsccor,1.0D0)
- call reada(weightcard,'WSTRAIN',wstrain,1.0D0)
- call reada(weightcard,'WBOND',wbond,1.0D0)
- call reada(weightcard,'WTOR',wtor,1.0D0)
- call reada(weightcard,'WTORD',wtor_d,1.0D0)
- call reada(weightcard,'WANG',wang,1.0D0)
- call reada(weightcard,'WSCLOC',wscloc,1.0D0)
- call reada(weightcard,'SCAL14',scal14,0.4D0)
- call reada(weightcard,'SCALSCP',scalscp,1.0d0)
- call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0)
- call reada(weightcard,'DELT_CORR',delt_corr,0.5d0)
- call reada(weightcard,'TEMP0',temp0,300.0d0)
- if (index(weightcard,'SOFT').gt.0) ipot=6
-C 12/1/95 Added weight for the multi-body term WCORR
- call reada(weightcard,'WCORRH',wcorr,1.0D0)
- if (wcorr4.gt.0.0d0) wcorr=wcorr4
-
- hweights(i,1)=wsc
- hweights(i,2)=wscp
- hweights(i,3)=welec
- hweights(i,4)=wcorr
- hweights(i,5)=wcorr5
- hweights(i,6)=wcorr6
- hweights(i,7)=wel_loc
- hweights(i,8)=wturn3
- hweights(i,9)=wturn4
- hweights(i,10)=wturn6
- hweights(i,11)=wang
- hweights(i,12)=wscloc
- hweights(i,13)=wtor
- hweights(i,14)=wtor_d
- hweights(i,15)=wstrain
- hweights(i,16)=wvdwpp
- hweights(i,17)=wbond
- hweights(i,18)=scal14
- hweights(i,21)=wsccor
-
- enddo
-
- do i=1,n_ene
- weights(i)=hweights(i2set(me),i)
- enddo
- 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)
-
-
- else
- call card_concat(weightcard)
- call reada(weightcard,'WLONG',wlong,1.0D0)
- call reada(weightcard,'WSC',wsc,wlong)
- call reada(weightcard,'WSCP',wscp,wlong)
- call reada(weightcard,'WELEC',welec,1.0D0)
- call reada(weightcard,'WVDWPP',wvdwpp,welec)
- call reada(weightcard,'WEL_LOC',wel_loc,1.0D0)
- call reada(weightcard,'WCORR4',wcorr4,0.0D0)
- call reada(weightcard,'WCORR5',wcorr5,0.0D0)
- call reada(weightcard,'WCORR6',wcorr6,0.0D0)
- call reada(weightcard,'WTURN3',wturn3,1.0D0)
- call reada(weightcard,'WTURN4',wturn4,1.0D0)
- call reada(weightcard,'WTURN6',wturn6,1.0D0)
- call reada(weightcard,'WSCCOR',wsccor,1.0D0)
- call reada(weightcard,'WSTRAIN',wstrain,1.0D0)
- call reada(weightcard,'WBOND',wbond,1.0D0)
- call reada(weightcard,'WTOR',wtor,1.0D0)
- call reada(weightcard,'WTORD',wtor_d,1.0D0)
- call reada(weightcard,'WANG',wang,1.0D0)
- call reada(weightcard,'WSCLOC',wscloc,1.0D0)
- call reada(weightcard,'SCAL14',scal14,0.4D0)
- call reada(weightcard,'SCALSCP',scalscp,1.0d0)
- call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0)
- call reada(weightcard,'DELT_CORR',delt_corr,0.5d0)
- call reada(weightcard,'TEMP0',temp0,300.0d0)
- if (index(weightcard,'SOFT').gt.0) ipot=6
-C 12/1/95 Added weight for the multi-body term WCORR
- call reada(weightcard,'WCORRH',wcorr,1.0D0)
- if (wcorr4.gt.0.0d0) wcorr=wcorr4
- 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
- endif
-
- if(me.eq.king.or..not.out1file)
- & write (iout,10) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor,
- & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3,
- & wturn4,wturn6
- 10 format (/'Energy-term weights (unscaled):'//
- & 'WSCC= ',f10.6,' (SC-SC)'/
- & 'WSCP= ',f10.6,' (SC-p)'/
- & 'WELEC= ',f10.6,' (p-p electr)'/
- & 'WVDWPP= ',f10.6,' (p-p VDW)'/
- & 'WBOND= ',f10.6,' (stretching)'/
- & 'WANG= ',f10.6,' (bending)'/
- & 'WSCLOC= ',f10.6,' (SC local)'/
- & 'WTOR= ',f10.6,' (torsional)'/
- & 'WTORD= ',f10.6,' (double torsional)'/
- & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/
- & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/
- & 'WCORR4= ',f10.6,' (multi-body 4th order)'/
- & 'WCORR5= ',f10.6,' (multi-body 5th order)'/
- & 'WCORR6= ',f10.6,' (multi-body 6th order)'/
- & 'WSCCOR= ',f10.6,' (back-scloc correlation)'/
- & 'WTURN3= ',f10.6,' (turns, 3rd order)'/
- & 'WTURN4= ',f10.6,' (turns, 4th order)'/
- & 'WTURN6= ',f10.6,' (turns, 6th order)')
- if(me.eq.king.or..not.out1file)then
- if (wcorr4.gt.0.0d0) then
- write (iout,'(/2a/)') 'Local-electrostatic type correlation ',
- & 'between contact pairs of peptide groups'
- write (iout,'(2(a,f5.3/))')
- & 'Cutoff on 4-6th order correlation terms: ',cutoff_corr,
- & 'Range of quenching the correlation terms:',2*delt_corr
- else if (wcorr.gt.0.0d0) then
- write (iout,'(/2a/)') 'Hydrogen-bonding correlation ',
- & 'between contact pairs of peptide groups'
- endif
- write (iout,'(a,f8.3)')
- & 'Scaling factor of 1,4 SC-p interactions:',scal14
- write (iout,'(a,f8.3)')
- & 'General scaling factor of SC-p interactions:',scalscp
- endif
- r0_corr=cutoff_corr-delt_corr
- do i=1,20
- aad(i,1)=scalscp*aad(i,1)
- aad(i,2)=scalscp*aad(i,2)
- bad(i,1)=scalscp*bad(i,1)
- bad(i,2)=scalscp*bad(i,2)
- enddo
- call rescale_weights(t_bath)
- if(me.eq.king.or..not.out1file)
- & write (iout,22) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor,
- & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3,
- & wturn4,wturn6
- 22 format (/'Energy-term weights (scaled):'//
- & 'WSCC= ',f10.6,' (SC-SC)'/
- & 'WSCP= ',f10.6,' (SC-p)'/
- & 'WELEC= ',f10.6,' (p-p electr)'/
- & 'WVDWPP= ',f10.6,' (p-p VDW)'/
- & 'WBOND= ',f10.6,' (stretching)'/
- & 'WANG= ',f10.6,' (bending)'/
- & 'WSCLOC= ',f10.6,' (SC local)'/
- & 'WTOR= ',f10.6,' (torsional)'/
- & 'WTORD= ',f10.6,' (double torsional)'/
- & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/
- & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/
- & 'WCORR4= ',f10.6,' (multi-body 4th order)'/
- & 'WCORR5= ',f10.6,' (multi-body 5th order)'/
- & 'WCORR6= ',f10.6,' (multi-body 6th order)'/
- & 'WSCCOR= ',f10.6,' (back-scloc correlatkion)'/
- & 'WTURN3= ',f10.6,' (turns, 3rd order)'/
- & 'WTURN4= ',f10.6,' (turns, 4th order)'/
- & 'WTURN6= ',f10.6,' (turns, 6th order)')
- if(me.eq.king.or..not.out1file)
- & write (iout,*) "Reference temperature for weights calculation:",
- & temp0
- call reada(weightcard,"D0CM",d0cm,3.78d0)
- call reada(weightcard,"AKCM",akcm,15.1d0)
- call reada(weightcard,"AKTH",akth,11.0d0)
- call reada(weightcard,"AKCT",akct,12.0d0)
- call reada(weightcard,"V1SS",v1ss,-1.08d0)
- call reada(weightcard,"V2SS",v2ss,7.61d0)
- call reada(weightcard,"V3SS",v3ss,13.7d0)
- call reada(weightcard,"EBR",ebr,-5.50D0)
- if(me.eq.king.or..not.out1file) then
- write (iout,*) "Parameters of the SS-bond potential:"
- write (iout,*) "D0CM",d0cm," AKCM",akcm," AKTH",akth,
- & " AKCT",akct
- write (iout,*) "V1SS",v1ss," V2SS",v2ss," V3SS",v3ss
- write (iout,*) "EBR",ebr
- print *,'indpdb=',indpdb,' pdbref=',pdbref
- endif
- if (indpdb.gt.0 .or. pdbref) then
- read(inp,'(a)') pdbfile
- if(me.eq.king.or..not.out1file)
- & write (iout,'(2a)') 'PDB data will be read from file ',
- & pdbfile(:ilen(pdbfile))
- open(ipdbin,file=pdbfile,status='old',err=33)
- goto 34
- 33 write (iout,'(a)') 'Error opening PDB file.'
- stop
- 34 continue
-c print *,'Begin reading pdb data'
- call readpdb
-c print *,'Finished reading pdb data'
- if(me.eq.king.or..not.out1file)
- & write (iout,'(a,i3,a,i3)')'nsup=',nsup,
- & ' nstart_sup=',nstart_sup
- do i=1,nres
- itype_pdb(i)=itype(i)
- enddo
- close (ipdbin)
- nnt=nstart_sup
- nct=nstart_sup+nsup-1
- call contact(.false.,ncont_ref,icont_ref,co)
-
- if (sideadd) then
- if(me.eq.king.or..not.out1file)
- & write(iout,*)'Adding sidechains'
- maxsi=1000
- do i=2,nres-1
- iti=itype(i)
- if (iti.ne.10) then
- nsi=0
- fail=.true.
- do while (fail.and.nsi.le.maxsi)
- call gen_side(iti,theta(i+1),alph(i),omeg(i),fail)
- nsi=nsi+1
- enddo
- if(fail) write(iout,*)'Adding sidechain failed for res ',
- & i,' after ',nsi,' trials'
- endif
- enddo
- endif
- endif
- if (indpdb.eq.0) then
-C Read sequence if not taken from the pdb file.
- read (inp,*) nres
-c print *,'nres=',nres
- if (iscode.gt.0) then
- read (inp,'(80a1)') (sequence(i)(1:1),i=1,nres)
- else
- read (inp,'(20(1x,a3))') (sequence(i),i=1,nres)
- endif
-C Convert sequence to numeric code
- do i=1,nres
- itype(i)=rescode(i,sequence(i),iscode)
- enddo
-C Assign initial virtual bond lengths
- do i=2,nres
- vbld(i)=vbl
- vbld_inv(i)=vblinv
- enddo
- do i=2,nres-1
- vbld(i+nres)=dsc(itype(i))
- vbld_inv(i+nres)=dsc_inv(itype(i))
-c write (iout,*) "i",i," itype",itype(i),
-c & " dsc",dsc(itype(i))," vbld",vbld(i),vbld(i+nres)
- enddo
- endif
-c print *,nres
-c print '(20i4)',(itype(i),i=1,nres)
- do i=1,nres
-#ifdef PROCOR
- if (itype(i).eq.21 .or. itype(i+1).eq.21) then
-#else
- if (itype(i).eq.21) then
-#endif
- itel(i)=0
-#ifdef PROCOR
- else if (itype(i+1).ne.20) then
-#else
- else if (itype(i).ne.20) then
-#endif
- itel(i)=1
- else
- itel(i)=2
- endif
- enddo
- if(me.eq.king.or..not.out1file)then
- write (iout,*) "ITEL"
- do i=1,nres-1
- write (iout,*) i,itype(i),itel(i)
- enddo
- print *,'Call Read_Bridge.'
- endif
- call read_bridge
-C 8/13/98 Set limits to generating the dihedral angles
- do i=1,nres
- phibound(1,i)=-pi
- phibound(2,i)=pi
- enddo
- read (inp,*) ndih_constr
- if (ndih_constr.gt.0) then
- read (inp,*) ftors
- read (inp,*) (idih_constr(i),phi0(i),drange(i),i=1,ndih_constr)
- if(me.eq.king.or..not.out1file)then
- write (iout,*)
- & 'There are',ndih_constr,' constraints on phi angles.'
- do i=1,ndih_constr
- write (iout,'(i5,2f8.3)') idih_constr(i),phi0(i),drange(i)
- enddo
- endif
- do i=1,ndih_constr
- phi0(i)=deg2rad*phi0(i)
- drange(i)=deg2rad*drange(i)
- enddo
- if(me.eq.king.or..not.out1file)
- & write (iout,*) 'FTORS',ftors
- do i=1,ndih_constr
- ii = idih_constr(i)
- phibound(1,ii) = phi0(i)-drange(i)
- phibound(2,ii) = phi0(i)+drange(i)
- enddo
- endif
- nnt=1
-#ifdef MPI
- if (me.eq.king) then
-#endif
- write (iout,'(a)') 'Boundaries in phi angle sampling:'
- do i=1,nres
- write (iout,'(a3,i5,2f10.1)')
- & restyp(itype(i)),i,phibound(1,i)*rad2deg,phibound(2,i)*rad2deg
- enddo
-#ifdef MP
- endif
-#endif
- nct=nres
-cd print *,'NNT=',NNT,' NCT=',NCT
- if (itype(1).eq.21) nnt=2
- if (itype(nres).eq.21) nct=nct-1
- if (pdbref) then
- if(me.eq.king.or..not.out1file)
- & write (iout,'(a,i3)') 'nsup=',nsup
- nstart_seq=nnt
- if (nsup.le.(nct-nnt+1)) then
- do i=0,nct-nnt+1-nsup
- if (seq_comp(itype(nnt+i),itype_pdb(nstart_sup),nsup)) then
- nstart_seq=nnt+i
- goto 111
- endif
- enddo
- write (iout,'(a)')
- & 'Error - sequences to be superposed do not match.'
- stop
- else
- do i=0,nsup-(nct-nnt+1)
- if (seq_comp(itype(nnt),itype_pdb(nstart_sup+i),nct-nnt+1))
- & then
- nstart_sup=nstart_sup+i
- nsup=nct-nnt+1
- goto 111
- endif
- enddo
- write (iout,'(a)')
- & 'Error - sequences to be superposed do not match.'
- endif
- 111 continue
- if (nsup.eq.0) nsup=nct-nnt
- if (nstart_sup.eq.0) nstart_sup=nnt
- if (nstart_seq.eq.0) nstart_seq=nnt
- if(me.eq.king.or..not.out1file)
- & write (iout,*) 'nsup=',nsup,' nstart_sup=',nstart_sup,
- & ' nstart_seq=',nstart_seq
- endif
-c--- Zscore rms -------
- if (nz_start.eq.0) nz_start=nnt
- if (nz_end.eq.0 .and. nsup.gt.0) then
- nz_end=nnt+nsup-1
- else if (nz_end.eq.0) then
- nz_end=nct
- endif
- if(me.eq.king.or..not.out1file)then
- write (iout,*) 'NZ_START=',nz_start,' NZ_END=',nz_end
- write (iout,*) 'IZ_SC=',iz_sc
- endif
-c----------------------
- call init_int_table
- if (refstr) then
- if (.not.pdbref) then
- call read_angles(inp,*38)
- goto 39
- 38 write (iout,'(a)') 'Error reading reference structure.'
-#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,IERROR)
- stop 'Error reading reference structure'
-#endif
- 39 call chainbuild
- call setup_var
-czscore call geom_to_var(nvar,coord_exp_zs(1,1))
- nstart_sup=nnt
- nstart_seq=nnt
- nsup=nct-nnt+1
- do i=1,2*nres
- do j=1,3
- cref(j,i)=c(j,i)
- enddo
- enddo
- call contact(.true.,ncont_ref,icont_ref,co)
- endif
-c write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup
- call flush(iout)
- if (constr_dist.gt.0) call read_dist_constr
-c write (iout,*) "After read_dist_constr nhpb",nhpb
- call hpb_partition
- if(me.eq.king.or..not.out1file)
- & write (iout,*) 'Contact order:',co
- if (pdbref) then
- if(me.eq.king.or..not.out1file)
- & write (2,*) 'Shifting contacts:',nstart_seq,nstart_sup
- do i=1,ncont_ref
- do j=1,2
- icont_ref(j,i)=icont_ref(j,i)+nstart_seq-nstart_sup
- enddo
- if(me.eq.king.or..not.out1file)
- & write (2,*) i,' ',restyp(itype(icont_ref(1,i))),' ',
- & icont_ref(1,i),' ',
- & restyp(itype(icont_ref(2,i))),' ',icont_ref(2,i)
- enddo
- endif
- endif
- if (indpdb.eq.0 .and. modecalc.ne.2 .and. modecalc.ne.4
- & .and. modecalc.ne.8 .and. modecalc.ne.9 .and.
- & modecalc.ne.10) then
-C If input structure hasn't been supplied from the PDB file read or generate
-C initial geometry.
- if (iranconf.eq.0 .and. .not. extconf) then
- if(me.eq.king.or..not.out1file .and.fg_rank.eq.0)
- & write (iout,'(a)') 'Initial geometry will be read in.'
- if (read_cart) then
- read(inp,'(8f10.5)',end=36,err=36)
- & ((c(l,k),l=1,3),k=1,nres),
- & ((c(l,k+nres),l=1,3),k=nnt,nct)
- call int_from_cart1(.false.)
- do i=1,nres-1
- do j=1,3
- dc(j,i)=c(j,i+1)-c(j,i)
- dc_norm(j,i)=dc_norm(j,i)*vbld_inv(i+1)
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- dc_norm(j,i+nres)=dc_norm(j,i+nres)*vbld_inv(i+nres)
- enddo
- endif
- enddo
- return
- else
- call read_angles(inp,*36)
- endif
- goto 37
- 36 write (iout,'(a)') 'Error reading angle file.'
-#ifdef MPI
- call mpi_finalize( MPI_COMM_WORLD,IERR )
-#endif
- stop 'Error reading angle file.'
- 37 continue
- else if (extconf) then
- if(me.eq.king.or..not.out1file .and. fg_rank.eq.0)
- & write (iout,'(a)') 'Extended chain initial geometry.'
- do i=3,nres
- theta(i)=90d0*deg2rad
- enddo
- do i=4,nres
- phi(i)=180d0*deg2rad
- enddo
- do i=2,nres-1
- alph(i)=110d0*deg2rad
- enddo
- do i=2,nres-1
- omeg(i)=-120d0*deg2rad
- enddo
- else
- if(me.eq.king.or..not.out1file)
- & write (iout,'(a)') 'Random-generated initial geometry.'
-
-
-#ifdef MPI
- if (me.eq.king .or. fg_rank.eq.0 .and. (
- & modecalc.eq.12 .or. modecalc.eq.14) ) then
-#endif
- do itrial=1,100
- itmp=1
- call gen_rand_conf(itmp,*30)
- goto 40
- 30 write (iout,*) 'Failed to generate random conformation',
- & ', itrial=',itrial
- write (*,*) 'Processor:',me,
- & ' Failed to generate random conformation',
- & ' itrial=',itrial
- call intout
-
-#ifdef AIX
- call flush_(iout)
-#else
- call flush(iout)
-#endif
- enddo
- write (iout,'(a,i3,a)') 'Processor:',me,
- & ' error in generating random conformation.'
- write (*,'(a,i3,a)') 'Processor:',me,
- & ' error in generating random conformation.'
- call flush(iout)
-#ifdef MPI
- call MPI_Abort(mpi_comm_world,error_msg,ierrcode)
- 40 continue
- endif
-#else
- 40 continue
-#endif
- endif
- elseif (modecalc.eq.4) then
- read (inp,'(a)') intinname
- open (intin,file=intinname,status='old',err=333)
- if (me.eq.king .or. .not.out1file.and.fg_rank.eq.0)
- & write (iout,'(a)') 'intinname',intinname
- write (*,'(a)') 'Processor',myrank,' intinname',intinname
- goto 334
- 333 write (iout,'(2a)') 'Error opening angle file ',intinname
-#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,IERR)
-#endif
- stop 'Error opening angle file.'
- 334 continue
-
- endif
-C Generate distance constraints, if the PDB structure is to be regularized.
- if (nthread.gt.0) then
- call read_threadbase
- endif
- call setup_var
- if (me.eq.king .or. .not. out1file)
- & call intout
- if (ns.gt.0 .and. (me.eq.king .or. .not.out1file) ) then
- write (iout,'(/a,i3,a)')
- & 'The chain contains',ns,' disulfide-bridging cysteines.'
- write (iout,'(20i4)') (iss(i),i=1,ns)
- write (iout,'(/a/)') 'Pre-formed links are:'
- do i=1,nss
- i1=ihpb(i)-nres
- i2=jhpb(i)-nres
- it1=itype(i1)
- it2=itype(i2)
- if (me.eq.king.or..not.out1file)
- & write (iout,'(2a,i3,3a,i3,a,3f10.3)')
- & restyp(it1),'(',i1,') -- ',restyp(it2),'(',i2,')',dhpb(i),
- & ebr,forcon(i)
- enddo
- write (iout,'(a)')
- endif
- if (i2ndstr.gt.0) call secstrp2dihc
-c call geom_to_var(nvar,x)
-c call etotal(energia(0))
-c call enerprint(energia(0))
-c call briefout(0,etot)
-c stop
-cd write (iout,'(2(a,i3))') 'NNT',NNT,' NCT',NCT
-cd write (iout,'(a)') 'Variable list:'
-cd write (iout,'(i4,f10.5)') (i,rad2deg*x(i),i=1,nvar)
-#ifdef MPI
- if (me.eq.king .or. (fg_rank.eq.0 .and. .not.out1file))
- & write (iout,'(//80(1h*)/20x,a,i4,a/80(1h*)//)')
- & 'Processor',myrank,': end reading molecular data.'
-#endif
- return
- end
-c--------------------------------------------------------------------------
- logical function seq_comp(itypea,itypeb,length)
- implicit none
- integer length,itypea(length),itypeb(length)
- integer i
- do i=1,length
- if (itypea(i).ne.itypeb(i)) then
- seq_comp=.false.
- return
- endif
- enddo
- seq_comp=.true.
- return
- end
-c-----------------------------------------------------------------------------
- subroutine read_bridge
-C Read information about disulfide bridges.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.NAMES'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.DBASE'
- include 'COMMON.THREAD'
- include 'COMMON.TIME1'
- include 'COMMON.SETUP'
-C Read bridging residues.
- read (inp,*) ns,(iss(i),i=1,ns)
- print *,'ns=',ns
- if(me.eq.king.or..not.out1file)
- & write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns)
-C Check whether the specified bridging residues are cystines.
- do i=1,ns
- if (itype(iss(i)).ne.1) then
- if (me.eq.king.or..not.out1file) write (iout,'(2a,i3,a)')
- & 'Do you REALLY think that the residue ',restyp(iss(i)),i,
- & ' can form a disulfide bridge?!!!'
- write (*,'(2a,i3,a)')
- & 'Do you REALLY think that the residue ',restyp(iss(i)),i,
- & ' can form a disulfide bridge?!!!'
-#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,ierror)
- stop
-#endif
- endif
- enddo
-C Read preformed bridges.
- if (ns.gt.0) then
- read (inp,*) nss,(ihpb(i),jhpb(i),i=1,nss)
- write (iout,*) 'nss=',nss,' ihpb,jhpb: ',(ihpb(i),jhpb(i),i=1,nss)
- if (nss.gt.0) then
- nhpb=nss
-C Check if the residues involved in bridges are in the specified list of
-C bridging residues.
- do i=1,nss
- do j=1,i-1
- if (ihpb(i).eq.ihpb(j).or.ihpb(i).eq.jhpb(j)
- & .or.jhpb(i).eq.ihpb(j).or.jhpb(i).eq.jhpb(j)) then
- write (iout,'(a,i3,a)') 'Disulfide pair',i,
- & ' contains residues present in other pairs.'
- write (*,'(a,i3,a)') 'Disulfide pair',i,
- & ' contains residues present in other pairs.'
-#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,ierror)
- stop
-#endif
- endif
- enddo
- do j=1,ns
- if (ihpb(i).eq.iss(j)) goto 10
- enddo
- write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.'
- 10 continue
- do j=1,ns
- if (jhpb(i).eq.iss(j)) goto 20
- enddo
- write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.'
- 20 continue
- dhpb(i)=dbr
- forcon(i)=fbr
- enddo
- do i=1,nss
- ihpb(i)=ihpb(i)+nres
- jhpb(i)=jhpb(i)+nres
- enddo
- endif
- endif
- return
- end
-c----------------------------------------------------------------------------
- subroutine read_x(kanal,*)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
-c Read coordinates from input
-c
- read(kanal,'(8f10.5)',end=10,err=10)
- & ((c(l,k),l=1,3),k=1,nres),
- & ((c(l,k+nres),l=1,3),k=nnt,nct)
- do j=1,3
- c(j,nres+1)=c(j,1)
- c(j,2*nres)=c(j,nres)
- enddo
- call int_from_cart1(.false.)
- do i=1,nres-1
- do j=1,3
- dc(j,i)=c(j,i+1)-c(j,i)
- dc_norm(j,i)=dc(j,i)*vbld_inv(i+1)
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres)
- enddo
- endif
- enddo
-
- return
- 10 return1
- end
-c----------------------------------------------------------------------------
- subroutine read_threadbase
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.NAMES'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.DBASE'
- include 'COMMON.THREAD'
- include 'COMMON.TIME1'
-C Read pattern database for threading.
- read (icbase,*) nseq
- do i=1,nseq
- read (icbase,'(i5,2x,a8,2i4)') nres_base(1,i),str_nam(i),
- & nres_base(2,i),nres_base(3,i)
- read (icbase,'(9f8.3)') ((cart_base(k,j,i),k=1,3),j=1,
- & nres_base(1,i))
-c write (iout,'(i5,2x,a8,2i4)') nres_base(1,i),str_nam(i),
-c & nres_base(2,i),nres_base(3,i)
-c write (iout,'(9f8.3)') ((cart_base(k,j,i),k=1,3),j=1,
-c & nres_base(1,i))
- enddo
- close (icbase)
- if (weidis.eq.0.0D0) weidis=0.1D0
- do i=nnt,nct
- do j=i+2,nct
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=weidis
- enddo
- enddo
- read (inp,*) nexcl,(iexam(1,i),iexam(2,i),i=1,nexcl)
- write (iout,'(a,i5)') 'nexcl: ',nexcl
- write (iout,'(2i5)') (iexam(1,i),iexam(2,i),i=1,nexcl)
- return
- end
-c------------------------------------------------------------------------------
- subroutine setup_var
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.NAMES'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.DBASE'
- include 'COMMON.THREAD'
- include 'COMMON.TIME1'
-C Set up variable list.
- ntheta=nres-2
- nphi=nres-3
- nvar=ntheta+nphi
- nside=0
- do i=2,nres-1
- if (itype(i).ne.10) then
- nside=nside+1
- ialph(i,1)=nvar+nside
- ialph(nside,2)=i
- endif
- enddo
- if (indphi.gt.0) then
- nvar=nphi
- else if (indback.gt.0) then
- nvar=nphi+ntheta
- else
- nvar=nvar+2*nside
- endif
-cd write (iout,'(3i4)') (i,ialph(i,1),ialph(i,2),i=2,nres-1)
- return
- end
-c----------------------------------------------------------------------------
- subroutine gen_dist_constr
-C Generate CA distance constraints.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.NAMES'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.DBASE'
- include 'COMMON.THREAD'
- include 'COMMON.TIME1'
- dimension itype_pdb(maxres)
- common /pizda/ itype_pdb
- character*2 iden
-cd print *,'gen_dist_constr: nnt=',nnt,' nct=',nct
-cd write (2,*) 'gen_dist_constr: nnt=',nnt,' nct=',nct,
-cd & ' nstart_sup',nstart_sup,' nstart_seq',nstart_seq,
-cd & ' nsup',nsup
- do i=nstart_sup,nstart_sup+nsup-1
-cd write (2,*) 'i',i,' seq ',restyp(itype(i+nstart_seq-nstart_sup)),
-cd & ' seq_pdb', restyp(itype_pdb(i))
- do j=i+2,nstart_sup+nsup-1
- nhpb=nhpb+1
- ihpb(nhpb)=i+nstart_seq-nstart_sup
- jhpb(nhpb)=j+nstart_seq-nstart_sup
- forcon(nhpb)=weidis
- dhpb(nhpb)=dist(i,j)
- enddo
- enddo
-cd write (iout,'(a)') 'Distance constraints:'
-cd do i=nss+1,nhpb
-cd ii=ihpb(i)
-cd jj=jhpb(i)
-cd iden='CA'
-cd if (ii.gt.nres) then
-cd iden='SC'
-cd ii=ii-nres
-cd jj=jj-nres
-cd endif
-cd write (iout,'(a,1x,a,i4,3x,a,1x,a,i4,2f10.3)')
-cd & restyp(itype(ii)),iden,ii,restyp(itype(jj)),iden,jj,
-cd & dhpb(i),forcon(i)
-cd enddo
- return
- end
-c----------------------------------------------------------------------------
- subroutine map_read
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MAP'
- include 'COMMON.IOUNITS'
- character*3 angid(4) /'THE','PHI','ALP','OME'/
- character*80 mapcard,ucase
- do imap=1,nmap
- read (inp,'(a)') mapcard
- mapcard=ucase(mapcard)
- if (index(mapcard,'PHI').gt.0) then
- kang(imap)=1
- else if (index(mapcard,'THE').gt.0) then
- kang(imap)=2
- else if (index(mapcard,'ALP').gt.0) then
- kang(imap)=3
- else if (index(mapcard,'OME').gt.0) then
- kang(imap)=4
- else
- write(iout,'(a)')'Error - illegal variable spec in MAP card.'
- stop 'Error - illegal variable spec in MAP card.'
- endif
- call readi (mapcard,'RES1',res1(imap),0)
- call readi (mapcard,'RES2',res2(imap),0)
- if (res1(imap).eq.0) then
- res1(imap)=res2(imap)
- else if (res2(imap).eq.0) then
- res2(imap)=res1(imap)
- endif
- if(res1(imap)*res2(imap).eq.0 .or. res1(imap).gt.res2(imap))then
- write (iout,'(a)')
- & 'Error - illegal definition of variable group in MAP.'
- stop 'Error - illegal definition of variable group in MAP.'
- endif
- call reada(mapcard,'FROM',ang_from(imap),0.0D0)
- call reada(mapcard,'TO',ang_to(imap),0.0D0)
- call readi(mapcard,'NSTEP',nstep(imap),0)
- if (ang_from(imap).eq.ang_to(imap) .or. nstep(imap).eq.0) then
- write (iout,'(a)')
- & 'Illegal boundary and/or step size specification in MAP.'
- stop 'Illegal boundary and/or step size specification in MAP.'
- endif
- enddo ! imap
- return
- end
-c----------------------------------------------------------------------------
- subroutine csaread
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CONTROL'
- character*80 ucase
- character*620 mcmcard
- call card_concat(mcmcard)
-
- call readi(mcmcard,'NCONF',nconf,50)
- call readi(mcmcard,'NADD',nadd,0)
- call readi(mcmcard,'JSTART',jstart,1)
- call readi(mcmcard,'JEND',jend,1)
- call readi(mcmcard,'NSTMAX',nstmax,500000)
- call readi(mcmcard,'N0',n0,1)
- call readi(mcmcard,'N1',n1,6)
- call readi(mcmcard,'N2',n2,4)
- call readi(mcmcard,'N3',n3,0)
- call readi(mcmcard,'N4',n4,0)
- call readi(mcmcard,'N5',n5,0)
- call readi(mcmcard,'N6',n6,10)
- call readi(mcmcard,'N7',n7,0)
- call readi(mcmcard,'N8',n8,0)
- call readi(mcmcard,'N9',n9,0)
- call readi(mcmcard,'N14',n14,0)
- call readi(mcmcard,'N15',n15,0)
- call readi(mcmcard,'N16',n16,0)
- call readi(mcmcard,'N17',n17,0)
- call readi(mcmcard,'N18',n18,0)
-
- vdisulf=(index(mcmcard,'DYNSS').gt.0)
-
- call readi(mcmcard,'NDIFF',ndiff,2)
- call reada(mcmcard,'DIFFCUT',diffcut,0.0d0)
- call readi(mcmcard,'IS1',is1,1)
- call readi(mcmcard,'IS2',is2,8)
- call readi(mcmcard,'NRAN0',nran0,4)
- call readi(mcmcard,'NRAN1',nran1,2)
- call readi(mcmcard,'IRR',irr,1)
- call readi(mcmcard,'NSEED',nseed,20)
- call readi(mcmcard,'NTOTAL',ntotal,10000)
- call reada(mcmcard,'CUT1',cut1,2.0d0)
- call reada(mcmcard,'CUT2',cut2,5.0d0)
- call reada(mcmcard,'ESTOP',estop,-3000.0d0)
- call readi(mcmcard,'ICMAX',icmax,3)
- call readi(mcmcard,'IRESTART',irestart,0)
-c!bankt call readi(mcmcard,'NBANKTM',ntbankm,0)
- ntbankm=0
-c!bankt
- call reada(mcmcard,'DELE',dele,20.0d0)
- call reada(mcmcard,'DIFCUT',difcut,720.0d0)
- call readi(mcmcard,'IREF',iref,0)
- call reada(mcmcard,'RMSCUT',rmscut,4.0d0)
- call reada(mcmcard,'PNCCUT',pnccut,0.5d0)
- call readi(mcmcard,'NCONF_IN',nconf_in,0)
- call reada(mcmcard,'RDIH_BIAS',rdih_bias,0.5d0)
- write (iout,*) "NCONF_IN",nconf_in
- return
- end
-c----------------------------------------------------------------------------
-cfmc subroutine mcmfread
-cfmc implicit real*8 (a-h,o-z)
-cfmc include 'DIMENSIONS'
-cfmc include 'COMMON.MCMF'
-cfmc include 'COMMON.IOUNITS'
-cfmc include 'COMMON.GEO'
-cfmc character*80 ucase
-cfmc character*620 mcmcard
-cfmc call card_concat(mcmcard)
-cfmc
-cfmc call readi(mcmcard,'MAXRANT',maxrant,1000)
-cfmc write(iout,*)'MAXRANT=',maxrant
-cfmc call readi(mcmcard,'MAXFAM',maxfam,maxfam_p)
-cfmc write(iout,*)'MAXFAM=',maxfam
-cfmc call readi(mcmcard,'NNET1',nnet1,5)
-cfmc write(iout,*)'NNET1=',nnet1
-cfmc call readi(mcmcard,'NNET2',nnet2,4)
-cfmc write(iout,*)'NNET2=',nnet2
-cfmc call readi(mcmcard,'NNET3',nnet3,4)
-cfmc write(iout,*)'NNET3=',nnet3
-cfmc call readi(mcmcard,'ILASTT',ilastt,0)
-cfmc write(iout,*)'ILASTT=',ilastt
-cfmc call readi(mcmcard,'MAXSTR',maxstr,maxstr_mcmf)
-cfmc write(iout,*)'MAXSTR=',maxstr
-cfmc maxstr_f=maxstr/maxfam
-cfmc write(iout,*)'MAXSTR_F=',maxstr_f
-cfmc call readi(mcmcard,'NMCMF',nmcmf,10)
-cfmc write(iout,*)'NMCMF=',nmcmf
-cfmc call readi(mcmcard,'IFOCUS',ifocus,nmcmf)
-cfmc write(iout,*)'IFOCUS=',ifocus
-cfmc call readi(mcmcard,'NLOCMCMF',nlocmcmf,1000)
-cfmc write(iout,*)'NLOCMCMF=',nlocmcmf
-cfmc call readi(mcmcard,'INTPRT',intprt,1000)
-cfmc write(iout,*)'INTPRT=',intprt
-cfmc call readi(mcmcard,'IPRT',iprt,100)
-cfmc write(iout,*)'IPRT=',iprt
-cfmc call readi(mcmcard,'IMAXTR',imaxtr,100)
-cfmc write(iout,*)'IMAXTR=',imaxtr
-cfmc call readi(mcmcard,'MAXEVEN',maxeven,1000)
-cfmc write(iout,*)'MAXEVEN=',maxeven
-cfmc call readi(mcmcard,'MAXEVEN1',maxeven1,3)
-cfmc write(iout,*)'MAXEVEN1=',maxeven1
-cfmc call readi(mcmcard,'INIMIN',inimin,200)
-cfmc write(iout,*)'INIMIN=',inimin
-cfmc call readi(mcmcard,'NSTEPMCMF',nstepmcmf,10)
-cfmc write(iout,*)'NSTEPMCMF=',nstepmcmf
-cfmc call readi(mcmcard,'NTHREAD',nthread,5)
-cfmc write(iout,*)'NTHREAD=',nthread
-cfmc call readi(mcmcard,'MAXSTEPMCMF',maxstepmcmf,2500)
-cfmc write(iout,*)'MAXSTEPMCMF=',maxstepmcmf
-cfmc call readi(mcmcard,'MAXPERT',maxpert,9)
-cfmc write(iout,*)'MAXPERT=',maxpert
-cfmc call readi(mcmcard,'IRMSD',irmsd,1)
-cfmc write(iout,*)'IRMSD=',irmsd
-cfmc call reada(mcmcard,'DENEMIN',denemin,0.01D0)
-cfmc write(iout,*)'DENEMIN=',denemin
-cfmc call reada(mcmcard,'RCUT1S',rcut1s,3.5D0)
-cfmc write(iout,*)'RCUT1S=',rcut1s
-cfmc call reada(mcmcard,'RCUT1E',rcut1e,2.0D0)
-cfmc write(iout,*)'RCUT1E=',rcut1e
-cfmc call reada(mcmcard,'RCUT2S',rcut2s,0.5D0)
-cfmc write(iout,*)'RCUT2S=',rcut2s
-cfmc call reada(mcmcard,'RCUT2E',rcut2e,0.1D0)
-cfmc write(iout,*)'RCUT2E=',rcut2e
-cfmc call reada(mcmcard,'DPERT1',d_pert1,180.0D0)
-cfmc write(iout,*)'DPERT1=',d_pert1
-cfmc call reada(mcmcard,'DPERT1A',d_pert1a,180.0D0)
-cfmc write(iout,*)'DPERT1A=',d_pert1a
-cfmc call reada(mcmcard,'DPERT2',d_pert2,90.0D0)
-cfmc write(iout,*)'DPERT2=',d_pert2
-cfmc call reada(mcmcard,'DPERT2A',d_pert2a,45.0D0)
-cfmc write(iout,*)'DPERT2A=',d_pert2a
-cfmc call reada(mcmcard,'DPERT2B',d_pert2b,90.0D0)
-cfmc write(iout,*)'DPERT2B=',d_pert2b
-cfmc call reada(mcmcard,'DPERT2C',d_pert2c,60.0D0)
-cfmc write(iout,*)'DPERT2C=',d_pert2c
-cfmc d_pert1=deg2rad*d_pert1
-cfmc d_pert1a=deg2rad*d_pert1a
-cfmc d_pert2=deg2rad*d_pert2
-cfmc d_pert2a=deg2rad*d_pert2a
-cfmc d_pert2b=deg2rad*d_pert2b
-cfmc d_pert2c=deg2rad*d_pert2c
-cfmc call reada(mcmcard,'KT_MCMF1',kt_mcmf1,1.0D0)
-cfmc write(iout,*)'KT_MCMF1=',kt_mcmf1
-cfmc call reada(mcmcard,'KT_MCMF2',kt_mcmf2,1.0D0)
-cfmc write(iout,*)'KT_MCMF2=',kt_mcmf2
-cfmc call reada(mcmcard,'DKT_MCMF1',dkt_mcmf1,10.0D0)
-cfmc write(iout,*)'DKT_MCMF1=',dkt_mcmf1
-cfmc call reada(mcmcard,'DKT_MCMF2',dkt_mcmf2,1.0D0)
-cfmc write(iout,*)'DKT_MCMF2=',dkt_mcmf2
-cfmc call reada(mcmcard,'RCUTINI',rcutini,3.5D0)
-cfmc write(iout,*)'RCUTINI=',rcutini
-cfmc call reada(mcmcard,'GRAT',grat,0.5D0)
-cfmc write(iout,*)'GRAT=',grat
-cfmc call reada(mcmcard,'BIAS_MCMF',bias_mcmf,0.0D0)
-cfmc write(iout,*)'BIAS_MCMF=',bias_mcmf
-cfmc
-cfmc return
-cfmc end
-c----------------------------------------------------------------------------
- subroutine mcmread
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MCM'
- include 'COMMON.MCE'
- include 'COMMON.IOUNITS'
- character*80 ucase
- character*320 mcmcard
- call card_concat(mcmcard)
- call readi(mcmcard,'MAXACC',maxacc,100)
- call readi(mcmcard,'MAX_MCM_IT',max_mcm_it,10000)
- call readi(mcmcard,'MAXTRIAL',maxtrial,100)
- call readi(mcmcard,'MAXTRIAL_ITER',maxtrial_iter,1000)
- call readi(mcmcard,'MAXREPM',maxrepm,200)
- call reada(mcmcard,'RANFRACT',RanFract,0.5D0)
- call reada(mcmcard,'POOL_FRACT',pool_fraction,0.01D0)
- call reada(mcmcard,'OVERLAP',overlap_cut,1.0D3)
- call reada(mcmcard,'E_UP',e_up,5.0D0)
- call reada(mcmcard,'DELTE',delte,0.1D0)
- call readi(mcmcard,'NSWEEP',nsweep,5)
- call readi(mcmcard,'NSTEPH',nsteph,0)
- call readi(mcmcard,'NSTEPC',nstepc,0)
- call reada(mcmcard,'TMIN',tmin,298.0D0)
- call reada(mcmcard,'TMAX',tmax,298.0D0)
- call readi(mcmcard,'NWINDOW',nwindow,0)
- call readi(mcmcard,'PRINT_MC',print_mc,0)
- print_stat=(index(mcmcard,'NO_PRINT_STAT').le.0)
- print_int=(index(mcmcard,'NO_PRINT_INT').le.0)
- ent_read=(index(mcmcard,'ENT_READ').gt.0)
- call readi(mcmcard,'SAVE_FREQ',save_frequency,1000)
- call readi(mcmcard,'MESSAGE_FREQ',message_frequency,1000)
- call readi(mcmcard,'POOL_READ_FREQ',pool_read_freq,5000)
- call readi(mcmcard,'POOL_SAVE_FREQ',pool_save_freq,1000)
- call readi(mcmcard,'PRINT_FREQ',print_freq,1000)
- if (nwindow.gt.0) then
- read (inp,*) (winstart(i),winend(i),i=1,nwindow)
- do i=1,nwindow
- winlen(i)=winend(i)-winstart(i)+1
- enddo
- endif
- if (tmax.lt.tmin) tmax=tmin
- if (tmax.eq.tmin) then
- nstepc=0
- nsteph=0
- endif
- if (nstepc.gt.0 .and. nsteph.gt.0) then
- tsteph=(tmax/tmin)**(1.0D0/(nsteph+0.0D0))
- tstepc=(tmax/tmin)**(1.0D0/(nstepc+0.0D0))
- endif
-C Probabilities of different move types
- sumpro_type(0)=0.0D0
- call reada(mcmcard,'MULTI_BOND',sumpro_type(1),1.0d0)
- call reada(mcmcard,'ONE_ANGLE' ,sumpro_type(2),2.0d0)
- sumpro_type(2)=sumpro_type(1)+sumpro_type(2)
- call reada(mcmcard,'THETA' ,sumpro_type(3),0.0d0)
- sumpro_type(3)=sumpro_type(2)+sumpro_type(3)
- call reada(mcmcard,'SIDE_CHAIN',sumpro_type(4),0.5d0)
- sumpro_type(4)=sumpro_type(3)+sumpro_type(4)
- do i=1,MaxMoveType
- print *,'i',i,' sumprotype',sumpro_type(i)
- sumpro_type(i)=sumpro_type(i)/sumpro_type(MaxMoveType)
- print *,'i',i,' sumprotype',sumpro_type(i)
- enddo
- return
- end
-c----------------------------------------------------------------------------
- subroutine read_minim
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MINIM'
- include 'COMMON.IOUNITS'
- character*80 ucase
- character*320 minimcard
- call card_concat(minimcard)
- call readi(minimcard,'MAXMIN',maxmin,2000)
- call readi(minimcard,'MAXFUN',maxfun,5000)
- call readi(minimcard,'MINMIN',minmin,maxmin)
- call readi(minimcard,'MINFUN',minfun,maxmin)
- call reada(minimcard,'TOLF',tolf,1.0D-2)
- call reada(minimcard,'RTOLF',rtolf,1.0D-4)
- write (iout,'(/80(1h*)/20x,a/80(1h*))')
- & 'Options in energy minimization:'
- write (iout,'(4(a,i5),a,1pe14.5,a,1pe14.5)')
- & 'MaxMin:',MaxMin,' MaxFun:',MaxFun,
- & 'MinMin:',MinMin,' MinFun:',MinFun,
- & ' TolF:',TolF,' RTolF:',RTolF
- return
- end
-c----------------------------------------------------------------------------
- subroutine read_angles(kanal,*)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
-c Read angles from input
-c
- read (kanal,*,err=10,end=10) (theta(i),i=3,nres)
- read (kanal,*,err=10,end=10) (phi(i),i=4,nres)
- read (kanal,*,err=10,end=10) (alph(i),i=2,nres-1)
- read (kanal,*,err=10,end=10) (omeg(i),i=2,nres-1)
-
- do i=1,nres
-c 9/7/01 avoid 180 deg valence angle
- if (theta(i).gt.179.99d0) theta(i)=179.99d0
-c
- theta(i)=deg2rad*theta(i)
- phi(i)=deg2rad*phi(i)
- alph(i)=deg2rad*alph(i)
- omeg(i)=deg2rad*omeg(i)
- enddo
- return
- 10 return1
- end
-c----------------------------------------------------------------------------
- subroutine reada(rekord,lancuch,wartosc,default)
- implicit none
- character*(*) rekord,lancuch
- double precision wartosc,default
- integer ilen,iread
- external ilen
- iread=index(rekord,lancuch)
- if (iread.eq.0) then
- wartosc=default
- return
- endif
- iread=iread+ilen(lancuch)+1
- read (rekord(iread:),*,err=10,end=10) wartosc
- return
- 10 wartosc=default
- return
- end
-c----------------------------------------------------------------------------
- subroutine readi(rekord,lancuch,wartosc,default)
- implicit none
- character*(*) rekord,lancuch
- integer wartosc,default
- integer ilen,iread
- external ilen
- iread=index(rekord,lancuch)
- if (iread.eq.0) then
- wartosc=default
- return
- endif
- iread=iread+ilen(lancuch)+1
- read (rekord(iread:),*,err=10,end=10) wartosc
- return
- 10 wartosc=default
- return
- end
-c----------------------------------------------------------------------------
- subroutine multreadi(rekord,lancuch,tablica,dim,default)
- implicit none
- integer dim,i
- integer tablica(dim),default
- character*(*) rekord,lancuch
- character*80 aux
- integer ilen,iread
- external ilen
- do i=1,dim
- tablica(i)=default
- enddo
- iread=index(rekord,lancuch(:ilen(lancuch))//"=")
- if (iread.eq.0) return
- iread=iread+ilen(lancuch)+1
- read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
- 10 return
- end
-c----------------------------------------------------------------------------
- subroutine multreada(rekord,lancuch,tablica,dim,default)
- implicit none
- integer dim,i
- double precision tablica(dim),default
- character*(*) rekord,lancuch
- character*80 aux
- integer ilen,iread
- external ilen
- do i=1,dim
- tablica(i)=default
- enddo
- iread=index(rekord,lancuch(:ilen(lancuch))//"=")
- if (iread.eq.0) return
- iread=iread+ilen(lancuch)+1
- read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
- 10 return
- end
-c----------------------------------------------------------------------------
- subroutine openunits
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- character*16 form,nodename
- integer nodelen
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- include 'COMMON.MD'
- include 'COMMON.CONTROL'
- integer lenpre,lenpot,ilen,lentmp
- external ilen
- character*3 out1file_text,ucase
- character*3 ll
- external ucase
-c print *,"Processor",myrank,"fg_rank",fg_rank," entered openunits"
- call getenv_loc("PREFIX",prefix)
- pref_orig = prefix
- call getenv_loc("POT",pot)
- call getenv_loc("DIRTMP",tmpdir)
- call getenv_loc("CURDIR",curdir)
- call getenv_loc("OUT1FILE",out1file_text)
-c print *,"Processor",myrank,"fg_rank",fg_rank," did GETENV"
- out1file_text=ucase(out1file_text)
- if (out1file_text(1:1).eq."Y") then
- out1file=.true.
- else
- out1file=fg_rank.gt.0
- endif
- lenpre=ilen(prefix)
- lenpot=ilen(pot)
- lentmp=ilen(tmpdir)
- if (lentmp.gt.0) then
- write (*,'(80(1h!))')
- write (*,'(a,19x,a,19x,a)') "!"," A T T E N T I O N ","!"
- write (*,'(80(1h!))')
- write (*,*)"All output files will be on node /tmp directory."
-#ifdef MPI
- call MPI_GET_PROCESSOR_NAME( nodename, nodelen, IERROR )
- if (me.eq.king) then
- write (*,*) "The master node is ",nodename
- else if (fg_rank.eq.0) then
- write (*,*) "I am the CG slave node ",nodename
- else
- write (*,*) "I am the FG slave node ",nodename
- endif
-#endif
- PREFIX = tmpdir(:lentmp)//'/'//prefix(:lenpre)
- lenpre = lentmp+lenpre+1
- endif
- entname=prefix(:lenpre)//'_'//pot(:lenpot)//'.entr'
-C Get the names and open the input files
-#if defined(WINIFL) || defined(WINPGI)
- open(1,file=pref_orig(:ilen(pref_orig))//
- & '.inp',status='old',readonly,shared)
- open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
-C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
-C Get parameter filenames and open the parameter files.
- call getenv_loc('BONDPAR',bondname)
- open (ibond,file=bondname,status='old',readonly,shared)
- call getenv_loc('THETPAR',thetname)
- open (ithep,file=thetname,status='old',readonly,shared)
- call getenv_loc('ROTPAR',rotname)
- open (irotam,file=rotname,status='old',readonly,shared)
- call getenv_loc('TORPAR',torname)
- open (itorp,file=torname,status='old',readonly,shared)
- call getenv_loc('TORDPAR',tordname)
- open (itordp,file=tordname,status='old',readonly,shared)
- call getenv_loc('FOURIER',fouriername)
- open (ifourier,file=fouriername,status='old',readonly,shared)
- call getenv_loc('ELEPAR',elename)
- open (ielep,file=elename,status='old',readonly,shared)
- call getenv_loc('SIDEPAR',sidename)
- open (isidep,file=sidename,status='old',readonly,shared)
-#elif (defined CRAY) || (defined AIX)
- open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old',
- & action='read')
-c print *,"Processor",myrank," opened file 1"
- open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
-c print *,"Processor",myrank," opened file 9"
-C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
-C Get parameter filenames and open the parameter files.
- call getenv_loc('BONDPAR',bondname)
- open (ibond,file=bondname,status='old',action='read')
-c print *,"Processor",myrank," opened file IBOND"
- call getenv_loc('THETPAR',thetname)
- open (ithep,file=thetname,status='old',action='read')
-c print *,"Processor",myrank," opened file ITHEP"
- call getenv_loc('ROTPAR',rotname)
- open (irotam,file=rotname,status='old',action='read')
-c print *,"Processor",myrank," opened file IROTAM"
- call getenv_loc('TORPAR',torname)
- open (itorp,file=torname,status='old',action='read')
-c print *,"Processor",myrank," opened file ITORP"
- call getenv_loc('TORDPAR',tordname)
- open (itordp,file=tordname,status='old',action='read')
-c print *,"Processor",myrank," opened file ITORDP"
- call getenv_loc('SCCORPAR',sccorname)
- open (isccor,file=sccorname,status='old',action='read')
-c print *,"Processor",myrank," opened file ISCCOR"
- call getenv_loc('FOURIER',fouriername)
- open (ifourier,file=fouriername,status='old',action='read')
-c print *,"Processor",myrank," opened file IFOURIER"
- call getenv_loc('ELEPAR',elename)
- open (ielep,file=elename,status='old',action='read')
-c print *,"Processor",myrank," opened file IELEP"
- call getenv_loc('SIDEPAR',sidename)
- open (isidep,file=sidename,status='old',action='read')
-c print *,"Processor",myrank," opened file ISIDEP"
-c print *,"Processor",myrank," opened parameter files"
-#elif (defined G77)
- open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old')
- open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
-C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
-C Get parameter filenames and open the parameter files.
- call getenv_loc('BONDPAR',bondname)
- open (ibond,file=bondname,status='old')
- call getenv_loc('THETPAR',thetname)
- open (ithep,file=thetname,status='old')
- call getenv_loc('ROTPAR',rotname)
- open (irotam,file=rotname,status='old')
- call getenv_loc('TORPAR',torname)
- open (itorp,file=torname,status='old')
- call getenv_loc('TORDPAR',tordname)
- open (itordp,file=tordname,status='old')
- call getenv_loc('SCCORPAR',sccorname)
- open (isccor,file=sccorname,status='old')
- call getenv_loc('FOURIER',fouriername)
- open (ifourier,file=fouriername,status='old')
- call getenv_loc('ELEPAR',elename)
- open (ielep,file=elename,status='old')
- call getenv_loc('SIDEPAR',sidename)
- open (isidep,file=sidename,status='old')
-#else
- open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old',
- & readonly)
- open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
-C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
-C Get parameter filenames and open the parameter files.
- call getenv_loc('BONDPAR',bondname)
- open (ibond,file=bondname,status='old',readonly)
- call getenv_loc('THETPAR',thetname)
- open (ithep,file=thetname,status='old',readonly)
- call getenv_loc('ROTPAR',rotname)
- open (irotam,file=rotname,status='old',readonly)
- call getenv_loc('TORPAR',torname)
- open (itorp,file=torname,status='old',readonly)
- call getenv_loc('TORDPAR',tordname)
- open (itordp,file=tordname,status='old',readonly)
- call getenv_loc('SCCORPAR',sccorname)
- open (isccor,file=sccorname,status='old',readonly)
- call getenv_loc('FOURIER',fouriername)
- open (ifourier,file=fouriername,status='old',readonly)
- call getenv_loc('ELEPAR',elename)
- open (ielep,file=elename,status='old',readonly)
- call getenv_loc('SIDEPAR',sidename)
- open (isidep,file=sidename,status='old',readonly)
-#endif
-#ifndef OLDSCP
-C
-C 8/9/01 In the newest version SCp interaction constants are read from a file
-C Use -DOLDSCP to use hard-coded constants instead.
-C
- call getenv_loc('SCPPAR',scpname)
-#if defined(WINIFL) || defined(WINPGI)
- open (iscpp,file=scpname,status='old',readonly,shared)
-#elif (defined CRAY) || (defined AIX)
- open (iscpp,file=scpname,status='old',action='read')
-#elif (defined G77)
- open (iscpp,file=scpname,status='old')
-#else
- open (iscpp,file=scpname,status='old',readonly)
-#endif
-#endif
- call getenv_loc('PATTERN',patname)
-#if defined(WINIFL) || defined(WINPGI)
- open (icbase,file=patname,status='old',readonly,shared)
-#elif (defined CRAY) || (defined AIX)
- open (icbase,file=patname,status='old',action='read')
-#elif (defined G77)
- open (icbase,file=patname,status='old')
-#else
- open (icbase,file=patname,status='old',readonly)
-#endif
-#ifdef MPI
-C Open output file only for CG processes
-c print *,"Processor",myrank," fg_rank",fg_rank
- if (fg_rank.eq.0) then
-
- if (nodes.eq.1) then
- npos=3
- else
- npos = dlog10(dfloat(nodes-1))+1
- endif
- if (npos.lt.3) npos=3
- write (liczba,'(i1)') npos
- form = '(bz,i'//liczba(:ilen(liczba))//'.'//liczba(:ilen(liczba))
- & //')'
- write (liczba,form) me
- outname=prefix(:lenpre)//'.out_'//pot(:lenpot)//
- & liczba(:ilen(liczba))
- intname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba))
- & //'.int'
- pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba))
- & //'.pdb'
- mol2name=prefix(:lenpre)//'_'//pot(:lenpot)//
- & liczba(:ilen(liczba))//'.mol2'
- statname=prefix(:lenpre)//'_'//pot(:lenpot)//
- & liczba(:ilen(liczba))//'.stat'
- if (lentmp.gt.0)
- & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot)
- & //liczba(:ilen(liczba))//'.stat')
- rest2name=prefix(:ilen(prefix))//"_"//liczba(:ilen(liczba))
- & //'.rst'
- if(usampl) then
- qname=prefix(:lenpre)//'_'//pot(:lenpot)//
- & liczba(:ilen(liczba))//'.const'
- endif
-
- endif
-#else
- outname=prefix(:lenpre)//'.out_'//pot(:lenpot)
- intname=prefix(:lenpre)//'_'//pot(:lenpot)//'.int'
- pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//'.pdb'
- mol2name=prefix(:lenpre)//'_'//pot(:lenpot)//'.mol2'
- statname=prefix(:lenpre)//'_'//pot(:lenpot)//'.stat'
- if (lentmp.gt.0)
- & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot)
- & //'.stat')
- rest2name=prefix(:ilen(prefix))//'.rst'
- if(usampl) then
- qname=prefix(:lenpre)//'_'//pot(:lenpot)//'.const'
- endif
-#endif
-#if defined(AIX) || defined(PGI)
- if (me.eq.king .or. .not. out1file)
- & open(iout,file=outname,status='unknown')
-#ifdef DEBUG
- if (fg_rank.gt.0) then
- write (liczba,'(i3.3)') myrank/nfgtasks
- write (ll,'(bz,i3.3)') fg_rank
- open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll,
- & status='unknown')
- endif
-#endif
- if(me.eq.king) then
- open(igeom,file=intname,status='unknown',position='append')
- open(ipdb,file=pdbname,status='unknown')
- open(imol2,file=mol2name,status='unknown')
- open(istat,file=statname,status='unknown',position='append')
- else
-c1out open(iout,file=outname,status='unknown')
- endif
-#else
- if (me.eq.king .or. .not.out1file)
- & open(iout,file=outname,status='unknown')
-#ifdef DEBUG
- if (fg_rank.gt.0) then
- write (liczba,'(i3.3)') myrank/nfgtasks
- write (ll,'(bz,i3.3)') fg_rank
- open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll,
- & status='unknown')
- endif
-#endif
- if(me.eq.king) then
- open(igeom,file=intname,status='unknown',access='append')
- open(ipdb,file=pdbname,status='unknown')
- open(imol2,file=mol2name,status='unknown')
- open(istat,file=statname,status='unknown',access='append')
- else
-c1out open(iout,file=outname,status='unknown')
- endif
-#endif
- csa_rbank=prefix(:lenpre)//'.CSA.rbank'
- csa_seed=prefix(:lenpre)//'.CSA.seed'
- csa_history=prefix(:lenpre)//'.CSA.history'
- csa_bank=prefix(:lenpre)//'.CSA.bank'
- csa_bank1=prefix(:lenpre)//'.CSA.bank1'
- csa_alpha=prefix(:lenpre)//'.CSA.alpha'
- csa_alpha1=prefix(:lenpre)//'.CSA.alpha1'
-c!bankt csa_bankt=prefix(:lenpre)//'.CSA.bankt'
- csa_int=prefix(:lenpre)//'.int'
- csa_bank_reminimized=prefix(:lenpre)//'.CSA.bank_reminimized'
- csa_native_int=prefix(:lenpre)//'.CSA.native.int'
- csa_in=prefix(:lenpre)//'.CSA.in'
-c print *,"Processor",myrank,"fg_rank",fg_rank," opened files"
-C Write file names
- if (me.eq.king)then
- write (iout,'(80(1h-))')
- write (iout,'(30x,a)') "FILE ASSIGNMENT"
- write (iout,'(80(1h-))')
- write (iout,*) "Input file : ",
- & pref_orig(:ilen(pref_orig))//'.inp'
- write (iout,*) "Output file : ",
- & outname(:ilen(outname))
- write (iout,*)
- write (iout,*) "Sidechain potential file : ",
- & sidename(:ilen(sidename))
-#ifndef OLDSCP
- write (iout,*) "SCp potential file : ",
- & scpname(:ilen(scpname))
-#endif
- write (iout,*) "Electrostatic potential file : ",
- & elename(:ilen(elename))
- write (iout,*) "Cumulant coefficient file : ",
- & fouriername(:ilen(fouriername))
- write (iout,*) "Torsional parameter file : ",
- & torname(:ilen(torname))
- write (iout,*) "Double torsional parameter file : ",
- & tordname(:ilen(tordname))
- write (iout,*) "SCCOR parameter file : ",
- & sccorname(:ilen(sccorname))
- write (iout,*) "Bond & inertia constant file : ",
- & bondname(:ilen(bondname))
- write (iout,*) "Bending parameter file : ",
- & thetname(:ilen(thetname))
- write (iout,*) "Rotamer parameter file : ",
- & rotname(:ilen(rotname))
- write (iout,*) "Threading database : ",
- & patname(:ilen(patname))
- if (lentmp.ne.0)
- &write (iout,*)" DIRTMP : ",
- & tmpdir(:lentmp)
- write (iout,'(80(1h-))')
- endif
- return
- end
-c----------------------------------------------------------------------------
- subroutine card_concat(card)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- character*(*) card
- character*80 karta,ucase
- external ilen
- read (inp,'(a)') karta
- karta=ucase(karta)
- card=' '
- do while (karta(80:80).eq.'&')
- card=card(:ilen(card)+1)//karta(:79)
- read (inp,'(a)') karta
- karta=ucase(karta)
- enddo
- card=card(:ilen(card)+1)//karta
- return
- end
-c----------------------------------------------------------------------------------
- subroutine readrst
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.MD'
- open(irest2,file=rest2name,status='unknown')
- read(irest2,*) totT,EK,potE,totE,t_bath
- do i=1,2*nres
- read(irest2,'(3e15.5)') (d_t(j,i),j=1,3)
- enddo
- do i=1,2*nres
- read(irest2,'(3e15.5)') (dc(j,i),j=1,3)
- enddo
- if(usampl) then
- read (irest2,*) iset
- endif
- close(irest2)
- return
- end
-c---------------------------------------------------------------------------------
- subroutine read_fragments
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.MD'
- include 'COMMON.CONTROL'
- read(inp,*) nset,nfrag,npair,nfrag_back
- if(me.eq.king.or..not.out1file)
- & write(iout,*) "nset",nset," nfrag",nfrag," npair",npair,
- & " nfrag_back",nfrag_back
- do iset=1,nset
- read(inp,*) mset(iset)
- do i=1,nfrag
- read(inp,*) wfrag(i,iset),ifrag(1,i,iset),ifrag(2,i,iset),
- & qinfrag(i,iset)
- if(me.eq.king.or..not.out1file)
- & write(iout,*) "R ",i,wfrag(i,iset),ifrag(1,i,iset),
- & ifrag(2,i,iset), qinfrag(i,iset)
- enddo
- do i=1,npair
- read(inp,*) wpair(i,iset),ipair(1,i,iset),ipair(2,i,iset),
- & qinpair(i,iset)
- if(me.eq.king.or..not.out1file)
- & write(iout,*) "R ",i,wpair(i,iset),ipair(1,i,iset),
- & ipair(2,i,iset), qinpair(i,iset)
- enddo
- do i=1,nfrag_back
- read(inp,*) wfrag_back(1,i,iset),wfrag_back(2,i,iset),
- & wfrag_back(3,i,iset),
- & ifrag_back(1,i,iset),ifrag_back(2,i,iset)
- if(me.eq.king.or..not.out1file)
- & write(iout,*) "A",i,wfrag_back(1,i,iset),wfrag_back(2,i,iset),
- & wfrag_back(3,i,iset),ifrag_back(1,i,iset),ifrag_back(2,i,iset)
- enddo
- enddo
- return
- end
-c-------------------------------------------------------------------------------
- subroutine read_dist_constr
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.SBRIDGE'
- integer ifrag_(2,100),ipair_(2,100)
- double precision wfrag_(100),wpair_(100)
- character*500 controlcard
-c write (iout,*) "Calling read_dist_constr"
-c write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup
-c call flush(iout)
- call card_concat(controlcard)
- call readi(controlcard,"NFRAG",nfrag_,0)
- call readi(controlcard,"NPAIR",npair_,0)
- call readi(controlcard,"NDIST",ndist_,0)
- call reada(controlcard,'DIST_CUT',dist_cut,5.0d0)
- call multreadi(controlcard,"IFRAG",ifrag_(1,1),2*nfrag_,0)
- call multreadi(controlcard,"IPAIR",ipair_(1,1),2*npair_,0)
- call multreada(controlcard,"WFRAG",wfrag_(1),nfrag_,0.0d0)
- call multreada(controlcard,"WPAIR",wpair_(1),npair_,0.0d0)
-c write (iout,*) "NFRAG",nfrag_," NPAIR",npair_," NDIST",ndist_
-c write (iout,*) "IFRAG"
-c do i=1,nfrag_
-c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
-c enddo
-c write (iout,*) "IPAIR"
-c do i=1,npair_
-c write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i)
-c enddo
- call flush(iout)
- do i=1,nfrag_
- if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup
- if (ifrag_(2,i).gt.nstart_sup+nsup-1)
- & ifrag_(2,i)=nstart_sup+nsup-1
-c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
- call flush(iout)
- if (wfrag_(i).gt.0.0d0) then
- do j=ifrag_(1,i),ifrag_(2,i)-1
- do k=j+1,ifrag_(2,i)
- write (iout,*) "j",j," k",k
- ddjk=dist(j,k)
- if (constr_dist.eq.1) then
- nhpb=nhpb+1
- ihpb(nhpb)=j
- jhpb(nhpb)=k
- dhpb(nhpb)=ddjk
- forcon(nhpb)=wfrag_(i)
- else if (constr_dist.eq.2) then
- if (ddjk.le.dist_cut) then
- nhpb=nhpb+1
- ihpb(nhpb)=j
- jhpb(nhpb)=k
- dhpb(nhpb)=ddjk
- forcon(nhpb)=wfrag_(i)
- endif
- else
- nhpb=nhpb+1
- ihpb(nhpb)=j
- jhpb(nhpb)=k
- dhpb(nhpb)=ddjk
- forcon(nhpb)=wfrag_(i)*dexp(-0.5d0*(ddjk/dist_cut)**2)
- endif
-#ifdef MPI
- if (.not.out1file .or. me.eq.king)
- & write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ",
- & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
-#else
- write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ",
- & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
-#endif
- enddo
- enddo
- endif
- enddo
- do i=1,npair_
- if (wpair_(i).gt.0.0d0) then
- ii = ipair_(1,i)
- jj = ipair_(2,i)
- if (ii.gt.jj) then
- itemp=ii
- ii=jj
- jj=itemp
- endif
- do j=ifrag_(1,ii),ifrag_(2,ii)
- do k=ifrag_(1,jj),ifrag_(2,jj)
- nhpb=nhpb+1
- ihpb(nhpb)=j
- jhpb(nhpb)=k
- forcon(nhpb)=wpair_(i)
- dhpb(nhpb)=dist(j,k)
-#ifdef MPI
- if (.not.out1file .or. me.eq.king)
- & write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
- & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
-#else
- write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
- & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
-#endif
- enddo
- enddo
- endif
- enddo
- do i=1,ndist_
- read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1)
- if (forcon(nhpb+1).gt.0.0d0) then
- nhpb=nhpb+1
- dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
-#ifdef MPI
- if (.not.out1file .or. me.eq.king)
- & write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
- & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
-#else
- write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
- & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
-#endif
- endif
- enddo
- call flush(iout)
- return
- end
-c-------------------------------------------------------------------------------
-#ifdef WINIFL
- subroutine flush(iu)
- return
- end
-#endif
-#ifdef AIX
- subroutine flush(iu)
- call flush_(iu)
- return
- end
-#endif
-c------------------------------------------------------------------------------
- subroutine copy_to_tmp(source)
- include "DIMENSIONS"
- include "COMMON.IOUNITS"
- character*(*) source
- character* 256 tmpfile
- integer ilen
- external ilen
- logical ex
- tmpfile=curdir(:ilen(curdir))//"/"//source(:ilen(source))
- inquire(file=tmpfile,exist=ex)
- if (ex) then
- write (*,*) "Copying ",tmpfile(:ilen(tmpfile)),
- & " to temporary directory..."
- write (*,*) "/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir
- call system("/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir)
- endif
- return
- end
-c------------------------------------------------------------------------------
- subroutine move_from_tmp(source)
- include "DIMENSIONS"
- include "COMMON.IOUNITS"
- character*(*) source
- integer ilen
- external ilen
- write (*,*) "Moving ",source(:ilen(source)),
- & " from temporary directory to working directory"
- write (*,*) "/bin/mv "//source(:ilen(source))//" "//curdir
- call system("/bin/mv "//source(:ilen(source))//" "//curdir)
- return
- end
-c------------------------------------------------------------------------------
- subroutine random_init(seed)
-C
-C Initialize random number generator
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef AMD64
- integer*8 iseedi8
-#endif
-#ifdef MPI
- include 'mpif.h'
- logical OKRandom, prng_restart
- real*8 r1
- integer iseed_array(4)
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- include 'COMMON.THREAD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CONTROL'
- include 'COMMON.MCM'
- include 'COMMON.MAP'
- include 'COMMON.HEADER'
- include 'COMMON.CSA'
- include 'COMMON.CHAIN'
- include 'COMMON.MUCA'
- include 'COMMON.MD'
- include 'COMMON.FFIELD'
- include 'COMMON.SETUP'
- iseed=-dint(dabs(seed))
- if (iseed.eq.0) then
- write (iout,'(/80(1h*)/20x,a/80(1h*))')
- & 'Random seed undefined. The program will stop.'
- write (*,'(/80(1h*)/20x,a/80(1h*))')
- & 'Random seed undefined. The program will stop.'
-#ifdef MPI
- call mpi_finalize(mpi_comm_world,ierr)
-#endif
- stop 'Bad random seed.'
- endif
-#ifdef MPI
- if (fg_rank.eq.0) then
- seed=seed*(me+1)+1
-#ifdef AMD64
- iseedi8=dint(seed)
- if(me.eq.king .or. .not. out1file)
- & write (iout,*) 'MPI: node= ', me, ' iseed= ',iseedi8
- write (*,*) 'MPI: node= ', me, ' iseed= ',iseedi8
- OKRandom = prng_restart(me,iseedi8)
-#else
- do i=1,4
- tmp=65536.0d0**(4-i)
- iseed_array(i) = dint(seed/tmp)
- seed=seed-iseed_array(i)*tmp
- enddo
- if(me.eq.king .or. .not. out1file)
- & write (iout,*) 'MPI: node= ', me, ' iseed(4)= ',
- & (iseed_array(i),i=1,4)
- write (*,*) 'MPI: node= ',me, ' iseed(4)= ',
- & (iseed_array(i),i=1,4)
- OKRandom = prng_restart(me,iseed_array)
-#endif
- if (OKRandom) then
- r1=ran_number(0.0D0,1.0D0)
- if(me.eq.king .or. .not. out1file)
- & write (iout,*) 'ran_num',r1
- if (r1.lt.0.0d0) OKRandom=.false.
- endif
- if (.not.OKRandom) then
- write (iout,*) 'PRNG IS NOT WORKING!!!'
- print *,'PRNG IS NOT WORKING!!!'
- if (me.eq.0) then
- call flush(iout)
- call mpi_abort(mpi_comm_world,error_msg,ierr)
- stop
- else
- write (iout,*) 'too many processors for parallel prng'
- write (*,*) 'too many processors for parallel prng'
- call flush(iout)
- stop
- endif
- endif
- endif
-#else
- call vrndst(iseed)
- write (iout,*) 'ran_num',ran_number(0.0d0,1.0d0)
-#endif
- return
- end
+++ /dev/null
-c---------------------------------
- subroutine csa_read
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.IOUNITS'
-
- open(icsa_in,file=csa_in,status="old",err=100)
- read(icsa_in,*) nconf
- read(icsa_in,*) jstart,jend
- read(icsa_in,*) nstmax
- read(icsa_in,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2
- read(icsa_in,*) nran0,nran1,irr
- read(icsa_in,*) nseed
- read(icsa_in,*) ntotal,cut1,cut2
- read(icsa_in,*) estop
- read(icsa_in,*) icmax,irestart
- read(icsa_in,*) ntbankm,dele,difcut
- read(icsa_in,*) iref,rmscut,pnccut
- read(icsa_in,*) ndiff
- close(icsa_in)
-
- return
-
- 100 continue
- return
- end
-c---------------------------------
- subroutine initial_write
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.IOUNITS'
-
- open(icsa_seed,file=csa_seed,status="unknown")
- write(icsa_seed,*) "seed"
- close(31)
-#if defined(AIX) || defined(PGI)
- open(icsa_history,file=csa_history,status="unknown",
- & position="append")
-#else
- open(icsa_history,file=csa_history,status="unknown",
- & access="append")
-#endif
- write(icsa_history,*) nconf
- write(icsa_history,*) jstart,jend
- write(icsa_history,*) nstmax
- write(icsa_history,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2
- write(icsa_history,*) nran0,nran1,irr
- write(icsa_history,*) nseed
- write(icsa_history,*) ntotal,cut1,cut2
- write(icsa_history,*) estop
- write(icsa_history,*) icmax,irestart
- write(icsa_history,*) ntbankm,dele,difcut
- write(icsa_history,*) iref,rmscut,pnccut
- write(icsa_history,*) ndiff
-
- write(icsa_history,*)
- close(icsa_history)
-
- open(icsa_bank1,file=csa_bank1,status="unknown")
- write(icsa_bank1,*) 0
- close(icsa_bank1)
-
- return
- end
-c---------------------------------
- subroutine restart_write
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
-
-#if defined(AIX) || defined(PGI)
- open(icsa_history,file=csa_history,position="append")
-#else
- open(icsa_history,file=csa_history,access="append")
-#endif
- write(icsa_history,*)
- write(icsa_history,*) "This is restart"
- write(icsa_history,*)
- write(icsa_history,*) nconf
- write(icsa_history,*) jstart,jend
- write(icsa_history,*) nstmax
- write(icsa_history,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2
- write(icsa_history,*) nran0,nran1,irr
- write(icsa_history,*) nseed
- write(icsa_history,*) ntotal,cut1,cut2
- write(icsa_history,*) estop
- write(icsa_history,*) icmax,irestart
- write(icsa_history,*) ntbankm,dele,difcut
- write(icsa_history,*) iref,rmscut,pnccut
- write(icsa_history,*) ndiff
- write(icsa_history,*)
- write(icsa_history,*) "irestart is: ", irestart
-
- write(icsa_history,*)
- close(icsa_history)
-
- return
- end
-c---------------------------------
end
- subroutine test_n16
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CONTROL'
- include 'COMMON.FFIELD'
- include 'COMMON.MINIM'
- include 'COMMON.CHAIN'
- double precision time0,time1
- double precision energy(0:n_ene),ee
- double precision var(maxvar),var1(maxvar)
- integer jdata(5)
- logical debug
- debug=.true.
-
-c
- call geom_to_var(nvar,var1)
- call chainbuild
- call etotal(energy(0))
- etot=energy(0)
- write(iout,*) nnt,nct,etot
- call write_pdb(1,'first structure',etot)
- call secondary2(.true.)
-
- do i=1,4
- jdata(i)=bfrag(i,2)
- enddo
-
- DO ij=1,4
- ieval=0
- jdata(5)=ij
- call var_to_geom(nvar,var1)
- write(iout,*) 'N16 test',(jdata(i),i=1,5)
- call beta_slide(jdata(1),jdata(2),jdata(3),jdata(4),jdata(5)
- & ,ieval,ij)
- call geom_to_var(nvar,var)
-
- if (minim) then
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'------------------------------------------------'
- write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,
- & '+ DIST eval',ieval
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
-
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(ij*100+99,'full min',etot)
- endif
-
-
- ENDDO
-
- return
- end
subroutine test_local
end
-c------------------------------------------
- subroutine test11
+c-------------------------------------------------
+
+ subroutine secondary(lprint)
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.GEO'
include 'COMMON.CHAIN'
include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.CONTROL'
- include 'COMMON.SBRIDGE'
- include 'COMMON.FFIELD'
- include 'COMMON.MINIM'
-c
- include 'COMMON.DISTFIT'
- integer if(20,maxres),nif,ifa(20)
- integer ibc(0:maxres,0:maxres),istrand(20)
- integer ibd(maxres),ifb(10,2),nifb,lifb(10),lifb0
- integer itmp(20,maxres)
- double precision time0,time1
- double precision energy(0:n_ene),ee
- double precision varia(maxvar),vorg(maxvar)
-c
- logical debug,ltest,usedbfrag(maxres/3)
- character*50 linia
-c
- integer betasheet(maxres),ibetasheet(maxres),nbetasheet
- integer bstrand(maxres/3,6),nbstrand
+ include 'COMMON.DISTFIT'
-c------------------------
+ integer ncont,icont(2,maxres*maxres/2),isec(maxres,3)
+ logical lprint,not_done
+ real dcont(maxres*maxres/2),d
+ real rcomp /7.0/
+ real rbeta /5.2/
+ real ralfa /5.2/
+ real r310 /6.6/
+ double precision xpi(3),xpj(3)
- debug=.true.
-c------------------------
- nbstrand=0
- nbetasheet=0
- do i=1,nres
- betasheet(i)=0
- ibetasheet(i)=0
- enddo
- call geom_to_var(nvar,vorg)
- call secondary2(debug)
- if (nbfrag.le.1) return
- do i=1,nbfrag
- usedbfrag(i)=.false.
+ call chainbuild
+cd call write_pdb(99,'sec structure',0d0)
+ ncont=0
+ nbfrag=0
+ nhfrag=0
+ do i=1,nres
+ isec(i,1)=0
+ isec(i,2)=0
+ isec(i,3)=0
enddo
-
- nbetasheet=nbetasheet+1
- nbstrand=2
- bstrand(1,1)=bfrag(1,1)
- bstrand(1,2)=bfrag(2,1)
- bstrand(1,3)=nbetasheet
- bstrand(1,4)=1
- bstrand(1,5)=bfrag(1,1)
- bstrand(1,6)=bfrag(2,1)
- do i=bfrag(1,1),bfrag(2,1)
- betasheet(i)=nbetasheet
- ibetasheet(i)=1
- enddo
-c
- bstrand(2,1)=bfrag(3,1)
- bstrand(2,2)=bfrag(4,1)
- bstrand(2,3)=nbetasheet
- bstrand(2,5)=bfrag(3,1)
- bstrand(2,6)=bfrag(4,1)
-
- if (bfrag(3,1).le.bfrag(4,1)) then
- bstrand(2,4)=2
- do i=bfrag(3,1),bfrag(4,1)
- betasheet(i)=nbetasheet
- ibetasheet(i)=2
+ do i=2,nres-3
+ do k=1,3
+ xpi(k)=0.5d0*(c(k,i-1)+c(k,i))
enddo
- else
- bstrand(2,4)=-2
- do i=bfrag(4,1),bfrag(3,1)
- betasheet(i)=nbetasheet
- ibetasheet(i)=2
+ do j=i+2,nres
+ do k=1,3
+ xpj(k)=0.5d0*(c(k,j-1)+c(k,j))
+ enddo
+cd d = (c(1,i)-c(1,j))*(c(1,i)-c(1,j)) +
+cd & (c(2,i)-c(2,j))*(c(2,i)-c(2,j)) +
+cd & (c(3,i)-c(3,j))*(c(3,i)-c(3,j))
+cd print *,'CA',i,j,d
+ d = (xpi(1)-xpj(1))*(xpi(1)-xpj(1)) +
+ & (xpi(2)-xpj(2))*(xpi(2)-xpj(2)) +
+ & (xpi(3)-xpj(3))*(xpi(3)-xpj(3))
+ if ( d.lt.rcomp*rcomp) then
+ ncont=ncont+1
+ icont(1,ncont)=i
+ icont(2,ncont)=j
+ dcont(ncont)=sqrt(d)
+ endif
+ enddo
+ enddo
+ if (lprint) then
+ write (iout,*)
+ write (iout,'(a)') '#PP contact map distances:'
+ do i=1,ncont
+ write (iout,'(3i4,f10.5)')
+ & i,icont(1,i),icont(2,i),dcont(i)
enddo
endif
- iused_nbfrag=1
-
- do while (iused_nbfrag.ne.nbfrag)
-
- do j=2,nbfrag
-
- IF (.not.usedbfrag(j)) THEN
-
- write (*,*) j,(bfrag(i,j),i=1,4)
- do jk=6,1,-1
- write (*,'(i4,a3,10i4)') jk,'B',(bstrand(i,jk),i=1,nbstrand)
- enddo
- write (*,*) '------------------'
+c finding parallel beta
+cd write (iout,*) '------- looking for parallel beta -----------'
+ nbeta=0
+ nstrand=0
+ do i=1,ncont
+ i1=icont(1,i)
+ j1=icont(2,i)
+ if(dcont(i).le.rbeta .and. j1-i1.gt.4 .and.
+ & isec(i1,1).le.1.and.isec(j1,1).le.1.and.
+ & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and.
+ & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and.
+ & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and.
+ & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0)
+ & ) then
+ ii1=i1
+ jj1=j1
+cd write (iout,*) i1,j1,dcont(i)
+ not_done=.true.
+ do while (not_done)
+ i1=i1+1
+ j1=j1+1
+ do j=1,ncont
+ if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)
+ & .and. dcont(j).le.rbeta .and.
+ & isec(i1,1).le.1.and.isec(j1,1).le.1.and.
+ & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and.
+ & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and.
+ & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and.
+ & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0)
+ & ) goto 5
+ enddo
+ not_done=.false.
+ 5 continue
+cd write (iout,*) i1,j1,dcont(j),not_done
+ enddo
+ j1=j1-1
+ i1=i1-1
+ if (i1-ii1.gt.1) then
+ ii1=max0(ii1-1,1)
+ jj1=max0(jj1-1,1)
+ nbeta=nbeta+1
+ if(lprint)write(iout,*)'parallel beta',nbeta,ii1,i1,jj1,j1
+ nbfrag=nbfrag+1
+ bfrag(1,nbfrag)=ii1
+ bfrag(2,nbfrag)=i1
+ bfrag(3,nbfrag)=jj1
+ bfrag(4,nbfrag)=j1
- if (bfrag(3,j).le.bfrag(4,j)) then
- do i=bfrag(3,j),bfrag(4,j)
- if(betasheet(i).eq.nbetasheet) then
- in=ibetasheet(i)
- do k=bfrag(3,j),bfrag(4,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=in
- enddo
- nbstrand=nbstrand+1
- usedbfrag(j)=.true.
- iused_nbfrag=iused_nbfrag+1
- do k=bfrag(1,j),bfrag(2,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=nbstrand
- enddo
- if (bstrand(in,4).lt.0) then
- bstrand(nbstrand,1)=bfrag(2,j)
- bstrand(nbstrand,2)=bfrag(1,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=-nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).lt.bfrag(4,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(4,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)+
- & (bstrand(in,5)-bfrag(4,j))
- endif
- if(bstrand(in,2).gt.bfrag(3,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(3,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)-
- & (-bstrand(in,6)+bfrag(3,j))
- endif
- else
- bstrand(nbstrand,1)=bfrag(1,j)
- bstrand(nbstrand,2)=bfrag(2,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).gt.bfrag(3,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(3,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)-
- & (-bstrand(in,5)+bfrag(3,j))
- endif
- if(bstrand(in,2).lt.bfrag(4,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(4,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)+
- & (bstrand(in,6)-bfrag(4,j))
- endif
- endif
- goto 11
- endif
- if(betasheet(bfrag(1,j)+i-bfrag(3,j)).eq.nbetasheet) then
- in=ibetasheet(bfrag(1,j)+i-bfrag(3,j))
- do k=bfrag(1,j),bfrag(2,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=in
- enddo
- nbstrand=nbstrand+1
- usedbfrag(j)=.true.
- iused_nbfrag=iused_nbfrag+1
- do k=bfrag(3,1),bfrag(4,1)
- betasheet(k)=nbetasheet
- ibetasheet(k)=nbstrand
- enddo
- if (bstrand(in,4).lt.0) then
- bstrand(nbstrand,1)=bfrag(4,j)
- bstrand(nbstrand,2)=bfrag(3,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=-nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).lt.bfrag(2,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(2,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)+
- & (bstrand(in,5)-bfrag(2,j))
- endif
- if(bstrand(in,2).gt.bfrag(1,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(1,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)-
- & (-bstrand(in,6)+bfrag(1,j))
- endif
- else
- bstrand(nbstrand,1)=bfrag(3,j)
- bstrand(nbstrand,2)=bfrag(4,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).gt.bfrag(1,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(1,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)-
- & (-bstrand(in,5)+bfrag(1,j))
- endif
- if(bstrand(in,2).lt.bfrag(2,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(2,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)+
- & (bstrand(in,6)-bfrag(2,j))
- endif
- endif
- goto 11
- endif
- enddo
- else
- do i=bfrag(4,j),bfrag(3,j)
- if(betasheet(i).eq.nbetasheet) then
- in=ibetasheet(i)
- do k=bfrag(4,j),bfrag(3,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=in
+ do ij=ii1,i1
+ isec(ij,1)=isec(ij,1)+1
+ isec(ij,1+isec(ij,1))=nbeta
enddo
- nbstrand=nbstrand+1
- usedbfrag(j)=.true.
- iused_nbfrag=iused_nbfrag+1
- do k=bfrag(1,j),bfrag(2,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=nbstrand
+ do ij=jj1,j1
+ isec(ij,1)=isec(ij,1)+1
+ isec(ij,1+isec(ij,1))=nbeta
enddo
- if (bstrand(in,4).lt.0) then
- bstrand(nbstrand,1)=bfrag(1,j)
- bstrand(nbstrand,2)=bfrag(2,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).lt.bfrag(3,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(3,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)-
- & (bstrand(in,5)-bfrag(3,j))
- endif
- if(bstrand(in,2).gt.bfrag(4,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(4,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)+
- & (-bstrand(in,6)+bfrag(4,j))
- endif
+
+ if(lprint) then
+ nstrand=nstrand+1
+ if (nbeta.le.9) then
+ write(12,'(a18,i1,a9,i3,a2,i3,a1)')
+ & "DefPropRes 'strand",nstrand,
+ & "' 'num = ",ii1-1,"..",i1-1,"'"
else
- bstrand(nbstrand,1)=bfrag(2,j)
- bstrand(nbstrand,2)=bfrag(1,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=-nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).gt.bfrag(4,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(4,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)+
- & (-bstrand(in,5)+bfrag(4,j))
- endif
- if(bstrand(in,2).lt.bfrag(3,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(3,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)-
- & (bstrand(in,6)-bfrag(3,j))
- endif
+ write(12,'(a18,i2,a9,i3,a2,i3,a1)')
+ & "DefPropRes 'strand",nstrand,
+ & "' 'num = ",ii1-1,"..",i1-1,"'"
endif
- goto 11
- endif
- if(betasheet(bfrag(2,j)-i+bfrag(4,j)).eq.nbetasheet) then
- in=ibetasheet(bfrag(2,j)-i+bfrag(4,j))
- do k=bfrag(1,j),bfrag(2,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=in
- enddo
- nbstrand=nbstrand+1
- usedbfrag(j)=.true.
- iused_nbfrag=iused_nbfrag+1
- do k=bfrag(4,j),bfrag(3,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=nbstrand
- enddo
- if (bstrand(in,4).lt.0) then
- bstrand(nbstrand,1)=bfrag(4,j)
- bstrand(nbstrand,2)=bfrag(3,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).lt.bfrag(2,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(2,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)-
- & (bstrand(in,5)-bfrag(2,j))
- endif
- if(bstrand(in,2).gt.bfrag(1,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(1,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)+
- & (-bstrand(in,6)+bfrag(1,j))
- endif
+ nstrand=nstrand+1
+ if (nbeta.le.9) then
+ write(12,'(a18,i1,a9,i3,a2,i3,a1)')
+ & "DefPropRes 'strand",nstrand,
+ & "' 'num = ",jj1-1,"..",j1-1,"'"
else
- bstrand(nbstrand,1)=bfrag(3,j)
- bstrand(nbstrand,2)=bfrag(4,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=-nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).gt.bfrag(1,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(1,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)+
- & (-bstrand(in,5)+bfrag(1,j))
- endif
- if(bstrand(in,2).lt.bfrag(2,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(2,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)-
- & (bstrand(in,6)-bfrag(2,j))
- endif
+ write(12,'(a18,i2,a9,i3,a2,i3,a1)')
+ & "DefPropRes 'strand",nstrand,
+ & "' 'num = ",jj1-1,"..",j1-1,"'"
endif
- goto 11
+ write(12,'(a8,4i4)')
+ & "SetNeigh",ii1-1,i1-1,jj1-1,j1-1
+ endif
endif
- enddo
endif
-
-
-
- ENDIF
- enddo
-
- j=2
- do while (usedbfrag(j))
- j=j+1
enddo
-
- nbstrand=nbstrand+1
- nbetasheet=nbetasheet+1
- bstrand(nbstrand,1)=bfrag(1,j)
- bstrand(nbstrand,2)=bfrag(2,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,5)=bfrag(1,j)
- bstrand(nbstrand,6)=bfrag(2,j)
-
- bstrand(nbstrand,4)=nbstrand
- do i=bfrag(1,j),bfrag(2,j)
- betasheet(i)=nbetasheet
- ibetasheet(i)=nbstrand
- enddo
-c
- nbstrand=nbstrand+1
- bstrand(nbstrand,1)=bfrag(3,j)
- bstrand(nbstrand,2)=bfrag(4,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,5)=bfrag(3,j)
- bstrand(nbstrand,6)=bfrag(4,j)
-
- if (bfrag(3,j).le.bfrag(4,j)) then
- bstrand(nbstrand,4)=nbstrand
- do i=bfrag(3,j),bfrag(4,j)
- betasheet(i)=nbetasheet
- ibetasheet(i)=nbstrand
- enddo
- else
- bstrand(nbstrand,4)=-nbstrand
- do i=bfrag(4,j),bfrag(3,j)
- betasheet(i)=nbetasheet
- ibetasheet(i)=nbstrand
- enddo
- endif
-
- iused_nbfrag=iused_nbfrag+1
- usedbfrag(j)=.true.
+c finding antiparallel beta
+cd write (iout,*) '--------- looking for antiparallel beta ---------'
- 11 continue
- do jk=6,1,-1
- write (*,'(i4,a3,10i4)') jk,'A',(bstrand(i,jk),i=1,nbstrand)
- enddo
-
-
- enddo
-
- do i=1,nres
- if (betasheet(i).ne.0) write(*,*) i,betasheet(i),ibetasheet(i)
- enddo
- write(*,*)
- do j=6,1,-1
- write (*,'(i4,a3,10i4)') j,':',(bstrand(i,j),i=1,nbstrand)
- enddo
-
-c------------------------
- nifb=0
- do i=1,nbstrand
- do j=i+1,nbstrand
- if(iabs(bstrand(i,5)-bstrand(j,5)).le.5 .or.
- & iabs(bstrand(i,6)-bstrand(j,6)).le.5 ) then
- nifb=nifb+1
- ifb(nifb,1)=bstrand(i,4)
- ifb(nifb,2)=bstrand(j,4)
- endif
- enddo
- enddo
-
- write(*,*)
- do i=1,nifb
- write (*,'(a3,20i4)') "ifb",i,ifb(i,1),ifb(i,2)
- enddo
-
- do i=1,nbstrand
- ifa(i)=bstrand(i,4)
- enddo
- write (*,'(a3,20i4)') "ifa",(ifa(i),i=1,nbstrand)
-
- nif=iabs(bstrand(1,6)-bstrand(1,5))+1
- do j=2,nbstrand
- if (iabs(bstrand(j,6)-bstrand(j,5))+1.gt.nif)
- & nif=iabs(bstrand(j,6)-bstrand(j,5))+1
- enddo
-
- write(*,*) nif
- do i=1,nif
- do j=1,nbstrand
- if(j,i)=bstrand(j,6)+(i-1)*sign(1,bstrand(j,5)-bstrand(j,6))
- if (if(j,i).gt.0) then
- if(betasheet(if(j,i)).eq.0 .or.
- & ibetasheet(if(j,i)).ne.iabs(bstrand(j,4))) if(j,i)=0
- else
- if(j,i)=0
- endif
- enddo
- write(*,'(a3,10i4)') 'if ',(if(j,i),j=1,nbstrand)
- enddo
-
-c read (inp,*) (ifa(i),i=1,4)
-c do i=1,nres
-c read (inp,*,err=20,end=20) (if(j,i),j=1,4)
-c enddo
-c 20 nif=i-1
- stop
-c------------------------
-
- isa=4
- is=2*isa-1
- iconf=0
-cccccccccccccccccccccccccccccccccc
- DO ig=1,is**isa-1
-cccccccccccccccccccccccccccccccccc
-
- ii=ig
- do j=1,is
- istrand(is-j+1)=int(ii/is**(is-j))
- ii=ii-istrand(is-j+1)*is**(is-j)
- enddo
- ltest=.true.
- do k=1,isa
- istrand(k)=istrand(k)+1
- if(istrand(k).gt.isa) istrand(k)=istrand(k)-2*isa-1
- enddo
- do k=1,isa
- do l=1,isa
- if(istrand(k).eq.istrand(l).and.k.ne.l.or.
- & istrand(k).eq.-istrand(l).and.k.ne.l) ltest=.false.
- enddo
- enddo
-
- lifb0=1
- do m=1,nifb
- lifb(m)=0
- do k=1,isa-1
- if(
- & ifb(m,1).eq.istrand(k).and.ifb(m,2).eq.istrand(k+1).or.
- & ifb(m,2).eq.istrand(k).and.ifb(m,1).eq.istrand(k+1).or.
- & -ifb(m,1).eq.istrand(k).and.-ifb(m,2).eq.istrand(k+1).or.
- & -ifb(m,2).eq.istrand(k).and.-ifb(m,1).eq.istrand(k+1))
- & lifb(m)=1
- enddo
- lifb0=lifb0*lifb(m)
- enddo
-
- if (mod(isa,2).eq.0) then
- do k=isa/2+1,isa
- if (istrand(k).eq.1) ltest=.false.
- enddo
- else
- do k=(isa+1)/2+1,isa
- if (istrand(k).eq.1) ltest=.false.
- enddo
- endif
-
- IF (ltest.and.lifb0.eq.1) THEN
- iconf=iconf+1
-
- call var_to_geom(nvar,vorg)
-
- write (*,'(i5,i10,10i3)') iconf,ig,(istrand(k),k=1,isa)
- write (iout,'(i5,i10,10i3)') iconf,ig,(istrand(k),k=1,isa)
- write (linia,'(10i3)') (istrand(k),k=1,isa)
-
- do i=1,nres
- do j=1,nres
- ibc(i,j)=0
- enddo
- enddo
-
-
- do i=1,4
- if ( sign(1,istrand(i)).eq.sign(1,ifa(iabs(istrand(i)))) ) then
- do j=1,nif
- itmp(iabs(istrand(i)),j)=if(iabs(ifa(iabs(istrand(i)))),j)
- enddo
- else
- do j=1,nif
- itmp(iabs(istrand(i)),j)=if(iabs(ifa(iabs(istrand(i)))),nif-j+1)
- enddo
- endif
- enddo
-
- do i=1,nif
- write(*,*) (itmp(j,i),j=1,4)
- enddo
-
- do i=1,nif
-c ifa(1),ifa(2),ifa(3),ifa(4)
-c if(1,i),if(2,i),if(3,i),if(4,i)
- do k=1,isa-1
- ltest=.false.
- do m=1,nifb
- if(
- & ifb(m,1).eq.istrand(k).and.ifb(m,2).eq.istrand(k+1).or.
- & ifb(m,2).eq.istrand(k).and.ifb(m,1).eq.istrand(k+1).or.
- & -ifb(m,1).eq.istrand(k).and.-ifb(m,2).eq.istrand(k+1).or.
- & -ifb(m,2).eq.istrand(k).and.-ifb(m,1).eq.istrand(k+1))
- & then
- ltest=.true.
- goto 110
- endif
- enddo
- 110 continue
- if (ltest) then
- ibc(itmp(iabs(istrand(k)),i),itmp(iabs(istrand(k+1)),i))=-1
- else
- ibc(itmp(iabs(istrand(k)),i),itmp(iabs(istrand(k+1)),i))=-2
- endif
-c
- if (k.lt.3)
- & ibc(itmp(iabs(istrand(k)),i),itmp(iabs(istrand(k+2)),i))=-3
- if (k.lt.2)
- & ibc(itmp(iabs(istrand(k)),i),itmp(iabs(istrand(k+3)),i))=-4
- enddo
- enddo
-c------------------------
-
-c
-c freeze sec.elements
-c
- do i=1,nres
- mask(i)=1
- mask_phi(i)=1
- mask_theta(i)=1
- mask_side(i)=1
- enddo
-
- do j=1,nbfrag
- do i=bfrag(1,j),bfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- if (bfrag(3,j).le.bfrag(4,j)) then
- do i=bfrag(3,j),bfrag(4,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- else
- do i=bfrag(4,j),bfrag(3,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- endif
- enddo
- do j=1,nhfrag
- do i=hfrag(1,j),hfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- enddo
- mask_r=.true.
-
-c------------------------
-c generate constrains
-c
- nhpb0=nhpb
- call chainbuild
- ind=0
- do i=1,nres-3
- do j=i+3,nres
- ind=ind+1
- if ( ibc(i,j).eq.-1 .or. ibc(j,i).eq.-1) then
- d0(ind)=DIST(i,j)
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(i,j).eq.-2 .or. ibc(j,i).eq.-2) then
- d0(ind)=5.0
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(i,j).eq.-3 .or. ibc(j,i).eq.-3) then
- d0(ind)=11.0
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(i,j).eq.-4 .or. ibc(j,i).eq.-4) then
- d0(ind)=16.0
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(i,j).gt.0 ) then
- d0(ind)=DIST(i,ibc(i,j))
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(j,i).gt.0 ) then
- d0(ind)=DIST(ibc(j,i),j)
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else
- w(ind)=0.0
- endif
- dd(ind)=d0(ind)
- enddo
- enddo
- call hpb_partition
-cd--------------------------
-
- write(iout,'(i3,2i4,a3,2i4,f7.2)') (i,ibc(ihpb(i),jhpb(i)),
- & ibc(jhpb(i),ihpb(i)),' --',
- & ihpb(i),jhpb(i),dhpb(i),i=1,nhpb)
-
-cd nhpb=0
-cd goto 901
-c
-c
- call contact_cp_min(varia,ifun,iconf,linia,debug)
- if (minim) then
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,varia,iretcode,nfun)
- write(iout,*)'------------------------------------------------'
- write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,
- & '+ DIST eval',ifun
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
-
- write (linia,'(a10,10i3)') 'full_min',(istrand(k),k=1,isa)
- call var_to_geom(nvar,varia)
- call chainbuild
- call write_pdb(900+iconf,linia,etot)
- endif
-
- call etotal(energy(0))
- etot=energy(0)
- call enerprint(energy(0))
-cd call intout
-cd call briefout(0,etot)
-cd call secondary2(.true.)
-
- 901 CONTINUE
-ctest return
-cccccccccccccccccccccccccccccccccccc
- ENDIF
- ENDDO
-cccccccccccccccccccccccccccccccccccc
-
- return
- 10 write (iout,'(a)') 'Error reading test structure.'
- return
- end
-c--------------------------------------------------------
-
- subroutine test3
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.CONTROL'
- include 'COMMON.SBRIDGE'
- include 'COMMON.FFIELD'
- include 'COMMON.MINIM'
-c
- include 'COMMON.DISTFIT'
- integer if(3,maxres),nif
- integer ibc(maxres,maxres),istrand(20)
- integer ibd(maxres),ifb(10,2),nifb,lifb(10),lifb0
- double precision time0,time1
- double precision energy(0:n_ene),ee
- double precision varia(maxvar)
-c
- logical debug,ltest
- character*50 linia
-c
- do i=1,nres
- read (inp,*,err=20,end=20) if(1,i),if(2,i),if(3,i)
- enddo
- 20 nif=i-1
- write (*,'(a4,3i5)') ('if =',if(1,i),if(2,i),if(3,i),
- & i=1,nif)
-
-
-c------------------------
- call secondary2(debug)
-c------------------------
- do i=1,nres
- do j=1,nres
- ibc(i,j)=0
- enddo
- enddo
-
-c
-c freeze sec.elements and store indexes for beta constrains
-c
- do i=1,nres
- mask(i)=1
- mask_phi(i)=1
- mask_theta(i)=1
- mask_side(i)=1
- enddo
-
- do j=1,nbfrag
- do i=bfrag(1,j),bfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- if (bfrag(3,j).le.bfrag(4,j)) then
- do i=bfrag(3,j),bfrag(4,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- ibc(bfrag(1,j)+i-bfrag(3,j),i)=-1
- enddo
- else
- do i=bfrag(4,j),bfrag(3,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- ibc(bfrag(2,j)-i+bfrag(4,j),i)=-1
- enddo
- endif
- enddo
- do j=1,nhfrag
- do i=hfrag(1,j),hfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- enddo
- mask_r=.true.
-
-
-c ---------------- test --------------
- do i=1,nif
- if (ibc(if(1,i),if(2,i)).eq.-1) then
- ibc(if(1,i),if(2,i))=if(3,i)
- ibc(if(1,i),if(3,i))=if(2,i)
- else if (ibc(if(2,i),if(1,i)).eq.-1) then
- ibc(if(2,i),if(1,i))=0
- ibc(if(1,i),if(2,i))=if(3,i)
- ibc(if(1,i),if(3,i))=if(2,i)
- else
- ibc(if(1,i),if(2,i))=if(3,i)
- ibc(if(1,i),if(3,i))=if(2,i)
- endif
- enddo
-
- do i=1,nres
- do j=1,nres
- if (ibc(i,j).ne.0) write(*,'(3i5)') i,j,ibc(i,j)
- enddo
- enddo
-c------------------------
- call chainbuild
- ind=0
- do i=1,nres-3
- do j=i+3,nres
- ind=ind+1
- if ( ibc(i,j).eq.-1 ) then
- d0(ind)=DIST(i,j)
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(i,j).gt.0 ) then
- d0(ind)=DIST(i,ibc(i,j))
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(j,i).gt.0 ) then
- d0(ind)=DIST(ibc(j,i),j)
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else
- w(ind)=0.0
- endif
- enddo
- enddo
- call hpb_partition
-
-cd--------------------------
- write(*,'(i3,2i4,a3,2i4,f7.2)') (i,ibc(ihpb(i),jhpb(i)),
- & ibc(jhpb(i),ihpb(i)),' --',
- & ihpb(i),jhpb(i),dhpb(i),i=1,nhpb)
-
-
- linia='dist'
- debug=.true.
- in_pdb=7
-c
- call contact_cp_min(varia,ieval,in_pdb,linia,debug)
- if (minim) then
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,varia,iretcode,nfun)
- write(iout,*)'------------------------------------------------'
- write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,
- & '+ DIST eval',ieval
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
-
-
- call var_to_geom(nvar,varia)
- call chainbuild
- call write_pdb(999,'full min',etot)
- endif
-
- call etotal(energy(0))
- etot=energy(0)
- call enerprint(energy(0))
- call intout
- call briefout(0,etot)
- call secondary2(.true.)
-
- return
- 10 write (iout,'(a)') 'Error reading test structure.'
- return
- end
-
-
-
-
- subroutine test__
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.CONTROL'
- include 'COMMON.SBRIDGE'
- include 'COMMON.FFIELD'
- include 'COMMON.MINIM'
-c
- include 'COMMON.DISTFIT'
- integer if(2,2),ind
- integer iff(maxres)
- double precision time0,time1
- double precision energy(0:n_ene),ee
- double precision theta2(maxres),phi2(maxres),alph2(maxres),
- & omeg2(maxres),
- & theta1(maxres),phi1(maxres),alph1(maxres),
- & omeg1(maxres)
- double precision varia(maxvar),varia2(maxvar)
-c
-
-
- read (inp,*,err=10,end=10) if(1,1),if(1,2),if(2,1),if(2,2)
- write (iout,'(a4,4i5)') 'if =',if(1,1),if(1,2),if(2,1),if(2,2)
- read (inp,*,err=10,end=10) (theta2(i),i=3,nres)
- read (inp,*,err=10,end=10) (phi2(i),i=4,nres)
- read (inp,*,err=10,end=10) (alph2(i),i=2,nres-1)
- read (inp,*,err=10,end=10) (omeg2(i),i=2,nres-1)
- do i=1,nres
- theta2(i)=deg2rad*theta2(i)
- phi2(i)=deg2rad*phi2(i)
- alph2(i)=deg2rad*alph2(i)
- omeg2(i)=deg2rad*omeg2(i)
- enddo
- do i=1,nres
- theta1(i)=theta(i)
- phi1(i)=phi(i)
- alph1(i)=alph(i)
- omeg1(i)=omeg(i)
- enddo
-
- do i=1,nres
- mask(i)=1
- enddo
-
-
-c------------------------
- do i=1,nres
- iff(i)=0
- enddo
- do j=1,2
- do i=if(j,1),if(j,2)
- iff(i)=1
- enddo
- enddo
-
- call chainbuild
- call geom_to_var(nvar,varia)
- call write_pdb(1,'first structure',0d0)
-
- call secondary(.true.)
-
- call secondary2(.true.)
-
- do j=1,nbfrag
- 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.3 ) then
- nn=nn+1
-
- if (bfrag(3,j).lt.bfrag(4,j)) then
- write(iout,'(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(iout,'(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
- endif
- enddo
-
- do i=1,nres
- theta(i)=theta2(i)
- phi(i)=phi2(i)
- alph(i)=alph2(i)
- omeg(i)=omeg2(i)
- enddo
-
- call chainbuild
- call geom_to_var(nvar,varia2)
- call write_pdb(2,'second structure',0d0)
-
-
-
-c-------------------------------------------------------
-
- ifun=-1
- call contact_cp(varia,varia2,iff,ifun,7)
- if (minim) then
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,varia,iretcode,nfun)
- write(iout,*)'------------------------------------------------'
- write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,
- & '+ DIST eval',ifun
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
-
-
- call var_to_geom(nvar,varia)
- call chainbuild
- call write_pdb(999,'full min',etot)
- endif
-
- call etotal(energy(0))
- etot=energy(0)
- call enerprint(energy(0))
- call intout
- call briefout(0,etot)
-
- return
- 10 write (iout,'(a)') 'Error reading test structure.'
- return
- end
-
-c-------------------------------------------------
-c-------------------------------------------------
-
- subroutine secondary(lprint)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
-
- integer ncont,icont(2,maxres*maxres/2),isec(maxres,3)
- logical lprint,not_done
- real dcont(maxres*maxres/2),d
- real rcomp /7.0/
- real rbeta /5.2/
- real ralfa /5.2/
- real r310 /6.6/
- double precision xpi(3),xpj(3)
-
-
-
- call chainbuild
-cd call write_pdb(99,'sec structure',0d0)
- ncont=0
- nbfrag=0
- nhfrag=0
- do i=1,nres
- isec(i,1)=0
- isec(i,2)=0
- isec(i,3)=0
- enddo
-
- do i=2,nres-3
- do k=1,3
- xpi(k)=0.5d0*(c(k,i-1)+c(k,i))
- enddo
- do j=i+2,nres
- do k=1,3
- xpj(k)=0.5d0*(c(k,j-1)+c(k,j))
- enddo
-cd d = (c(1,i)-c(1,j))*(c(1,i)-c(1,j)) +
-cd & (c(2,i)-c(2,j))*(c(2,i)-c(2,j)) +
-cd & (c(3,i)-c(3,j))*(c(3,i)-c(3,j))
-cd print *,'CA',i,j,d
- d = (xpi(1)-xpj(1))*(xpi(1)-xpj(1)) +
- & (xpi(2)-xpj(2))*(xpi(2)-xpj(2)) +
- & (xpi(3)-xpj(3))*(xpi(3)-xpj(3))
- if ( d.lt.rcomp*rcomp) then
- ncont=ncont+1
- icont(1,ncont)=i
- icont(2,ncont)=j
- dcont(ncont)=sqrt(d)
- endif
- enddo
- enddo
- if (lprint) then
- write (iout,*)
- write (iout,'(a)') '#PP contact map distances:'
- do i=1,ncont
- write (iout,'(3i4,f10.5)')
- & i,icont(1,i),icont(2,i),dcont(i)
- enddo
- endif
-
-c finding parallel beta
-cd write (iout,*) '------- looking for parallel beta -----------'
- nbeta=0
- nstrand=0
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if(dcont(i).le.rbeta .and. j1-i1.gt.4 .and.
- & isec(i1,1).le.1.and.isec(j1,1).le.1.and.
- & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and.
- & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and.
- & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and.
- & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0)
- & ) then
- ii1=i1
- jj1=j1
-cd write (iout,*) i1,j1,dcont(i)
- not_done=.true.
- do while (not_done)
- i1=i1+1
- j1=j1+1
- do j=1,ncont
- if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)
- & .and. dcont(j).le.rbeta .and.
- & isec(i1,1).le.1.and.isec(j1,1).le.1.and.
- & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and.
- & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and.
- & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and.
- & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0)
- & ) goto 5
- enddo
- not_done=.false.
- 5 continue
-cd write (iout,*) i1,j1,dcont(j),not_done
- enddo
- j1=j1-1
- i1=i1-1
- if (i1-ii1.gt.1) then
- ii1=max0(ii1-1,1)
- jj1=max0(jj1-1,1)
- nbeta=nbeta+1
- if(lprint)write(iout,*)'parallel beta',nbeta,ii1,i1,jj1,j1
-
- nbfrag=nbfrag+1
- bfrag(1,nbfrag)=ii1
- bfrag(2,nbfrag)=i1
- bfrag(3,nbfrag)=jj1
- bfrag(4,nbfrag)=j1
-
- do ij=ii1,i1
- isec(ij,1)=isec(ij,1)+1
- isec(ij,1+isec(ij,1))=nbeta
- enddo
- do ij=jj1,j1
- isec(ij,1)=isec(ij,1)+1
- isec(ij,1+isec(ij,1))=nbeta
- enddo
-
- if(lprint) then
- nstrand=nstrand+1
- if (nbeta.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",ii1-1,"..",i1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",ii1-1,"..",i1-1,"'"
- endif
- nstrand=nstrand+1
- if (nbeta.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",jj1-1,"..",j1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",jj1-1,"..",j1-1,"'"
- endif
- write(12,'(a8,4i4)')
- & "SetNeigh",ii1-1,i1-1,jj1-1,j1-1
- endif
- endif
- endif
- enddo
-
-c finding antiparallel beta
-cd write (iout,*) '--------- looking for antiparallel beta ---------'
-
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if (dcont(i).le.rbeta.and.
- & isec(i1,1).le.1.and.isec(j1,1).le.1.and.
- & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and.
- & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and.
- & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and.
- & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0)
- & ) then
- ii1=i1
- jj1=j1
-cd write (iout,*) i1,j1,dcont(i)
+ do i=1,ncont
+ i1=icont(1,i)
+ j1=icont(2,i)
+ if (dcont(i).le.rbeta.and.
+ & isec(i1,1).le.1.and.isec(j1,1).le.1.and.
+ & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and.
+ & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and.
+ & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and.
+ & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0)
+ & ) then
+ ii1=i1
+ jj1=j1
+cd write (iout,*) i1,j1,dcont(i)
not_done=.true.
do while (not_done)
cd write (iout,*) i1,j1,dcont(j),not_done
enddo
i1=i1-1
- j1=j1+1
- if (i1-ii1.gt.1) then
- if(lprint)write (iout,*)'antiparallel beta',
- & nbeta,ii1-1,i1,jj1,j1-1
-
- nbfrag=nbfrag+1
- bfrag(1,nbfrag)=max0(ii1-1,1)
- bfrag(2,nbfrag)=i1
- bfrag(3,nbfrag)=jj1
- bfrag(4,nbfrag)=max0(j1-1,1)
-
- nbeta=nbeta+1
- iii1=max0(ii1-1,1)
- do ij=iii1,i1
- isec(ij,1)=isec(ij,1)+1
- isec(ij,1+isec(ij,1))=nbeta
- enddo
- jjj1=max0(j1-1,1)
- do ij=jjj1,jj1
- isec(ij,1)=isec(ij,1)+1
- isec(ij,1+isec(ij,1))=nbeta
- enddo
-
-
- if (lprint) then
- nstrand=nstrand+1
- if (nstrand.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",ii1-2,"..",i1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",ii1-2,"..",i1-1,"'"
- endif
- nstrand=nstrand+1
- if (nstrand.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",j1-2,"..",jj1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",j1-2,"..",jj1-1,"'"
- endif
- write(12,'(a8,4i4)')
- & "SetNeigh",ii1-2,i1-1,jj1-1,j1-2
- endif
- endif
- endif
- enddo
-
- if (nstrand.gt.0.and.lprint) then
- write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1"
- do i=2,nstrand
- if (i.le.9) then
- write(12,'(a9,i1,$)') " | strand",i
- else
- write(12,'(a9,i2,$)') " | strand",i
- endif
- enddo
- write(12,'(a1)') "'"
- endif
-
-
-c finding alpha or 310 helix
-
- nhelix=0
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if (j1.eq.i1+3.and.dcont(i).le.r310
- & .or.j1.eq.i1+4.and.dcont(i).le.ralfa ) then
-cd if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,dcont(i)
-cd if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,dcont(i)
- ii1=i1
- jj1=j1
- if (isec(ii1,1).eq.0) then
- not_done=.true.
- else
- not_done=.false.
- endif
- do while (not_done)
- i1=i1+1
- j1=j1+1
- do j=1,ncont
- if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10
- enddo
- not_done=.false.
- 10 continue
-cd write (iout,*) i1,j1,not_done
- enddo
- j1=j1-1
- if (j1-ii1.gt.4) then
- nhelix=nhelix+1
-cd write (iout,*)'helix',nhelix,ii1,j1
-
- nhfrag=nhfrag+1
- hfrag(1,nhfrag)=ii1
- hfrag(2,nhfrag)=max0(j1-1,1)
-
- do ij=ii1,j1
- isec(ij,1)=-1
- enddo
- if (lprint) then
- write (iout,'(a6,i3,2i4)') "Helix",nhelix,ii1-1,j1-2
- if (nhelix.le.9) then
- write(12,'(a17,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'helix",nhelix,
- & "' 'num = ",ii1-1,"..",j1-2,"'"
- else
- write(12,'(a17,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'helix",nhelix,
- & "' 'num = ",ii1-1,"..",j1-2,"'"
- endif
- endif
- endif
- endif
- enddo
-
- if (nhelix.gt.0.and.lprint) then
- write(12,'(a26,$)') "DefPropRes 'helix' 'helix1"
- do i=2,nhelix
- if (nhelix.le.9) then
- write(12,'(a8,i1,$)') " | helix",i
- else
- write(12,'(a8,i2,$)') " | helix",i
- endif
- enddo
- write(12,'(a1)') "'"
- endif
-
- if (lprint) then
- write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'"
- write(12,'(a20)') "XMacStand ribbon.mac"
- endif
-
-
- return
- end
-c----------------------------------------------------------------------------
-
- subroutine write_pdb(npdb,titelloc,ee)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- character*50 titelloc1
- character*(*) titelloc
- character*3 zahl
- character*5 liczba5
- double precision ee
- integer npdb,ilen
- external ilen
-
- titelloc1=titelloc
- lenpre=ilen(prefix)
- if (npdb.lt.1000) then
- call numstr(npdb,zahl)
- open(ipdb,file=prefix(:lenpre)//'@@'//zahl//'.pdb')
- else
- if (npdb.lt.10000) then
- write(liczba5,'(i1,i4)') 0,npdb
- else
- write(liczba5,'(i5)') npdb
- endif
- open(ipdb,file=prefix(:lenpre)//'@@'//liczba5//'.pdb')
- endif
- call pdbout(ee,titelloc1,ipdb)
- close(ipdb)
- return
- end
-
-c-----------------------------------------------------------
- subroutine contact_cp2(var,var2,iff,ieval,in_pdb)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SBRIDGE'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.MINIM'
-
- character*50 linia
- integer nf,ij(4)
- double precision var(maxvar),var2(maxvar)
- double precision time0,time1
- integer iff(maxres),ieval
- double precision theta1(maxres),phi1(maxres),alph1(maxres),
- & omeg1(maxres)
-
-
- call var_to_geom(nvar,var)
- call chainbuild
- nhpb0=nhpb
- ind=0
- do i=1,nres-3
- do j=i+3,nres
- ind=ind+1
- if ( iff(i).eq.1.and.iff(j).eq.1 ) then
- d0(ind)=DIST(i,j)
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else
- w(ind)=0.0
- endif
- enddo
- enddo
- call hpb_partition
-
- do i=1,nres
- theta1(i)=theta(i)
- phi1(i)=phi(i)
- alph1(i)=alph(i)
- omeg1(i)=omeg(i)
- enddo
-
- call var_to_geom(nvar,var2)
-
- do i=1,nres
- if ( iff(i).eq.1 ) then
- theta(i)=theta1(i)
- phi(i)=phi1(i)
- alph(i)=alph1(i)
- omeg(i)=omeg1(i)
- endif
- enddo
-
- call chainbuild
-cd call write_pdb(3,'combined structure',0d0)
-cd time0=MPI_WTIME()
-
- NX=NRES-3
- NY=((NRES-4)*(NRES-5))/2
- call distfit(.true.,200)
-
-cd time1=MPI_WTIME()
-cd write (iout,'(a,f6.2,a)') ' Time for distfit ',time1-time0,' sec'
-
- ipot0=ipot
- maxmin0=maxmin
- maxfun0=maxfun
- wstrain0=wstrain
+ j1=j1+1
+ if (i1-ii1.gt.1) then
+ if(lprint)write (iout,*)'antiparallel beta',
+ & nbeta,ii1-1,i1,jj1,j1-1
- ipot=6
- maxmin=2000
- maxfun=5000
- call geom_to_var(nvar,var)
-cd time0=MPI_WTIME()
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun
+ nbfrag=nbfrag+1
+ bfrag(1,nbfrag)=max0(ii1-1,1)
+ bfrag(2,nbfrag)=i1
+ bfrag(3,nbfrag)=jj1
+ bfrag(4,nbfrag)=max0(j1-1,1)
-cd time1=MPI_WTIME()
-cd write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0,
-cd & nfun/(time1-time0),' SOFT eval/s'
- call var_to_geom(nvar,var)
- call chainbuild
+ nbeta=nbeta+1
+ iii1=max0(ii1-1,1)
+ do ij=iii1,i1
+ isec(ij,1)=isec(ij,1)+1
+ isec(ij,1+isec(ij,1))=nbeta
+ enddo
+ jjj1=max0(j1-1,1)
+ do ij=jjj1,jj1
+ isec(ij,1)=isec(ij,1)+1
+ isec(ij,1+isec(ij,1))=nbeta
+ enddo
- iwsk=0
- nf=0
- if (iff(1).eq.1) then
- iwsk=1
- nf=nf+1
- ij(nf)=0
- endif
- do i=2,nres
- if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then
- iwsk=1
- nf=nf+1
- ij(nf)=i
- endif
- if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then
- iwsk=0
- nf=nf+1
- ij(nf)=i-1
+ if (lprint) then
+ nstrand=nstrand+1
+ if (nstrand.le.9) then
+ write(12,'(a18,i1,a9,i3,a2,i3,a1)')
+ & "DefPropRes 'strand",nstrand,
+ & "' 'num = ",ii1-2,"..",i1-1,"'"
+ else
+ write(12,'(a18,i2,a9,i3,a2,i3,a1)')
+ & "DefPropRes 'strand",nstrand,
+ & "' 'num = ",ii1-2,"..",i1-1,"'"
+ endif
+ nstrand=nstrand+1
+ if (nstrand.le.9) then
+ write(12,'(a18,i1,a9,i3,a2,i3,a1)')
+ & "DefPropRes 'strand",nstrand,
+ & "' 'num = ",j1-2,"..",jj1-1,"'"
+ else
+ write(12,'(a18,i2,a9,i3,a2,i3,a1)')
+ & "DefPropRes 'strand",nstrand,
+ & "' 'num = ",j1-2,"..",jj1-1,"'"
+ endif
+ write(12,'(a8,4i4)')
+ & "SetNeigh",ii1-2,i1-1,jj1-1,j1-2
endif
- enddo
- if (iff(nres).eq.1) then
- nf=nf+1
- ij(nf)=nres
+ endif
endif
-
-
-cd write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)')
-cd & "select",ij(1),"-",ij(2),
-cd & ",",ij(3),"-",ij(4)
-cd call write_pdb(in_pdb,linia,etot)
-
-
- ipot=ipot0
- maxmin=maxmin0
- maxfun=maxfun0
-cd time0=MPI_WTIME()
- call minimize(etot,var,iretcode,nfun)
-cd write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun
- ieval=nfun
-
-cd time1=MPI_WTIME()
-cd write (iout,'(a,f6.2,f8.2,a)')' Time for DIST min.',time1-time0,
-cd & nfun/(time1-time0),' eval/s'
-cd call var_to_geom(nvar,var)
-cd call chainbuild
-cd call write_pdb(6,'dist structure',etot)
-
-
- nhpb= nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
-
- return
- end
-c-----------------------------------------------------------
- subroutine contact_cp(var,var2,iff,ieval,in_pdb)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.SBRIDGE'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.MINIM'
-
- character*50 linia
- integer nf,ij(4)
- double precision energy(0:n_ene)
- double precision var(maxvar),var2(maxvar)
- double precision time0,time1
- integer iff(maxres),ieval
- double precision theta1(maxres),phi1(maxres),alph1(maxres),
- & omeg1(maxres)
- logical debug
-
- debug=.false.
-c debug=.true.
- if (ieval.eq.-1) debug=.true.
-
-
-c
-c store selected dist. constrains from 1st structure
-c
-#ifdef OSF
-c Intercept NaNs in the coordinates
-c write(iout,*) (var(i),i=1,nvar)
- x_sum=0.D0
- do i=1,nvar
- x_sum=x_sum+var(i)
enddo
- if (x_sum.ne.x_sum) then
- write(iout,*)" *** contact_cp : Found NaN in coordinates"
- call flush(iout)
- print *," *** contact_cp : Found NaN in coordinates"
- return
- endif
-#endif
-
-
- call var_to_geom(nvar,var)
- call chainbuild
- nhpb0=nhpb
- ind=0
- do i=1,nres-3
- do j=i+3,nres
- ind=ind+1
- if ( iff(i).eq.1.and.iff(j).eq.1 ) then
- d0(ind)=DIST(i,j)
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else
- w(ind)=0.0
- endif
- enddo
- enddo
- call hpb_partition
-
- do i=1,nres
- theta1(i)=theta(i)
- phi1(i)=phi(i)
- alph1(i)=alph(i)
- omeg1(i)=omeg(i)
- enddo
-
-c
-c freeze sec.elements from 2nd structure
-c
- do i=1,nres
- mask_phi(i)=1
- mask_theta(i)=1
- mask_side(i)=1
- enddo
-
- call var_to_geom(nvar,var2)
- call secondary2(debug)
- do j=1,nbfrag
- do i=bfrag(1,j),bfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- if (bfrag(3,j).le.bfrag(4,j)) then
- do i=bfrag(3,j),bfrag(4,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- else
- do i=bfrag(4,j),bfrag(3,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- endif
- enddo
- do j=1,nhfrag
- do i=hfrag(1,j),hfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- enddo
- mask_r=.true.
-
-c
-c copy selected res from 1st to 2nd structure
-c
-
- do i=1,nres
- if ( iff(i).eq.1 ) then
- theta(i)=theta1(i)
- phi(i)=phi1(i)
- alph(i)=alph1(i)
- omeg(i)=omeg1(i)
- endif
- enddo
- if(debug) then
-c
-c prepare description in linia variable
-c
- iwsk=0
- nf=0
- if (iff(1).eq.1) then
- iwsk=1
- nf=nf+1
- ij(nf)=1
- endif
- do i=2,nres
- if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then
- iwsk=1
- nf=nf+1
- ij(nf)=i
- endif
- if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then
- iwsk=0
- nf=nf+1
- ij(nf)=i-1
- endif
+ if (nstrand.gt.0.and.lprint) then
+ write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1"
+ do i=2,nstrand
+ if (i.le.9) then
+ write(12,'(a9,i1,$)') " | strand",i
+ else
+ write(12,'(a9,i2,$)') " | strand",i
+ endif
enddo
- if (iff(nres).eq.1) then
- nf=nf+1
- ij(nf)=nres
- endif
-
- write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)')
- & "SELECT",ij(1)-1,"-",ij(2)-1,
- & ",",ij(3)-1,"-",ij(4)-1
-
+ write(12,'(a1)') "'"
endif
-c
-c run optimization
-c
- call contact_cp_min(var,ieval,in_pdb,linia,debug)
- return
- end
-
- subroutine contact_cp_min(var,ieval,in_pdb,linia,debug)
-c
-c input : theta,phi,alph,omeg,in_pdb,linia,debug
-c output : var,ieval
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SBRIDGE'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.MINIM'
-
- character*50 linia
- integer nf,ij(4)
- double precision energy(0:n_ene)
- double precision var(maxvar)
- double precision time0,time1
- integer ieval,info(3)
- logical debug,fail,check_var,reduce,change
-
- write(iout,'(a20,i6,a20)')
- & '------------------',in_pdb,'-------------------'
-
- if (debug) then
- call chainbuild
- call write_pdb(1000+in_pdb,'combined structure',0d0)
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- endif
-c
-c run optimization of distances
-c
-c uses d0(),w() and mask() for frozen 2D
-c
-ctest---------------------------------------------
-ctest NX=NRES-3
-ctest NY=((NRES-4)*(NRES-5))/2
-ctest call distfit(debug,5000)
-
- do i=1,nres
- mask_side(i)=0
- enddo
-
- ipot01=ipot
- maxmin01=maxmin
- maxfun01=maxfun
-c wstrain01=wstrain
- wsc01=wsc
- wscp01=wscp
- welec01=welec
- wvdwpp01=wvdwpp
-c wang01=wang
- wscloc01=wscloc
- wtor01=wtor
- wtor_d01=wtor_d
-
- ipot=6
- maxmin=2000
- maxfun=4000
-c wstrain=1.0
- wsc=0.0
- wscp=0.0
- welec=0.0
- wvdwpp=0.0
-c wang=0.0
- wscloc=0.0
- wtor=0.0
- wtor_d=0.0
-
- call geom_to_var(nvar,var)
-cde change=reduce(var)
- if (check_var(var,info)) then
- write(iout,*) 'cp_min error in input'
- print *,'cp_min error in input'
- return
- endif
-
-cd call etotal(energy(0))
-cd call enerprint(energy(0))
-cd call check_eint
-
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
-cdtest call minimize(etot,var,iretcode,nfun)
-cdtest write(iout,*)'SUMSL return code is',iretcode,' eval SDIST',nfun
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
-cd call etotal(energy(0))
-cd call enerprint(energy(0))
-cd call check_eint
-
- do i=1,nres
- mask_side(i)=1
- enddo
-
- ipot=ipot01
- maxmin=maxmin01
- maxfun=maxfun01
-c wstrain=wstrain01
- wsc=wsc01
- wscp=wscp01
- welec=welec01
- wvdwpp=wvdwpp01
-c wang=wang01
- wscloc=wscloc01
- wtor=wtor01
- wtor_d=wtor_d01
-ctest--------------------------------------------------
-
- if(debug) then
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,a)')' Time for distfit ',time1-time0,' sec'
- call write_pdb(2000+in_pdb,'distfit structure',0d0)
- endif
-
+c finding alpha or 310 helix
- ipot0=ipot
- maxmin0=maxmin
- maxfun0=maxfun
- wstrain0=wstrain
-c
-c run soft pot. optimization
-c with constrains:
-c nhpb,ihpb(),jhpb(),forcon(),dhpb() and hpb_partition
-c and frozen 2D:
-c mask_phi(),mask_theta(),mask_side(),mask_r
-c
- ipot=6
- maxmin=2000
- maxfun=4000
+ nhelix=0
+ do i=1,ncont
+ i1=icont(1,i)
+ j1=icont(2,i)
+ if (j1.eq.i1+3.and.dcont(i).le.r310
+ & .or.j1.eq.i1+4.and.dcont(i).le.ralfa ) then
+cd if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,dcont(i)
+cd if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,dcont(i)
+ ii1=i1
+ jj1=j1
+ if (isec(ii1,1).eq.0) then
+ not_done=.true.
+ else
+ not_done=.false.
+ endif
+ do while (not_done)
+ i1=i1+1
+ j1=j1+1
+ do j=1,ncont
+ if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10
+ enddo
+ not_done=.false.
+ 10 continue
+cd write (iout,*) i1,j1,not_done
+ enddo
+ j1=j1-1
+ if (j1-ii1.gt.4) then
+ nhelix=nhelix+1
+cd write (iout,*)'helix',nhelix,ii1,j1
-cde change=reduce(var)
-cde if (check_var(var,info)) write(iout,*) 'error before soft'
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,var,iretcode,nfun)
+ nhfrag=nhfrag+1
+ hfrag(1,nhfrag)=ii1
+ hfrag(2,nhfrag)=max0(j1-1,1)
- write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0,
- & nfun/(time1-time0),' SOFT eval/s'
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(3000+in_pdb,'soft structure',etot)
- endif
-c
-c run full UNRES optimization with constrains and frozen 2D
-c the same variables as soft pot. optimizatio
-c
- ipot=ipot0
- maxmin=maxmin0
- maxfun=maxfun0
-c
-c check overlaps before calling full UNRES minim
-c
- call var_to_geom(nvar,var)
- call chainbuild
- call etotal(energy(0))
-#ifdef OSF
- write(iout,*) 'N7 ',energy(0)
- if (energy(0).ne.energy(0)) then
- write(iout,*) 'N7 error - gives NaN',energy(0)
- endif
-#endif
- ieval=1
- if (energy(1).eq.1.0d20) then
- write (iout,'(a,1pe14.5)')'#N7_OVERLAP evdw=1d20',energy(1)
- call overlap_sc(fail)
- if(.not.fail) then
- call etotal(energy(0))
- ieval=ieval+1
- write (iout,'(a,1pe14.5)')'#N7_OVERLAP evdw after',energy(1)
+ do ij=ii1,j1
+ isec(ij,1)=-1
+ enddo
+ if (lprint) then
+ write (iout,'(a6,i3,2i4)') "Helix",nhelix,ii1-1,j1-2
+ if (nhelix.le.9) then
+ write(12,'(a17,i1,a9,i3,a2,i3,a1)')
+ & "DefPropRes 'helix",nhelix,
+ & "' 'num = ",ii1-1,"..",j1-2,"'"
+ else
+ write(12,'(a17,i2,a9,i3,a2,i3,a1)')
+ & "DefPropRes 'helix",nhelix,
+ & "' 'num = ",ii1-1,"..",j1-2,"'"
+ endif
+ endif
+ endif
+ endif
+ enddo
+
+ if (nhelix.gt.0.and.lprint) then
+ write(12,'(a26,$)') "DefPropRes 'helix' 'helix1"
+ do i=2,nhelix
+ if (nhelix.le.9) then
+ write(12,'(a8,i1,$)') " | helix",i
else
- mask_r=.false.
- nhpb= nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
- return
+ write(12,'(a8,i2,$)') " | helix",i
endif
- endif
- call flush(iout)
-c
-cdte time0=MPI_WTIME()
-cde change=reduce(var)
-cde if (check_var(var,info)) then
-cde write(iout,*) 'error before mask dist'
-cde call var_to_geom(nvar,var)
-cde call chainbuild
-cde call write_pdb(10000+in_pdb,'before mask dist',etot)
-cde endif
-cdte call minimize(etot,var,iretcode,nfun)
-cdte write(iout,*)'SUMSL MASK DIST return code is',iretcode,
-cdte & ' eval ',nfun
-cdte ieval=ieval+nfun
-cdte
-cdte time1=MPI_WTIME()
-cdte write (iout,'(a,f6.2,f8.2,a)')
-cdte & ' Time for mask dist min.',time1-time0,
-cdte & nfun/(time1-time0),' eval/s'
-cdte call flush(iout)
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(4000+in_pdb,'mask dist',etot)
- endif
-c
-c switch off freezing of 2D and
-c run full UNRES optimization with constrains
-c
- mask_r=.false.
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
-cde change=reduce(var)
-cde if (check_var(var,info)) then
-cde write(iout,*) 'error before dist'
-cde call var_to_geom(nvar,var)
-cde call chainbuild
-cde call write_pdb(11000+in_pdb,'before dist',etot)
-cde endif
+ enddo
+ write(12,'(a1)') "'"
+ endif
- call minimize(etot,var,iretcode,nfun)
+ if (lprint) then
+ write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'"
+ write(12,'(a20)') "XMacStand ribbon.mac"
+ endif
-cde change=reduce(var)
-cde if (check_var(var,info)) then
-cde write(iout,*) 'error after dist',ico
-cde call var_to_geom(nvar,var)
-cde call chainbuild
-cde call write_pdb(12000+in_pdb+ico*1000,'after dist',etot)
-cde endif
- write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun
- ieval=ieval+nfun
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for dist min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
-cde call etotal(energy(0))
-cde write(iout,*) 'N7 after dist',energy(0)
- call flush(iout)
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(in_pdb,linia,etot)
- endif
-c
-c reset constrains
-c
- nhpb= nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
+ return
+ end
+c----------------------------------------------------------------------------
+
+ subroutine write_pdb(npdb,titelloc,ee)
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.IOUNITS'
+ character*50 titelloc1
+ character*(*) titelloc
+ character*3 zahl
+ character*5 liczba5
+ double precision ee
+ integer npdb,ilen
+ external ilen
+
+ titelloc1=titelloc
+ lenpre=ilen(prefix)
+ if (npdb.lt.1000) then
+ call numstr(npdb,zahl)
+ open(ipdb,file=prefix(:lenpre)//'@@'//zahl//'.pdb')
+ else
+ if (npdb.lt.10000) then
+ write(liczba5,'(i1,i4)') 0,npdb
+ else
+ write(liczba5,'(i5)') npdb
+ endif
+ open(ipdb,file=prefix(:lenpre)//'@@'//liczba5//'.pdb')
+ endif
+ call pdbout(ee,titelloc1,ipdb)
+ close(ipdb)
+ return
+ end
- return
- end
c--------------------------------------------------------
subroutine softreg
implicit real*8 (a-h,o-z)
end
- subroutine beta_slide(i1,i2,i3,i4,i5,ieval,ij)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CONTROL'
- include 'COMMON.FFIELD'
- include 'COMMON.MINIM'
- include 'COMMON.CHAIN'
- double precision time0,time1
- double precision energy(0:n_ene),ee
- double precision var(maxvar)
- integer jdata(5),isec(maxres)
-c
- jdata(1)=i1
- jdata(2)=i2
- jdata(3)=i3
- jdata(4)=i4
- jdata(5)=i5
-
- call secondary2(.false.)
-
- do i=1,nres
- isec(i)=0
- enddo
- do j=1,nbfrag
- 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
- enddo
- do j=1,nhfrag
- do i=hfrag(1,j),hfrag(2,j)
- isec(i)=2
- enddo
- enddo
-
-c
-c cut strands at the ends
-c
- if (jdata(2)-jdata(1).gt.3) then
- jdata(1)=jdata(1)+1
- jdata(2)=jdata(2)-1
- if (jdata(3).lt.jdata(4)) then
- jdata(3)=jdata(3)+1
- jdata(4)=jdata(4)-1
- else
- jdata(3)=jdata(3)-1
- jdata(4)=jdata(4)+1
- endif
- endif
-
-cv call chainbuild
-cv call etotal(energy(0))
-cv etot=energy(0)
-cv write(iout,*) nnt,nct,etot
-cv call write_pdb(ij*100,'first structure',etot)
-cv write(iout,*) 'N16 test',(jdata(i),i=1,5)
-
-c------------------------
-c generate constrains
-c
- ishift=jdata(5)-2
- if(ishift.eq.0) ishift=-2
- nhpb0=nhpb
- call chainbuild
- do i=jdata(1),jdata(2)
- isec(i)=-1
- if(jdata(4).gt.jdata(3))then
- do j=jdata(3)+i-jdata(1)-2,jdata(3)+i-jdata(1)+2
- isec(j)=-1
-cd print *,i,j,j+ishift
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=1000.0
- dhpb(nhpb)=DIST(i,j+ishift)
- enddo
- else
- do j=jdata(3)-i+jdata(1)+2,jdata(3)-i+jdata(1)-2,-1
- isec(j)=-1
-cd print *,i,j,j+ishift
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=1000.0
- dhpb(nhpb)=DIST(i,j+ishift)
- enddo
- endif
- enddo
-
- do i=nnt,nct-2
- do j=i+2,nct
- if(isec(i).gt.0.or.isec(j).gt.0) then
-cd print *,i,j
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=0.1
- dhpb(nhpb)=DIST(i,j)
- endif
- enddo
- enddo
-
- call hpb_partition
-
- call geom_to_var(nvar,var)
- maxfun0=maxfun
- wstrain0=wstrain
- maxfun=4000/5
-
- do ico=1,5
-
- wstrain=wstrain0/ico
-
-cv time0=MPI_WTIME()
- call minimize(etot,var,iretcode,nfun)
- write(iout,'(a10,f6.3,a14,i3,a6,i5)')
- & ' SUMSL DIST',wstrain,' return code is',iretcode,
- & ' eval ',nfun
- ieval=ieval+nfun
-cv time1=MPI_WTIME()
-cv write (iout,'(a,f6.2,f8.2,a)')
-cv & ' Time for dist min.',time1-time0,
-cv & nfun/(time1-time0),' eval/s'
-cv call var_to_geom(nvar,var)
-cv call chainbuild
-cv call write_pdb(ij*100+ico,'dist cons',etot)
-
- enddo
-c
- nhpb=nhpb0
- call hpb_partition
- wstrain=wstrain0
- maxfun=maxfun0
-c
-cd print *,etot
- wscloc0=wscloc
- wscloc=10.0
- call sc_move(nnt,nct,100,100d0,nft_sc,etot)
- wscloc=wscloc0
-cv call chainbuild
-cv call etotal(energy(0))
-cv etot=energy(0)
-cv call write_pdb(ij*100+10,'sc_move',etot)
-cd call intout
-cd print *,nft_sc,etot
-
- return
- end
-
- subroutine beta_zip(i1,i2,ieval,ij)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CONTROL'
- include 'COMMON.FFIELD'
- include 'COMMON.MINIM'
- include 'COMMON.CHAIN'
- double precision time0,time1
- double precision energy(0:n_ene),ee
- double precision var(maxvar)
- character*10 test
-
-cv call chainbuild
-cv call etotal(energy(0))
-cv etot=energy(0)
-cv write(test,'(2i5)') i1,i2
-cv call write_pdb(ij*100,test,etot)
-cv write(iout,*) 'N17 test',i1,i2,etot,ij
-
-c
-c generate constrains
-c
- nhpb0=nhpb
- nhpb=nhpb+1
- ihpb(nhpb)=i1
- jhpb(nhpb)=i2
- forcon(nhpb)=1000.0
- dhpb(nhpb)=4.0
-
- call hpb_partition
-
- call geom_to_var(nvar,var)
- maxfun0=maxfun
- wstrain0=wstrain
- maxfun=1000/5
-
- do ico=1,5
- wstrain=wstrain0/ico
-cv time0=MPI_WTIME()
- call minimize(etot,var,iretcode,nfun)
- write(iout,'(a10,f6.3,a14,i3,a6,i5)')
- & ' SUMSL DIST',wstrain,' return code is',iretcode,
- & ' eval ',nfun
- ieval=ieval+nfun
-cv time1=MPI_WTIME()
-cv write (iout,'(a,f6.2,f8.2,a)')
-cv & ' Time for dist min.',time1-time0,
-cv & nfun/(time1-time0),' eval/s'
-c do not comment the next line
- call var_to_geom(nvar,var)
-cv call chainbuild
-cv call write_pdb(ij*100+ico,'dist cons',etot)
- enddo
-
- nhpb=nhpb0
- call hpb_partition
- wstrain=wstrain0
- maxfun=maxfun0
-
-cv call etotal(energy(0))
-cv etot=energy(0)
-cv write(iout,*) 'N17 test end',i1,i2,etot,ij
-
-
- return
- end
+++ /dev/null
-#ifdef MPI
- Subroutine together
-c feeds tasks for parallel processing
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- real ran1,ran2
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.TIME1'
- include 'COMMON.SETUP'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.CONTROL'
- include 'COMMON.SBRIDGE'
- real tcpu
- double precision time_start,time_start_c,time0f,time0i
- logical ovrtim,sync_iter,timeout,flag,timeout1
- dimension muster(mpi_status_size)
- dimension t100(0:100),indx(mxio)
- dimension xout(maxvar),eout(mxch*(mxch+1)/2+1),ind(9)
- dimension cout(2)
- parameter (rad=1.745329252d-2)
-
-cccccccccccccccccccccccccccccccccccccccccccccccc
- IF (ME.EQ.KING) THEN
-
- time0f=MPI_WTIME()
- ilastnstep=1
- sync_iter=.false.
- numch=1
- nrmsdb=0
- nrmsdb1=0
- rmsdbc1c=rmsdbc1
- nstep=0
- call csa_read
- call make_array
-
- if(iref.ne.0) call from_int(1,0,idum)
-
-c To minimize input conformation (bank conformation)
-c Output to $mol.reminimized
- if (irestart.lt.0) then
- call read_bank(0,nft,cutdifr)
- if (irestart.lt.-10) then
- p_cut=nres*4.d0
- call prune_bank(p_cut)
- return
- endif
- call reminimize(jlee)
- return
- endif
-
- if (irestart.eq.0) then
- call initial_write
- nbank=nconf
- ntbank=nconf
- if (ntbankm.eq.0) ntbank=0
- nstep=0
- nft=0
- do i=1,mxio
- ibank(i)=0
- jbank(i)=0
- enddo
- else
- call restart_write
-c!bankt call read_bankt(jlee,nft,cutdifr)
- call read_bank(jlee,nft,cutdifr)
- call read_rbank(jlee,adif)
- if(iref.ne.0) call from_int(1,0,idum)
- endif
-
- nstmax=nstmax+nstep
- ntrial=n1+n2+n3+n4+n5+n6+n7+n8
- ntry=ntrial+1
- ntry=ntry*nseed
-
-c ntrial : number of trial conformations per seed.
-c ntry : total number of trial conformations including seed conformations.
-
- idum2=-123
- imax=2**31-1
- ENDIF
-
- call mpi_bcast(jend,1,mpi_integer,0,CG_COMM,ierr)
-cccccccccccccccccccccccccccccccccccccccc
- do 300 jlee=1,jend
-cccccccccccccccccccccccccccccccccccccccc
- 331 continue
- IF (ME.EQ.KING) THEN
- if(sync_iter) goto 333
- idum=- ran2(idum2)*imax
- if(jlee.lt.jstart) goto 300
-
-C Restart the random number generator for conformation generation
-
- if(irestart.gt.0) then
- idum2=idum2+nstep
- if(idum2.le.0) idum2=-idum2+1
- idum=- ran2(idum2)*imax
- endif
-
- idumm=idum
- call vrndst(idumm)
-
- open(icsa_seed,file=csa_seed,status="old")
- write(icsa_seed,*) "jlee : ",jlee
- close(icsa_seed)
-
- call history_append
- write(icsa_history,*) "number of procs is ",nodes
- write(icsa_history,*) jlee,idum,idum2
- close(icsa_history)
-
-cccccccccccccccccccccccccccccccccccccccccccccccc
- 333 icycle=0
-
- call history_append
- write(icsa_history,*) "nbank is ",nbank
- close(icsa_history)
-
- if(irestart.eq.1) goto 111
- if(irestart.eq.2) then
- icycle=0
- do i=1,nbank
- ibank(i)=1
- enddo
- do i=nbank+1,nbank+nconf
- ibank(i)=0
- enddo
- endif
-
-c start energy minimization
- nconfr=max0(nconf+nadd,nodes-1)
- if (sync_iter) nconf_in=0
-c king-emperor - feed input and sort output
- write (iout,*) "NCONF_IN",nconf_in
- m=0
- if (nconf_in.gt.0) then
-c al 7/2/00 - added possibility to read in some of the initial conformations
- do m=1,nconf_in
- read (intin,'(i5)',end=11,err=12) iconf
- 12 continue
- write (iout,*) "write READ_ANGLES",iconf,m
- call read_angles(intin,*11)
- if (iref.eq.0) then
- mm=m
- else
- mm=m+1
- endif
- do j=2,nres-1
- dihang_in(1,j,1,mm)=theta(j+1)
- dihang_in(2,j,1,mm)=phi(j+2)
- dihang_in(3,j,1,mm)=alph(j)
- dihang_in(4,j,1,mm)=omeg(j)
- enddo
- enddo ! m
- goto 13
- 11 write (iout,*) nconf_in," conformations requested, but only",
- & m-1," found in the angle file."
- nconf_in=m-1
- 13 continue
- m=nconf_in
- write (iout,*) nconf_in,
- & " initial conformations have been read in."
- endif
- if (iref.eq.0) then
- if (nconfr.gt.nconf_in) then
- call make_ranvar(nconfr,m,idum)
- write (iout,*) nconfr-nconf_in,
- & " conformations have been generated randomly."
- endif
- else
- nconfr=nconfr*2
- call from_int(nconfr,m,idum)
-c call from_pdb(nconfr,idum)
- endif
- write (iout,*) 'Exitted from make_ranvar nconfr=',nconfr
- write (*,*) 'Exitted from make_ranvar nconfr=',nconfr
- do m=1,nconfr
- write (iout,*) 'Initial conformation',m
- write(iout,'(8f10.4)') (rad2deg*dihang_in(1,j,1,m),j=2,nres-1)
- write(iout,'(8f10.4)') (rad2deg*dihang_in(2,j,1,m),j=2,nres-1)
- write(iout,'(8f10.4)') (rad2deg*dihang_in(3,j,1,m),j=2,nres-1)
- write(iout,'(8f10.4)') (rad2deg*dihang_in(4,j,1,m),j=2,nres-1)
- enddo
- write(iout,*)'Calling FEEDIN NCONF',nconfr
- time1i=MPI_WTIME()
- call feedin(nconfr,nft)
- write (iout,*) ' Time for first bank min.',MPI_WTIME()-time1i
- call history_append
- write(icsa_history,*) jlee,nft,nbank
- write(icsa_history,851) (etot(i),i=1,nconfr)
- write(icsa_history,850) (rmsn(i),i=1,nconfr)
- write(icsa_history,850) (pncn(i),i=1,nconfr)
- write(icsa_history,*)
- close(icsa_history)
- ELSE
-c To minimize input conformation (bank conformation)
-c Output to $mol.reminimized
- if (irestart.lt.0) then
- call reminimize(jlee)
- return
- endif
- if (irestart.eq.1) goto 111
-c soldier - perform energy minimization
- 334 call minim_jlee
- ENDIF
-
-ccccccccccccccccccccccccccccccccccc
-c need to syncronize all procs
- call mpi_barrier(CG_COMM,ierr)
- if (ierr.ne.0) then
- print *, ' cannot synchronize MPI'
- stop
- endif
-ccccccccccccccccccccccccccccccccccc
-
- IF (ME.EQ.KING) THEN
-
-c print *,"ok after minim"
- nstep=nstep+nconf
- if(irestart.eq.2) then
- nbank=nbank+nconf
-c ntbank=ntbank+nconf
- if(ntbank.gt.ntbankm) ntbank=ntbankm
- endif
-c print *,"ok before indexx"
- if(iref.eq.0) then
- call indexx(nconfr,etot,indx)
- else
-c cc/al 7/6/00
- do k=1,nconfr
- indx(k)=k
- enddo
- call indexx(nconfr-nconf_in,rmsn(nconf_in+1),indx(nconf_in+1))
- do k=nconf_in+1,nconfr
- indx(k)=indx(k)+nconf_in
- enddo
-c cc/al
-c call indexx(nconfr,rmsn,indx)
- endif
-c print *,"ok after indexx"
- do im=1,nconf
- m=indx(im)
- if (m.gt.mxio .or. m.lt.1) then
- write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,' M',m
- call mpi_abort(mpi_comm_world,ierror,ierrcode)
- endif
- jbank(im+nbank-nconf)=0
- bene(im+nbank-nconf)=etot(m)
- rene(im+nbank-nconf)=etot(m)
-c!bankt btene(im)=etot(m)
-c
- brmsn(im+nbank-nconf)=rmsn(m)
- bpncn(im+nbank-nconf)=pncn(m)
- rrmsn(im+nbank-nconf)=rmsn(m)
- rpncn(im+nbank-nconf)=pncn(m)
- if (im+nbank-nconf.gt.mxio .or. im+nbank-nconf.lt.1) then
- write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,
- & ' NBANK',nbank,' NCONF',nconf,' IM+NBANK-NCONF',im+nbank-nconf
- 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,im+nbank-nconf)=dihang(i,j,k,m)
- rvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m)
-c!bankt btvar(i,j,k,im)=dihang(i,j,k,m)
-c
- enddo
- enddo
- enddo
- if(iref.eq.1) then
- if(brmsn(im+nbank-nconf).gt.rmscut.or.
- & bpncn(im+nbank-nconf).lt.pnccut) ibank(im+nbank-nconf)=9
- endif
- if(vdisulf) then
- bvar_ns(im+nbank-nconf)=ns-2*nss
- k=0
- do i=1,ns
- j=1
- do while( iss(i).ne.ihpb(j)-nres .and.
- & iss(i).ne.jhpb(j)-nres .and. j.le.nss)
- j=j+1
- enddo
- if (j.gt.nss) then
- k=k+1
- bvar_s(k,im+nbank-nconf)=iss(i)
- endif
- enddo
- endif
- bvar_nss(im+nbank-nconf)=nss
- do i=1,nss
- bvar_ss(1,i,im+nbank-nconf)=ihpb(i)
- bvar_ss(2,i,im+nbank-nconf)=jhpb(i)
- enddo
- enddo
- ENDIF
-
- 111 continue
-
- IF (ME.EQ.KING) THEN
-
- call find_max
- call find_min
-
- call get_diff
- if(nbank.eq.nconf.and.irestart.eq.0) then
- adif=avedif
- endif
-
- cutdif=adif/cut1
- ctdif1=adif/cut2
-
-cd print *,"adif,xctdif,cutdifr"
-cd print *,adif,xctdif,cutdifr
- nst=ntotal/ntrial/nseed
- xctdif=(cutdif/ctdif1)**(-1.0/nst)
- if(irestart.ge.1) call estimate_cutdif(adif,xctdif,cutdifr)
-c print *,"ok after estimate"
-
- irestart=0
-
- call write_rbank(jlee,adif,nft)
- call write_bank(jlee,nft)
-c!bankt call write_bankt(jlee,nft)
-c call write_bank1(jlee)
- call history_append
- write(icsa_history,*) "xctdif: ", xctdif,nst,adif/cut1,ctdif1
- write(icsa_history,851) (bene(i),i=1,nbank)
- write(icsa_history,850) (brmsn(i),i=1,nbank)
- write(icsa_history,850) (bpncn(i),i=1,nbank)
- close(icsa_history)
- 850 format(10f8.3)
- 851 format(5e15.6)
-
- ifar=nseed/4*3+1
- ifar=nseed+1
- ENDIF
-
-
- finished=.false.
- iter = 0
- irecv = 0
- isent =0
- ifrom= 0
- time0i=MPI_WTIME()
- time1i=time0i
- time_start_c=time0i
- if (.not.sync_iter) then
- time_start=time0i
- nft00=nft
- else
- sync_iter=.false.
- endif
- nft00_c=nft
- nft0i=nft
-ccccccccccccccccccccccccccccccccccccccc
- do while (.not. finished)
-ccccccccccccccccccccccccccccccccccccccc
-crc print *,"iter ", iter,' isent=',isent
-
- IF (ME.EQ.KING) THEN
-c start energy minimization
-
- if (isent.eq.0) then
-c king-emperor - select seeds & make var & feed input
-cd print *,'generating new conf',ntrial,MPI_WTIME()
- call select_is(nseed,ifar,idum)
-
- open(icsa_seed,file=csa_seed,status="old")
- write(icsa_seed,39)
- & jlee,icycle,nstep,(is(i),bene(is(i)),i=1,nseed)
- close(icsa_seed)
- call history_append
- write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
- * ebmin,ebmax,nft,iuse,nbank,ntbank
- close(icsa_history)
-
-
-
- call make_var(ntry,idum,iter)
-cd print *,'new trial generated',ntrial,MPI_WTIME()
- time2i=MPI_WTIME()
- write (iout,'(a20,i4,f12.2)')
- & 'Time for make trial',iter+1,time2i-time1i
- endif
-
-crc write(iout,*)'1:Calling FEEDIN NTRY',NTRY,' ntrial',ntrial
-crc call feedin(ntry,nft)
-
- isent=isent+1
- if (isent.ge.nodes.or.iter.gt.0) then
-ct print *,'waiting ',MPI_WTIME()
- irecv=irecv+1
- call recv(0,ifrom,xout,eout,ind,timeout)
-ct print *,' ',irecv,' received from',ifrom,MPI_WTIME()
- else
- ifrom=ifrom+1
- endif
-
-ct print *,'sending to',ifrom,MPI_WTIME()
- call send(isent,ifrom,iter)
-ct print *,isent,' sent ',MPI_WTIME()
-
-c store results -----------------------------------------------
- if (isent.ge.nodes.or.iter.gt.0) then
- nft=nft+ind(3)
- movernx(irecv)=iabs(ind(5))
- call getx(ind,xout,eout,cout,rad,iw_pdb,irecv)
- if(vdisulf) then
- nss_out(irecv)=nss
- do i=1,nss
- iss_out(i,irecv)=ihpb(i)
- jss_out(i,irecv)=jhpb(i)
- enddo
- endif
- if(iw_pdb.gt.0)
- & call write_csa_pdb(xout,eout,nft,irecv,iw_pdb)
- endif
-c--------------------------------------------------------------
- if (isent.eq.ntry) then
- time1i=MPI_WTIME()
- write (iout,'(a18,f12.2,a14,f10.2)')
- & 'Nonsetup time ',time1i-time_start_c,
- & ' sec, Eval/s =',(nft-nft00_c)/(time1i-time_start_c)
- write (iout,'(a14,i4,f12.2,a14,f10.2)')
- & 'Time for iter ',iter+1,time1i-time0i,
- & ' sec, Eval/s =',(nft-nft0i)/(time1i-time0i)
- time0i=time1i
- nft0i=nft
- cutdif=cutdif*xctdif
- if(cutdif.lt.ctdif1) cutdif=ctdif1
- if (iter.eq.0) then
- print *,'UPDATING ',ntry-nodes+1,irecv
- write(iout,*) 'UPDATING ',ntry-nodes+1
- iter=iter+1
-c----------------- call update(ntry-nodes+1) -------------------
- nstep=nstep+ntry-nseed-(nodes-1)
- call refresh_bank(ntry-nodes+1)
-c!bankt call refresh_bankt(ntry-nodes+1)
- else
-c----------------- call update(ntry) ---------------------------
- iter=iter+1
- print *,'UPDATING ',ntry,irecv
- write(iout,*) 'UPDATING ',ntry
- nstep=nstep+ntry-nseed
- call refresh_bank(ntry)
-c!bankt call refresh_bankt(ntry)
- endif
-c-----------------------------------------------------------------
-
- call write_bank(jlee,nft)
-c!bankt call write_bankt(jlee,nft)
- call find_min
-
- time1i=MPI_WTIME()
- write (iout,'(a20,i4,f12.2)')
- & 'Time for refresh ',iter,time1i-time0i
-
- if(ebmin.lt.estop) finished=.true.
- if(icycle.gt.icmax) then
- call write_bank1(jlee)
- do i=1,nbank
- ibank(i)=2
- ibank(i)=1
- enddo
- nbank=nbank+nconf
- if(nbank.gt.1000) then
- finished=.true.
- else
-crc goto 333
- sync_iter=.true.
- endif
- endif
- if(nstep.gt.nstmax) finished=.true.
-
- if(finished.or.sync_iter) then
- do ij=1,nodes-1
- call recv(1,ifrom,xout,eout,ind,timeout)
- if (timeout) then
- nstep=nstep+ij-1
- print *,'ERROR worker is not responding'
- write(iout,*) 'ERROR worker is not responding'
- time1i=MPI_WTIME()-time_start_c
- print *,'End of cycle, master time for ',iter,' iters ',
- & time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
- write (iout,*) 'End of cycle, master time for ',iter,
- & ' iters ',time1i,' sec'
- write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
- print *,'UPDATING ',ij-1
- write(iout,*) 'UPDATING ',ij-1
- call flush(iout)
- call refresh_bank(ij-1)
-c!bankt call refresh_bankt(ij-1)
- goto 1002
- endif
-c print *,'node ',ifrom,' finished ',ij,nft
- write(iout,*) 'node ',ifrom,' finished ',ij,nft
- call flush(iout)
- nft=nft+ind(3)
- movernx(ij)=iabs(ind(5))
- call getx(ind,xout,eout,cout,rad,iw_pdb,ij)
- if(vdisulf) then
- nss_out(ij)=nss
- do i=1,nss
- iss_out(i,ij)=ihpb(i)
- jss_out(i,ij)=jhpb(i)
- enddo
- endif
- if(iw_pdb.gt.0)
- & call write_csa_pdb(xout,eout,nft,ij,iw_pdb)
- enddo
- nstep=nstep+nodes-1
-crc print *,'---------bcast finished--------',finished
- time1i=MPI_WTIME()-time_start_c
- print *,'End of cycle, master time for ',iter,' iters ',
- & time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
- write (iout,*) 'End of cycle, master time for ',iter,
- & ' iters ',time1i,' sec'
- write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
-
-ctimeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
-ctimeout call mpi_bcast(sync_iter,1,mpi_logical,0,
-ctimeout & CG_COMM,ierr)
- do ij=1,nodes-1
- tstart=MPI_WTIME()
- call mpi_issend(finished,1,mpi_logical,ij,idchar,
- & CG_COMM,ireq,ierr)
- call mpi_issend(sync_iter,1,mpi_logical,ij,idchar,
- & CG_COMM,ireq2,ierr)
- flag=.false.
- timeout1=.false.
- do while(.not. (flag .or. timeout1))
- call MPI_TEST(ireq2,flag,muster,ierr)
- tend1=MPI_WTIME()
- if(tend1-tstart.gt.60) then
- print *,'ERROR worker ',ij,' is not responding'
- write(iout,*) 'ERROR worker ',ij,' is not responding'
- timeout1=.true.
- endif
- enddo
- if(timeout1) then
- write(iout,*) 'worker ',ij,' NOT OK ',tend1-tstart
- timeout=.true.
- else
- write(iout,*) 'worker ',ij,' OK ',tend1-tstart
- endif
- enddo
- print *,'UPDATING ',nodes-1,ij
- write(iout,*) 'UPDATING ',nodes-1
- call refresh_bank(nodes-1)
-c!bankt call refresh_bankt(nodes-1)
- 1002 continue
- call write_bank(jlee,nft)
-c!bankt call write_bankt(jlee,nft)
- call find_min
-
- 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
-
- write(iout,*)'### Total stats:'
- do i=0,mxmv
- if(nstatnx_tot(i,1).ne.0) then
- if (i.le.9) then
- write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)')
- & '### N',i,' total=',nstatnx_tot(i,1),
- & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',
- & (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
- else
- write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)')
- & '###N',i,' total=',nstatnx_tot(i,1),
- & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',
- & (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
- endif
- else
- if (i.le.9) then
- write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)')
- & '### N',i,' total=',nstatnx_tot(i,1),
- & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),
- & ' %acc',0.0
- else
- write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)')
- & '###N',i,' total=',nstatnx_tot(i,1),
- & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),
- & ' %acc',0.0
- endif
- endif
- enddo
-
- endif
- if(sync_iter) goto 331
-
- 39 format(2i3,i7,5(i4,f8.3,1x),19(/,13x,5(i4,f8.3,1x)))
- 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
- 43 format(10i8)
- 44 format('jlee =',i3,':',4f10.1,' E =',f8.3,i7,i10)
-
- isent=0
- irecv=0
- endif
- ELSE
-c soldier - perform energy minimization
- call minim_jlee
- print *,'End of minim, proc',me,'time ',MPI_WTIME()-time_start
- write (iout,*) 'End of minim, proc',me,'time ',
- & MPI_WTIME()-time_start
- call flush(iout)
-ctimeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
-ctimeout call mpi_bcast(sync_iter,1,mpi_logical,0,CG_COMM,ierr)
- call mpi_recv(finished,1,mpi_logical,0,idchar,
- * CG_COMM,muster,ierr)
- call mpi_recv(sync_iter,1,mpi_logical,0,idchar,
- * CG_COMM,muster,ierr)
- if(sync_iter) goto 331
- ENDIF
-
-ccccccccccccccccccccccccccccccccccccccc
- enddo
-ccccccccccccccccccccccccccccccccccccccc
-
- IF (ME.EQ.KING) THEN
- call history_append
- write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
- * ebmin,ebmax,nft,iuse,nbank,ntbank
-
- write(icsa_history,44) jlee,0.0,0.0,0.0,
- & 0.0,ebmin,nstep,nft
- write(icsa_history,*)
- close(icsa_history)
-
- time1i=MPI_WTIME()-time_start
- print *,'End of RUN, master time ',
- & time1i,'sec, Eval/s ',(nft-nft00)/time1i
- write (iout,*) 'End of RUN, master time ',
- & time1i,' sec'
- write (iout,*) 'Total eval/s ',(nft-nft00)/time1i
-
- if(timeout) then
- write(iout,*) '!!!! ERROR worker was not responding'
- write(iout,*) '!!!! cannot finish work normally'
- write(iout,*) 'Processor0 is calling MPI_ABORT'
- print *,'!!!! ERROR worker was not responding'
- print *,'!!!! cannot finish work normally'
- print *,'Processor0 is calling MPI_ABORT'
- call flush(iout)
- call mpi_abort(mpi_comm_world, 111, ierr)
- endif
- ENDIF
-
-cccccccccccccccccccccccccccccc
- 300 continue
-cccccccccccccccccccccccccccccc
-
- return
- end
-c-------------------------------------------------
- subroutine feedin(nconf,nft)
-c sends out starting conformations and receives results of energy minimization
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- include 'mpif.h'
- dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
- * cout(2),ind(9),info(12)
- dimension muster(mpi_status_size)
- include 'COMMON.SETUP'
- parameter (rad=1.745329252d-2)
-
- print *,'FEEDIN: NCONF=',nconf
- mm=0
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- if (nconf .lt. nodes-1) then
- write (*,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',
- & nconf,nodes-1
- write (iout,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',
- & nconf,nodes-1
- call mpi_abort(mpi_comm_world,ierror,ierrcode)
- endif
- do n=1,nconf
-c pull out external and internal variables for next start
- call putx(xin,n,rad)
-! write (iout,*) 'XIN from FEEDIN N=',n
-! write(iout,'(8f10.4)') (xin(j),j=1,nvar)
- mm=mm+1
- if (mm.lt.nodes) then
-c feed task to soldier
-! print *, ' sending input for start # ',n
- info(1)=n
- info(2)=-1
- info(3)=0
- info(4)=0
- info(5)=0
- info(6)=0
- call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
- * ierr)
- call mpi_send(xin,nvar,mpi_double_precision,mm,
- * idreal,CG_COMM,ierr)
- else
-c find an available soldier
- call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
- * CG_COMM,muster,ierr)
-! print *, ' receiving output from start # ',ind(1)
- man=muster(mpi_source)
-c receive final energies and variables
- nft=nft+ind(3)
- call mpi_recv(eout,1,mpi_double_precision,
- * man,idreal,CG_COMM,muster,ierr)
-! print *,eout
-#ifdef CO_BIAS
- call mpi_recv(co,1,mpi_double_precision,
- * man,idreal,CG_COMM,muster,ierr)
- write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
-#endif
- call mpi_recv(xout,nvar,mpi_double_precision,
- * man,idreal,CG_COMM,muster,ierr)
-! print *,nvar , ierr
-c feed next task to soldier
-! print *, ' sending input for start # ',n
- info(1)=n
- info(2)=-1
- info(3)=0
- info(4)=0
- info(5)=0
- info(6)=0
- info(7)=0
- info(8)=0
- info(9)=0
- call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,
- * ierr)
- call mpi_send(xin,nvar,mpi_double_precision,man,
- * idreal,CG_COMM,ierr)
-c retrieve latest results
- call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
- if(iw_pdb.gt.0)
- & call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
- endif
- enddo
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c no more input
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- do j=1,nodes-1
-c wait for a soldier
- call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
- * CG_COMM,muster,ierr)
-crc if (ierr.ne.0) go to 30
-! print *, ' receiving output from start # ',ind(1)
- man=muster(mpi_source)
-c receive final energies and variables
- nft=nft+ind(3)
- call mpi_recv(eout,1,
- * mpi_double_precision,man,idreal,
- * CG_COMM,muster,ierr)
-! print *,eout
-#ifdef CO_BIAS
- call mpi_recv(co,1,mpi_double_precision,
- * man,idreal,CG_COMM,muster,ierr)
- write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
-#endif
-crc if (ierr.ne.0) go to 30
- call mpi_recv(xout,nvar,mpi_double_precision,
- * man,idreal,CG_COMM,muster,ierr)
-! print *,nvar , ierr
-crc if (ierr.ne.0) go to 30
-c halt soldier
- info(1)=0
- info(2)=-1
- info(3)=0
- info(4)=0
- info(5)=0
- info(6)=0
- call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,
- * ierr)
-c retrieve results
- call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
- if(iw_pdb.gt.0)
- & call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
- enddo
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- return
- 10 print *, ' dispatching error'
- call mpi_abort(mpi_comm_world,ierror,ierrcode)
- return
- 20 print *, ' communication error'
- call mpi_abort(mpi_comm_world,ierror,ierrcode)
- return
- 30 print *, ' receiving error'
- call mpi_abort(mpi_comm_world,ierror,ierrcode)
- return
- end
-cccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine getx(ind,xout,eout,cout,rad,iw_pdb,k)
-c receives and stores data from soldiers
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.CONTACTS'
- dimension ind(9),xout(maxvar),eout(mxch*(mxch+1)/2+1)
-cjlee
- double precision przes(3),obr(3,3)
- logical non_conv
-cjlee
- iw_pdb=2
- if (k.gt.mxio .or. k.lt.1) then
- write (iout,*)
- & 'ERROR - dimensions of ANGMIN have been exceeded K=',k
- call mpi_abort(mpi_comm_world,ierror,ierrcode)
- endif
-c store ind()
- do j=1,9
- indb(k,j)=ind(j)
- enddo
-c store energies
- etot(k)=eout(1)
-c retrieve dihedral angles etc
- call var_to_geom(nvar,xout)
- do j=2,nres-1
- dihang(1,j,1,k)=theta(j+1)
- dihang(2,j,1,k)=phi(j+2)
- dihang(3,j,1,k)=alph(j)
- dihang(4,j,1,k)=omeg(j)
- enddo
- dihang(2,nres-1,1,k)=0.0d0
-cjlee
- if(iref.eq.0) then
- iw_pdb=1
-cd write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4)')
-cd & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' mv ',
-cd & ind(5),ind(4)
- return
- endif
- call chainbuild
-c call dihang_to_c(dihang(1,1,1,k))
-c call fitsq(rms,c(1,1),crefjlee(1,1),nres,przes,obr,non_conv)
-c call fitsq(rms,c(1,2),crefjlee(1,2),nres-1,przes,obr,non_conv)
-c call fitsq(rms,c(1,nstart_seq),crefjlee(1,nstart_sup),
-c & nsup,przes,obr,non_conv)
-c rmsn(k)=dsqrt(rms)
-
- call rmsd_csa(rmsn(k))
- call contact(.false.,ncont,icont,co)
- pncn(k)=contact_fract(ncont,ncont_ref,icont,icont_ref)
-
-cd write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a5
-cd & ,0pf5.2,a5,f5.1,a,f6.3,a4,i3,i4)')
-cd & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' rms ',
-cd & rmsn(k),' %NC ',pncn(k)*100,' cont.order',co,' mv ',
-cd & ind(5),ind(4)
-
-
- if (rmsn(k).gt.rmscut.or.pncn(k).lt.pnccut) iw_pdb=0
- return
- end
-cccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine putx(xin,n,rad)
-c gets starting variables
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- dimension xin(maxvar)
-
-c pull out starting values for variables
-! write (iout,*)'PUTX: N=',n
- do m=1,numch
-! write (iout,'(8f10.4)') (dihang_in(1,j,m,n),j=2,nres-1)
-! write (iout,'(8f10.4)') (dihang_in(2,j,m,n),j=2,nres-1)
-! write (iout,'(8f10.4)') (dihang_in(3,j,m,n),j=2,nres-1)
-! write (iout,'(8f10.4)') (dihang_in(4,j,m,n),j=2,nres-1)
- do j=2,nres-1
- theta(j+1)=dihang_in(1,j,m,n)
- phi(j+2)=dihang_in(2,j,m,n)
- alph(j)=dihang_in(3,j,m,n)
- omeg(j)=dihang_in(4,j,m,n)
- enddo
- enddo
-c set up array of variables
- call geom_to_var(nvar,xin)
-! write (iout,*) 'xin in PUTX N=',n
-! call intout
-! write (iout,'(8f10.4)') (xin(i),i=1,nvar)
- return
- end
-c--------------------------------------------------------
- subroutine putx2(xin,iff,n)
-c gets starting variables
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- dimension xin(maxvar),iff(maxres)
-
-c pull out starting values for variables
- do m=1,numch
- do j=2,nres-1
- theta(j+1)=dihang_in2(1,j,m,n)
- phi(j+2)=dihang_in2(2,j,m,n)
- alph(j)=dihang_in2(3,j,m,n)
- omeg(j)=dihang_in2(4,j,m,n)
- enddo
- enddo
-c set up array of variables
- call geom_to_var(nvar,xin)
-
- do i=1,nres
- iff(i)=iff_in(i,n)
- enddo
- return
- end
-
-c-------------------------------------------------------
- subroutine prune_bank(p_cut)
- 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.TIME1'
- include 'COMMON.SETUP'
-c---------------------------
-c This subroutine prunes bank conformations using p_cut
-c---------------------------
-
- nprune=0
- nprune=nprune+1
- m=1
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang(i,j,k,nprune)=bvar(i,j,k,m)
- enddo
- enddo
- enddo
- bene(nprune)=bene(m)
- brmsn(nprune)=brmsn(m)
- bpncn(nprune)=bpncn(m)
-
- do m=2,nbank
- ddmin=9.d190
- do ip=1,nprune
- call get_diff12(dihang(1,1,1,ip),bvar(1,1,1,m),diff)
- if(diff.lt.p_cut) goto 100
- if(diff.lt.ddmin) ddmin=diff
- enddo
- nprune=nprune+1
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang(i,j,k,nprune)=bvar(i,j,k,m)
- enddo
- enddo
- enddo
- bene(nprune)=bene(m)
- brmsn(nprune)=brmsn(m)
- bpncn(nprune)=bpncn(m)
- 100 continue
- write (iout,*) 'Pruning :',m,nprune,p_cut,ddmin
- enddo
- nbank=nprune
- print *, 'Pruning :',m,nprune,p_cut
- call write_bank(0,0)
-
- return
- end
-c-------------------------------------------------------
-
- subroutine reminimize(jlee)
- 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.TIME1'
- include 'COMMON.SETUP'
-c---------------------------
-c This subroutine re-minimizes bank conformations:
-c---------------------------
-
- ntry=nbank
-
- call find_max
- call find_min
-
- if (me.eq.king) then
- open(icsa_history,file=csa_history,status="old")
- write(icsa_history,*) "Re-minimization",nodes,"nodes"
- write(icsa_history,851) (bene(i),i=1,nbank)
- write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
- * ebmin,ebmax,nft,iuse,nbank,ntbank
- close(icsa_history)
- do index=1,ntry
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,index)
- enddo
- enddo
- enddo
- enddo
- nft=0
- call feedin(ntry,nft)
- else
- call minim_jlee
- endif
-
- call find_max
- call find_min
-
- if (me.eq.king) then
- do i=1,ntry
- call replace_bvar(i,i)
- enddo
- open(icsa_history,file=csa_history,status="old")
- write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
- * ebmin,ebmax,nft,iuse,nbank,ntbank
- write(icsa_history,851) (bene(i),i=1,nbank)
- close(icsa_history)
- call write_bank_reminimized(jlee,nft)
- endif
-
- 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
- 851 format(5e15.6)
- 850 format(5e15.10)
-c 850 format(10f8.3)
-
- return
- end
-c-------------------------------------------------------
- subroutine send(n,mm,it)
-c sends out starting conformation for minimization
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'mpif.h'
- dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
- * cout(2),ind(8),xin2(maxvar),iff(maxres),info(12)
- dimension muster(mpi_status_size)
- include 'COMMON.SETUP'
- parameter (rad=1.745329252d-2)
-
- if (isend2(n).eq.0) then
-c pull out external and internal variables for next start
- call putx(xin,n,rad)
- info(1)=n
- info(2)=it
- info(3)=movenx(n)
- info(4)=nss_in(n)
- info(5)=parent(1,n)
- info(6)=parent(2,n)
-
- if (movenx(n).eq.14.or.movenx(n).eq.17) then
- info(7)=idata(1,n)
- info(8)=idata(2,n)
- else if (movenx(n).eq.16) then
- info(7)=idata(1,n)
- info(8)=idata(2,n)
- info(10)=idata(3,n)
- info(11)=idata(4,n)
- info(12)=idata(5,n)
- else
- info(7)=0
- info(8)=0
- info(10)=0
- info(11)=0
- info(12)=0
- endif
-
- if (movenx(n).eq.15) then
- info(9)=parent(3,n)
- else
- info(9)=0
- endif
- call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
- * ierr)
- call mpi_send(xin,nvar,mpi_double_precision,mm,
- * idreal,CG_COMM,ierr)
- else
-c distfit & minimization for n7 move
- info(1)=-n
- info(2)=it
- info(3)=movenx(n)
- info(4)=nss_in(n)
- info(5)=parent(1,n)
- info(6)=parent(2,n)
- info(7)=0
- info(8)=0
- info(9)=0
- call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
- * ierr)
- call putx2(xin,iff,isend2(n))
- call mpi_send(xin,nvar,mpi_double_precision,mm,
- * idreal,CG_COMM,ierr)
- call mpi_send(iff,nres,mpi_integer,mm,
- * idint,CG_COMM,ierr)
- call putx(xin2,n,rad)
- call mpi_send(xin2,nvar,mpi_double_precision,mm,
- * idreal,CG_COMM,ierr)
- endif
- if (vdisulf.and.nss_in(n).ne.0) then
- call mpi_send(iss_in(1,n),nss_in(n),mpi_integer,mm,
- * idint,CG_COMM,ierr)
- call mpi_send(jss_in(1,n),nss_in(n),mpi_integer,mm,
- * idint,CG_COMM,ierr)
- endif
- return
- end
-c-------------------------------------------------
-
- subroutine recv(ihalt,man,xout,eout,ind,tout)
-c receives results of energy minimization
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- include 'COMMON.SBRIDGE'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'mpif.h'
- dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
- * cout(2),ind(9),info(12)
- dimension muster(mpi_status_size)
- include 'COMMON.SETUP'
- logical tout,flag
- double precision twait,tstart,tend1
- parameter(twait=600.0d0)
-
-c find an available soldier
- tout=.false.
- flag=.false.
- tstart=MPI_WTIME()
- do while(.not. (flag .or. tout))
- call MPI_IPROBE(mpi_any_source,idint,CG_COMM,flag,
- * muster,ierr)
- tend1=MPI_WTIME()
- if(tend1-tstart.gt.twait .and. ihalt.eq.1) tout=.true.
-c_error if(tend1-tstart.gt.twait) tout=.true.
- enddo
- if (tout) then
- write(iout,*) 'ERROR = timeout for recv ',tend1-tstart
- call flush(iout)
- return
- endif
- man=muster(mpi_source)
-
-ctimeout call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
-ctimeout * CG_COMM,muster,ierr)
-! print *, ' receiving output from start # ',ind(1)
-ct print *,'receiving ',MPI_WTIME()
-ctimeout man=muster(mpi_source)
- call mpi_recv(ind,9,mpi_integer,man,idint,
- * CG_COMM,muster,ierr)
-ctimeout
-c receive final energies and variables
- call mpi_recv(eout,1,mpi_double_precision,
- * man,idreal,CG_COMM,muster,ierr)
-! print *,eout
-#ifdef CO_BIAS
- call mpi_recv(co,1,mpi_double_precision,
- * man,idreal,CG_COMM,muster,ierr)
- write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
-#endif
- call mpi_recv(xout,nvar,mpi_double_precision,
- * man,idreal,CG_COMM,muster,ierr)
-! print *,nvar , ierr
- if(vdisulf) nss=ind(6)
- if(vdisulf.and.nss.ne.0) then
- call mpi_recv(ihpb,nss,mpi_integer,
- * man,idint,CG_COMM,muster,ierr)
- call mpi_recv(jhpb,nss,mpi_integer,
- * man,idint,CG_COMM,muster,ierr)
- endif
-c halt soldier
- if(ihalt.eq.1) then
-c print *,'sending halt to ',man
- write(iout,*) 'sending halt to ',man
- info(1)=0
- call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,ierr)
- endif
- return
- end
-
-c----------------------------------------------------------
- subroutine history_append
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
-
-#if defined(AIX) || defined(PGI)
- open(icsa_history,file=csa_history,position="append")
-#else
- open(icsa_history,file=csa_history,access="append")
-#endif
- return
- end
-#endif
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
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
projects / unres.git / commitdiff