#=========================================
if(UNRES_MD_FF STREQUAL "GAB" )
# set preprocesor flags
- set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" )
+ set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DSCCORPDB" )
#=========================================
# Settings for E0LL2Y force field
#=========================================
elseif(UNRES_MD_FF STREQUAL "E0LL2Y")
# set preprocesor flags
- set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0" )
+ set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DSCCORPDB" )
endif(UNRES_MD_FF STREQUAL "GAB")
elseif (Fortran_COMPILER_NAME STREQUAL "gfortran")
# Add old gfortran flags
set(CPPFLAGS "${CPPFLAGS} -DG77")
+else (Fortran_COMPILER_NAME STREQUAL "ifort")
+ # Default preprocessor flags
+ set(CPPFLAGS "${CPPFLAGS} -DPGI")
endif (Fortran_COMPILER_NAME STREQUAL "ifort")
& faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2,
& sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2,
& eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder,
- & dsci_inv,dscj_inv,gg
+ & dsci_inv,dscj_inv,gg,gg_lipi,gg_lipj
common /calc/ erij(3),rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj,
& chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12,
& om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1,
& faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2,
& sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2,
& eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder,
- & dsci_inv,dscj_inv,gg(3),i,j
+ & dsci_inv,dscj_inv,gg(3),gg_lipi(3),gg_lipj(3),i,j
integer nres,nsup,nstart_sup,nz_start,nz_end,iz_sc,
- & nres0,nstart_seq,chain_length,iprzes,tabperm,nperm
+ & nres0,nstart_seq,chain_length,iprzes,tabperm,nperm,afmend,
+ & afmbeg
double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm,t,r,
- & prod,rt,dc_work,cref,crefjlee,chain_rep,dc_norm2
+ & prod,rt,dc_work,cref,crefjlee,chain_rep,dc_norm2,velAFMconst,
+ & totTafm
common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2),
& xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2),
& dc_norm2(3,0:maxres2),
& nsup,nstart_sup,nstart_seq,
& chain_length,iprzes,tabperm(maxperm,maxsym),nperm
common /from_zscore/ nz_start,nz_end,iz_sc
+ double precision boxxsize,boxysize,boxzsize,enecut,sscut,
+ & sss,sssgrad,
+ & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick
+ common /box/ boxxsize,boxysize,boxzsize,enecut,sscut,sss,sssgrad,
+ & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick
+ common /afm/ forceAFMconst, distafminit,afmend,afmbeg,
+ & velAFMconst,
+ & totTafm
+
C 10/30/99 Added other pre-computed vectors and matrices needed
C to calculate three - six-order el-loc correlation terms
double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der,
- & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder,
- & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der
+ & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder,gmu,gUb2
+ & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der,
+ & gtEug
common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres),
& Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres),
& obrot_der(2,maxres),obrot2_der(2,maxres)
C This common block contains vectors and matrices dependent on a single
C amino-acid residue.
common /precomp1/ mu(2,maxres),muder(2,maxres),Ub2(2,maxres),
+ & gmu(2,maxres),gUb2(2,maxres),
& Ub2der(2,maxres),Ctobr(2,maxres),Ctobrder(2,maxres),
& Dtobr2(2,maxres),Dtobr2der(2,maxres),
& EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres),
& CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres),
- & DtUg2(2,2,maxres),DtUg2der(2,2,maxres)
+ & DtUg2(2,2,maxres),DtUg2der(2,2,maxres),gtEUg(2,2,maxres)
C This common block contains vectors and matrices dependent on two
C consecutive amino-acid residues.
double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC,
integer modecalc,iscode,indpdb,indback,indphi,iranconf,icheckgrad,
- & inprint,i2ndstr,mucadyn,constr_dist,symetr
+ & inprint,i2ndstr,mucadyn,constr_dist,symetr,AFMlog,selfguide
logical minim,refstr,pdbref,outpdb,outmol2,overlapsc,energy_dec,
& sideadd,lsecondary,read_cart,unres_pdb,
& vdisulf,searchsc,lmuca,dccart,extconf,out1file,
& icheckgrad,minim,i2ndstr,refstr,pdbref,outpdb,outmol2,iprint,
& overlapsc,energy_dec,sideadd,lsecondary,read_cart,unres_pdb
& ,vdisulf,searchsc,lmuca,dccart,mucadyn,extconf,out1file,
- & constr_dist,gnorm_check,gradout,split_ene,symetr
+ & constr_dist,gnorm_check,gradout,split_ene,symetr,AFMlog,
+ & selfguide
C... minim = .true. means DO minimization.
C... energy_dec = .true. means print energy decomposition matrix
- double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gelc_long,
- & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp,
+ double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gelc_long
+ & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp,gliptranc,gliptranx,
& 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,gvdwx
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
+ & gradx(3,-1:maxres,2),gradc(3,-1:maxres,2),gvdwx(3,-1:maxres),
+ & gvdwc(3,-1:maxres),gelc(3,-1:maxres),gelc_long(3,-1:maxres),
+ & gvdwpp(3,-1:maxres),gvdwc_scpp(3,-1:maxres),
+ & gliptranc(3,-1:maxres),
+ & gliptranx(3,-1:maxres),
+ & gradafm(3,-1:maxres),
+ & gradx_scp(3,-1:maxres),gvdwc_scp(3,-1:maxres),
+ & ghpbx(3,-1:maxres),
+ & ghpbc(3,-1:maxres),gloc(maxvar,2),gradcorr(3,-1:maxres),
+ & gradcorr_long(3,-1:maxres),gradcorr5_long(3,-1:maxres),
+ & gradcorr6_long(3,-1:maxres),gcorr6_turn_long(3,-1:maxres),
+ & gradxorr(3,-1:maxres),gradcorr5(3,-1:maxres),
+ & gradcorr6(3,-1:maxres),
+ & gloc_x(maxvar,2),gel_loc(3,-1:maxres),gel_loc_long(3,-1:maxres),
+ & gcorr3_turn(3,-1:maxres),
+ & gcorr4_turn(3,-1:maxres),gcorr6_turn(3,-1:maxres),
+ & gradb(3,-1:maxres),
+ & gradbx(3,-1: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,-1:maxres),
+ & gsccorx(3,-1:maxres),gsccor_loc(-1:maxres),
+ & dtheta(3,2,-1:maxres),
+ & gscloc(3,-1:maxres),gsclocx(3,-1:maxres),
+ & dphi(3,3,-1:maxres),dalpha(3,3,-1:maxres),domega(3,3,-1: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),
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,
+ & wturn6,wvdwpp,weights(n_ene),wliptran,temp0,
& scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp,
& rescale_mode
common /potentials/ potname(5)
- double precision aa,bb,augm,aad,bad,app,bpp,ale6,ael3,ael6
+ double precision aa,bb,augm,aad,bad,app,bpp,ale6,ael3,ael6,
+ &aa_lip,bb_lip,aa_aq,bb_aq
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),
+ common /interact/aa_aq(ntyp,ntyp),bb_aq(ntyp,ntyp),
+ & aa_lip(ntyp,ntyp),bb_lip(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,
& 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,
+ double precision eps,epslip,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),
+ common /body/eps(ntyp,ntyp),epslip(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)
+ & rpp(2,2),epp(2,2),elpp6(2,2),elpp3(2,2),eps_scp(ntyp,2),
+ & rscp(ntyp,2)
c 12/5/03 modified 09/18/03 Bond stretching parameters.
- double precision vbldp0,vbldsc0,akp,aksc,abond0,distchainmax
+ double precision vbldp0,vbldpDUM,
+ & vbldsc0,akp,aksc,abond0,distchainmax
integer nbondterm
- common /stretch/ vbldp0,vbldsc0(maxbondterm,ntyp),akp,
+ common /stretch/ vbldp0,vbldpDUM,
+ & vbldsc0(maxbondterm,ntyp),akp,
& aksc(maxbondterm,ntyp),abond0(maxbondterm,ntyp),
& distchainmax,nbondterm(ntyp)
+C 01/29/15 Lipidic parameters
+ double precision pepliptran,liptranene
+ common /lipid/ pepliptran,liptranene(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,liptranname
common /parfiles/ bondname,thetname,rotname,torname,tordname,
- & fouriername,elename,sidename,scpname,sccorname,patname
+ & fouriername,elename,sidename,scpname,sccorname,patname,
+ & thetname_pdb,rotname_pdb,liptranname
character*3 pot
C-----------------------------------------------------------------------
C INP - main input file
& sigc0,dsc,dsc_inv,bsc,censc,gaussc,dsc0
integer nlob
C Parameters of the virtual-bond-angle probability distribution
- common /thetas/ a0thet(ntyp),athet(2,ntyp),bthet(2,ntyp),
- & polthet(0:3,ntyp),gthet(3,ntyp),theta0(ntyp),sig0(ntyp),
- & sigc0(ntyp)
+ common /thetas/ a0thet(-ntyp:ntyp),athet(2,-ntyp:ntyp,-1:1,-1:1),
+ & bthet(2,-ntyp:ntyp,-1:1,-1:1),polthet(0:3,-ntyp:ntyp),
+ & gthet(3,-ntyp:ntyp),theta0(-ntyp:ntyp),sig0(-ntyp:ntyp),
+ & sigc0(-ntyp:ntyp)
C Parameters of the side-chain probability distribution
common /sclocal/ dsc(ntyp1),dsc_inv(ntyp1),bsc(maxlob,ntyp),
- & censc(3,maxlob,ntyp),gaussc(3,3,maxlob,ntyp),dsc0(ntyp1),
+ & censc(3,maxlob,-ntyp:ntyp),gaussc(3,3,maxlob,-ntyp:ntyp),
+ & dsc0(ntyp1),
& nlob(ntyp1)
C Parameters of ab initio-derived potential of virtual-bond-angle bending
integer nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,ndouble,
- & ithetyp(ntyp1),nntheterm
- double precision aa0thet(maxthetyp1,maxthetyp1,maxthetyp1),
- & aathet(maxtheterm,maxthetyp1,maxthetyp1,maxthetyp1),
- & bbthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1),
- & ccthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1),
- & ddthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1),
- & eethet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1),
- & ffthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1,
- & maxthetyp1),
- & ggthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1,
- & maxthetyp1)
+ & ithetyp(-ntyp1:ntyp1),nntheterm
+ double precision aa0thet(-maxthetyp1:maxthetyp1,
+ &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2),
+ & aathet(maxtheterm,-maxthetyp1:maxthetyp1,
+ &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2),
+ & bbthet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,
+ &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2),
+ & ccthet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,
+ &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2),
+ & ddthet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,
+ &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2),
+ & eethet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,
+ &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2),
+ & ffthet(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1,
+ &-maxthetyp1:maxthetyp1, -maxthetyp1:maxthetyp1,2),
+ & ggthet(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1,
+ &-maxthetyp1:maxthetyp1, -maxthetyp1:maxthetyp1,2)
common /theta_abinitio/aa0thet,aathet,bbthet,ccthet,ddthet,eethet,
& ffthet,
& ggthet,ithetyp,nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,
& iphi_end,iphid_start,iphid_end,ibond_start,ibond_end,
& ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end,
& iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start,
- & iint_end,iphi1_start,iphi1_end,itau_start,itau_end,
+ & iint_end,iphi1_start,iphi1_end,itau_start,itau_end,ilip_start,
+ & ilip_end,
& ibond_displ(0:max_fg_procs-1),ibond_count(0:max_fg_procs-1),
& ithet_displ(0:max_fg_procs-1),ithet_count(0:max_fg_procs-1),
& iphi_displ(0:max_fg_procs-1),iphi_count(0:max_fg_procs-1),
& iint_end,iphi1_start,iphi1_end,iint_count,iint_displ,ivec_displ,
& ivec_count,iset_displ,itau_start,itau_end,
& iset_count,ibond_displ,ibond_count,ithet_displ,ithet_count,
- & iphi_displ,iphi_count,iphi1_displ,iphi1_count
+ & iphi_displ,iphi_count,iphi1_displ,iphi1_count,ilip_start,ilip_end
C Inverses of the actual virtual bond lengths
common /invlen/ vbld_inv(maxres2)
character*3 restyp
character*1 onelet
- common /names/ restyp(ntyp+1),onelet(ntyp+1)
+ common /names/ restyp(-ntyp1:ntyp1),
+ & onelet(-ntyp1:ntyp1)
character*10 ename,wname
integer nprint_ene,print_order
common /namterm/ ename(n_ene),wname(n_ene),nprint_ene,
double precision v1sccor,v2sccor,vlor1sccor,
& vlor2sccor,vlor3sccor,gloc_sc,
& dcostau,dsintau,dtauangle,dcosomicron,
- & domicron
+ & domicron,v0sccor
integer nterm_sccor,isccortyp,nsccortyp,nlor_sccor
common/sccor/v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp),
& v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp),
& nlor_sccor(-ntyp:ntyp,-ntyp:ntyp),
& vlor1sccor(maxterm_sccor,20,20),
& vlor2sccor(maxterm_sccor,20,20),
- & vlor3sccor(maxterm_sccor,20,20),gloc_sc(3,0:maxres2,10),
+ & vlor3sccor(maxterm_sccor,20,20),gloc_sc(3,-1:maxres2,10),
& dcostau(3,3,3,maxres2),dsintau(3,3,3,maxres2),
& dtauangle(3,3,3,maxres2),dcosomicron(3,3,3,maxres2),
& domicron(3,3,3,maxres2)
C Parameters of the SC rotamers (local) term
double precision sc_parmin
- common/scrot/sc_parmin(maxsccoef,20)
+ common/scrot/sc_parmin(maxsccoef,ntyp)
C Torsional constants of the rotation about virtual-bond dihedral angles
double precision v1,v2,vlor1,vlor2,vlor3,v0
integer itortyp,ntortyp,nterm,nlor,nterm_old
- common/torsion/ v0(maxtor,maxtor),
- & v1(maxterm,maxtor,maxtor),
- & v2(maxterm,maxtor,maxtor),
- & vlor1(maxlor,maxtor,maxtor),
- & vlor2(maxlor,maxtor,maxtor),
- & vlor3(maxlor,maxtor,maxtor),
- & nterm(maxtor,maxtor),
- & nlor(maxtor,maxtor),
- & nterm_old,
- & itortyp(ntyp1),
- & ntortyp
+ common/torsion/v0(-maxtor:maxtor,-maxtor:maxtor,2),
+ & v1(maxterm,-maxtor:maxtor,-maxtor:maxtor,2),
+ & v2(maxterm,-maxtor:maxtor,-maxtor:maxtor,2),
+ & vlor1(maxlor,-maxtor:maxtor,-maxtor:maxtor),
+ & vlor2(maxlor,maxtor,maxtor),vlor3(maxlor,maxtor,maxtor),
+ & itortyp(-ntyp1:ntyp1),ntortyp,
+ & nterm(-maxtor:maxtor,-maxtor:maxtor,2),
+ & nlor(-maxtor:maxtor,-maxtor:maxtor,2)
+ & ,nterm_old
C 6/23/01 - constants for double torsionals
double precision v1c,v1s,v2c,v2s
integer ntermd_1,ntermd_2
- common /torsiond/ v1c(2,maxtermd_1,maxtor,maxtor,maxtor),
- & v1s(2,maxtermd_1,maxtor,maxtor,maxtor),
- & v2c(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor),
- & v2s(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor),
- & ntermd_1(maxtor,maxtor,maxtor),ntermd_2(maxtor,maxtor,maxtor)
+ common /torsiond/
+ &v1c(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2),
+ &v1s(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2),
+ &v2c(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,
+ & -maxtor:maxtor,2),
+ &v2s(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,
+ & -maxtor:maxtor,2),
+ & ntermd_1(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2),
+ & ntermd_2(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2)
C 9/18/99 - added Fourier coeffficients of the expansion of local energy
C surface
- double precision b1,b2,cc,dd,ee,ctilde,dtilde,b2tilde
+ double precision b1,b2,cc,dd,ee,ctilde,dtilde,b2tilde,b1tilde,
+ &bnew1,bnew2,eenew,gtb1,gtb2,eeold,gtee
integer nloctyp
- common/fourier/ b1(2,maxtor),b2(2,maxtor),cc(2,2,maxtor),
- & dd(2,2,maxtor),ee(2,2,maxtor),ctilde(2,2,maxtor),
- & dtilde(2,2,maxtor),b1tilde(2,maxtor),nloctyp
+ common/fourier/ b1(2,maxres),b2(2,maxres),b(13,0:maxtor),
+ & bnew1(3,2,-maxtor:maxtor),bnew2(3,2,-maxtor:maxtor),
+ & cc(2,2,-maxtor:maxtor),
+ & dd(2,2,-maxtor:maxtor),eeold(2,2,-maxtor:maxtor),
+ & eenew(2,-maxtor:maxtor),
+ & ee(2,2,maxres),
+ & ctilde(2,2,-maxtor:maxtor),
+ & dtilde(2,2,-maxtor:maxtor),b1tilde(2,maxres),
+ & b2tilde(2,maxres),
+ & gtb1(2,maxres),gtb2(2,maxres),gtEE(2,2,maxres),
+ & nloctyp
+
********************************************************************************
C Max. number of processors.
integer maxprocs
- parameter (maxprocs=2048)
+ parameter (maxprocs=1028)
C Max. number of fine-grain processors
integer max_fg_procs
c parameter (max_fg_procs=maxprocs)
- parameter (max_fg_procs=512)
+ parameter (max_fg_procs=256)
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=1200)
+ parameter (maxres=600)
C Appr. max. number of interaction sites
integer maxres2,maxres6,mmaxres2
parameter (maxres2=2*maxres,maxres6=6*maxres)
parameter (maxcont=12*maxres)
C Max. number of contacts per residue
integer maxconts
- parameter (maxconts=maxres/4)
+ parameter (maxconts=maxres)
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)
+ parameter (ntyp=24,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 (max_pool=10)
C Number of energy components
integer n_ene,n_ene2
- parameter (n_ene=21,n_ene2=2*n_ene)
+ 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)
call brown_step(itime)
endif
if (ntwe.ne.0) then
- if (mod(itime,ntwe).eq.0) call statout(itime)
+ if (mod(itime,ntwe).eq.0) then
+ call statout(itime)
+ call returnbox
+ endif
#ifdef VOUT
do j=1,3
v_work(j)=d_t(j,0)
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
ind=ind+1
v_work(ind)=d_t(j,i+nres)
double precision difftol /1.0d-5/
nbond=nct-nnt
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) nbond=nbond+1
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) nbond=nbond+1
enddo
c
if (lprn1) then
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
ind1=ind1+1
do j=1,3
Bmat(ind+j,ind1)=dC_norm(j,i+nres)
Td(i)=Td(i)+vbl*Tmat(i,ind)
enddo
do k=nnt,nct
- if (itype(k).ne.10 .and. itype(i).ne.21) then
+ if (itype(k).ne.10 .and. itype(i).ne.ntyp1) then
ind=ind+1
Td(i)=Td(i)+vbldsc0(1,itype(k))*Tmat(i,ind)
endif
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
ind=ind+1
zapas(ind)=-gxcart(j,i)+stochforcvec(ind)
& i,(dC(j,i),j=1,3),xx
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
ind=ind+1
xx=vbld(i+nres)-vbldsc0(1,itype(i))
write (iout,'(i5,3f10.5,5x,f10.5,e15.5)')
endif
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
ind=ind+1
blen2 = scalar(dc(1,i+nres),dc(1,i+nres))
ppvec(ind)=2*vbldsc0(1,itype(i))**2-blen2
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
dc(j,i+nres)=zapas(ind+j)
dc_work(ind+j)=zapas(ind+j)
& i,(dC(j,i),j=1,3),xx
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
ind=ind+1
xx=vbld(i+nres)-vbldsc0(1,itype(i))
write (iout,'(i5,3f10.5,5x,f10.5,e15.5)')
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
d_t(j,inres)=d_t(j,inres)+0.5d0*d_a(j,inres)*d_time
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
adt=d_a_old(j,inres)*d_time
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
d_t(j,inres)=d_t_new(j,inres)+0.5d0*d_a(j,inres)*d_time
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
adt=(d_a_old(j,inres)+d_af_work(ind+j))*d_time
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
d_t(j,inres)=d_t_new(j,inres)+(0.5d0*(d_a(j,inres)
do j=1,3
accel(j)=aux(j)
enddo
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
accel(j)=accel(j)+d_a(j,i+nres)-d_a_old(j,i+nres)
enddo
enddo
endif
c Side chains
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
epdriftij=
& dabs((d_a(j,i+nres)-d_a_old(j,i+nres))*gxcart(j,i))
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
d_t(j,inres)=fact*d_t(j,inres)
do i=nnt,nct-1
do j=1,3
ind=ind+1
- if (itype(i).ne.21 .and. itype(i+1).ne.21) then
+ if (itype(i).ne.ntyp1 .and. itype(i+1).ne.ntyp1) then
d_t(j,i)=d_t_work(ind)
else
d_t(j,i)=0.0d0
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
ind=ind+1
d_t(j,i+nres)=d_t_work(ind)
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
dc_work(ind+j)=dc_old(j,i+nres)
d_t_work(ind+j)=d_t_old(j,i+nres)
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
dc(j,inres)=dc_work(ind+j)
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
d_t(j,inres)=d_t_work(ind+j)
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
dc_work(ind+j)=dc_old(j,i+nres)
d_t_work(ind+j)=d_t_old(j,i+nres)
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
dc(j,inres)=dc_work(ind+j)
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
d_t(j,inres)=d_t_work(ind+j)
#endif
endif
if (ntwe.ne.0) then
- if (mod(itime,ntwe).eq.0) call statout(itime)
+ if (mod(itime,ntwe).eq.0) then
+ call statout(itime)
+C call enerprint(potEcomp)
+C print *,itime,'AFM',Eafmforc,etot
+ endif
#ifdef VOUT
do j=1,3
v_work(j)=d_t(j,0)
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
ind=ind+1
v_work(ind)=d_t(j,i+nres)
#endif
endif
if (mod(itime,ntwx).eq.0) then
+ write(iout,*) 'time=',itime
+C call check_ecartint
+ call returnbox
write (tytul,'("time",f8.2)') totT
if(mdpdb) then
call hairpin(.true.,nharp,iharp)
endif
if (rattle) call rattle2
totT=totT+d_time
+ totTafm=totT
+C print *,totTafm,"TU?"
if (d_time.ne.d_time0) then
d_time=d_time0
#ifndef LANG0
potE=potEcomp(0)-potEcomp(20)
c potE=energia_short(0)+energia_long(0)
totT=totT+d_time
+ totTafm=totT
c Calculate the kinetic and the total energy and the kinetic temperature
call kinetic(EK)
totE=EK+potE
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
d_t(j,inres)=d_t(j,inres)+0.5d0*d_a(j,inres)*d_time
d_t(j,0)=d_t_old(j,0)+adt
enddo
do i=nnt,nct-1
+C SPYTAC ADAMA
+C do i=0,nres
do j=1,3
adt=d_a_old(j,i)*d_time
adt2=0.5d0*adt
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+C do i=0,nres
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
adt=d_a_old(j,inres)*d_time
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
d_t(j,inres)=d_t_new(j,inres)+0.5d0*d_a(j,inres)*d_time
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
adt=(d_a_old(j,inres)+d_af_work(ind+j))*d_time
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
d_t(j,inres)=d_t_new(j,inres)+(0.5d0*(d_a(j,inres)
c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j))
if (dabs(accel(j)).gt.dabs(accel_old(j))) then
dacc=dabs(accel(j)-accel_old(j))
+c write (iout,*) i,dacc
if (dacc.gt.amax) amax=dacc
endif
enddo
enddo
endif
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
c accel(j)=accel(j)+d_a(j,i+nres)-d_a_old(j,i+nres)
accel_old(j)=accel_old(j)+d_a_old(j,i+nres)
c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j))
if (dabs(accel(j)).gt.dabs(accel_old(j))) then
dacc=dabs(accel(j)-accel_old(j))
+c write (iout,*) "side-chain",i,dacc
if (dacc.gt.amax) amax=dacc
endif
enddo
enddo
endif
c Side chains
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
epdriftij=
& dabs((d_a(j,i+nres)-d_a_old(j,i+nres))*gxcart(j,i))
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
d_t(j,inres)=fact*d_t(j,inres)
stdforcp(i)=stdfp*dsqrt(gamp)
enddo
do i=nnt,nct
- stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamsc(itype(i)))
+ stdforcsc(i)=stdfsc(iabs(itype(i)))
+ & *dsqrt(gamsc(iabs(itype(i))))
enddo
endif
c Open the pdb file for snapshotshots
endif
call random_vel
totT=0.0d0
+ totTafm=totT
endif
else
c Generate initial velocities
& write(iout,*) "Initial velocities randomly generated"
call random_vel
totT=0.0d0
+CtotTafm is the variable for AFM time which eclipsed during
+ totTafm=totT
endif
c rest2name = prefix(:ilen(prefix))//'.rst'
if(me.eq.king.or..not.out1file)then
& "Time step reduced to",d_time,
& " because of too large initial acceleration."
endif
- if(me.eq.king.or..not.out1file)then
- write(iout,*) "Potential energy and its components"
- call enerprint(potEcomp)
+C if(me.eq.king.or..not.out1file)then
+C write(iout,*) "Potential energy and its components"
+C call enerprint(potEcomp)
c write(iout,*) (potEcomp(i),i=0,n_ene)
- endif
+C endif
potE=potEcomp(0)-potEcomp(20)
totE=EK+potE
itime=0
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
include 'COMMON.TIME1'
- double precision xv,sigv,lowb,highb
+ double precision xv,sigv,lowb,highb,vec_afm(3)
c Generate random velocities from Gaussian distribution of mean 0 and std of KT/m
c First generate velocities in the eigenspace of the G matrix
c write (iout,*) "Calling random_vel dimen dimen3",dimen,dimen3
lowb=-5*sigv
highb=5*sigv
d_t_work_new(ii)=anorm_distr(xv,sigv,lowb,highb)
+
c write (iout,*) "i",i," ii",ii," geigen",geigen(i),
c & " d_t_work_new",d_t_work_new(ii)
enddo
enddo
+C if (SELFGUIDE.gt.0) then
+C distance=0.0
+C do j=1,3
+C vec_afm(j)=c(j,afmend)-c(j,afmbeg)
+C distance=distance+vec_afm(j)**2
+C enddo
+C distance=dsqrt(distance)
+C do j=1,3
+C d_t_work_new(j+(afmbeg-1)*3)=-velAFMconst*vec_afm(j)/distance
+C d_t_work_new(j+(afmend-1)*3)=velAFMconst*vec_afm(j)/distance
+C write(iout,*) "myvel",d_t_work_new(j+(afmbeg-1)*3),
+C & d_t_work_new(j+(afmend-1)*3)
+C enddo
+
+C endif
+
c diagnostics
c Ek1=0.0d0
c ii=0
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
ind=ind+1
d_t(j,i+nres)=d_t_work(ind)
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
dc_work(ind+j)=dc_old(j,i+nres)
d_t_work(ind+j)=d_t_old(j,i+nres)
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
d_t(j,inres)=d_t_work(ind+j)
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
dc_work(ind+j)=dc_old(j,i+nres)
d_t_work(ind+j)=d_t_old(j,i+nres)
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
dc(j,inres)=dc_work(ind+j)
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
do j=1,3
d_t(j,inres)=d_t_work(ind+j)
ugamma_cache(i,ntwx_cache)=ugamma(i)
uscdiff_cache(i,ntwx_cache)=uscdiff(i)
enddo
-
+C print *,'przed returnbox'
+ call returnbox
+C call enerprint(remd_ene(0,i))
do i=1,nres*2
do j=1,3
c_cache(j,i,ntwx_cache)=c(j,i)
call rescale_weights(remd_t_bath(iex))
c write (iout,*) "0,i",remd_t_bath(iex)
-c call enerprint(remd_ene(0,i))
+ call enerprint(remd_ene(0,i))
call sum_energy(remd_ene(0,i),.false.)
c write (iout,*) "ene_i_iex",remd_ene(0,i)
if(me.eq.king) close(irest2)
return
end
-
+c------------------------------------------
potE=potEcomp(0)-potEcomp(20)
call cartgrad
totT=totT+d_time
+ totTafm=totT
c Calculate the kinetic and total energy and the kinetic temperature
call kinetic(EK)
#ifdef MPI
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
include 'COMMON.INTERACT'
- logical lprn
+ double precision e1(3),e2(3),e3(3)
+ logical lprn,perbox,fail
C Set lprn=.true. for debugging
lprn = .false.
+ perbox=.false.
+ fail=.false.
+ print *, 'enter chainbuild'
+ call chainbuild_cart
+ return
+ end
+#ifdef DEBUG
+ if (perbox) then
+ cost=dcos(theta(3))
+ sint=dsin(theta(3))
+ print *,'before refsys'
+ call refsys(2,3,4,e1,e2,e3,fail)
+ print *,'after refsys'
+ if (fail) then
+ e2(1)=0.0d0
+ e2(2)=1.0d0
+ e2(3)=0.0d0
+ endif
+ dc(1,0)=c(1,1)
+ dc(2,0)=c(2,1)
+ dc(3,0)=c(3,1)
+ print *,'dc',dc(1,0),dc(2,0),dc(3,0)
+ dc(1,1)=c(1,2)-c(1,1)
+ dc(2,1)=c(2,2)-c(2,1)
+ dc(3,1)=c(3,2)-c(3,1)
+ dc(1,2)=c(1,3)-c(1,2)
+ dc(2,2)=c(2,3)-c(2,2)
+ dc(3,2)=c(3,3)-c(3,2)
+ t(1,1,1)=e1(1)
+ t(1,2,1)=e1(2)
+ t(1,3,1)=e1(3)
+ t(2,1,1)=e2(1)
+ t(2,2,1)=e2(2)
+ t(2,3,1)=e2(3)
+ t(3,1,1)=e3(1)
+ t(3,2,1)=e3(2)
+ t(3,3,1)=e3(3)
+ veclen=0.0d0
+ do i=1,3
+ veclen=veclen+(c(i,2)-c(i,1))**2
+ enddo
+ veclen=sqrt(veclen)
+ r(1,1,1)= 1.0D0
+ r(1,2,1)= 0.0D0
+ r(1,3,1)= 0.0D0
+ r(2,1,1)= 0.0D0
+ r(2,2,1)= 1.0D0
+ r(2,3,1)= 0.0D0
+ r(3,1,1)= 0.0D0
+ r(3,2,1)= 0.0D0
+ r(3,3,1)= 1.0D0
+ do i=1,3
+ do j=1,3
+ rt(i,j,1)=t(i,j,1)
+ enddo
+ enddo
+ do i=1,3
+ do j=1,3
+ prod(i,j,1)=0.0D0
+ prod(i,j,2)=t(i,j,1)
+ enddo
+ prod(i,i,1)=1.0D0
+ enddo
+ call locate_side_chain(2)
+ do i=4,nres
+#ifdef OSF
+ theti=theta(i)
+ if (theti.ne.theti) theti=100.0
+ phii=phi(i)
+ if (phii.ne.phii) phii=180.0
+#else
+ theti=theta(i)
+ phii=phi(i)
+#endif
+ cost=dcos(theti)
+ sint=dsin(theti)
+ cosphi=dcos(phii)
+ sinphi=dsin(phii)
+* Define the matrices of the rotation about the virtual-bond valence angles
+* theta, T(i,j,k), virtual-bond dihedral angles gamma (miscalled PHI in this
+* program), R(i,j,k), and, the cumulative matrices of rotation RT
+ t(1,1,i-2)=-cost
+ t(1,2,i-2)=-sint
+ t(1,3,i-2)= 0.0D0
+ t(2,1,i-2)=-sint
+ t(2,2,i-2)= cost
+ t(2,3,i-2)= 0.0D0
+ t(3,1,i-2)= 0.0D0
+ t(3,2,i-2)= 0.0D0
+ t(3,3,i-2)= 1.0D0
+ r(1,1,i-2)= 1.0D0
+ r(1,2,i-2)= 0.0D0
+ r(1,3,i-2)= 0.0D0
+ r(2,1,i-2)= 0.0D0
+ r(2,2,i-2)=-cosphi
+ r(2,3,i-2)= sinphi
+ r(3,1,i-2)= 0.0D0
+ r(3,2,i-2)= sinphi
+ r(3,3,i-2)= cosphi
+ rt(1,1,i-2)=-cost
+ rt(1,2,i-2)=-sint
+ rt(1,3,i-2)=0.0D0
+ rt(2,1,i-2)=sint*cosphi
+ rt(2,2,i-2)=-cost*cosphi
+ rt(2,3,i-2)=sinphi
+ rt(3,1,i-2)=-sint*sinphi
+ rt(3,2,i-2)=cost*sinphi
+ rt(3,3,i-2)=cosphi
+ call matmult(prod(1,1,i-2),rt(1,1,i-2),prod(1,1,i-1))
+ do j=1,3
+ dc_norm(j,i-1)=prod(j,1,i-1)
+ dc(j,i-1)=vbld(i)*prod(j,1,i-1)
+ enddo
+ call locate_side_chain(i-1)
+ enddo
+ else
C
C Define the origin and orientation of the coordinate system and locate the
C first three CA's and SC(2).
1212 format (a3,'(',i3,')',2(f10.5,2f10.2))
endif
-
+ endif
return
end
+#endif
c-------------------------------------------------------------------------
subroutine orig_frame
C
dc_norm(3,1)=0.0D0
do j=1,3
dc_norm(j,2)=prod(j,1,2)
- dc(j,2)=vbld(3)*prod(j,1,2)
- c(j,3)=c(j,2)+dc(j,2)
+ dc(j,2)=vbld(3)*prod(j,1,2)
+ c(j,3)=c(j,2)+dc(j,2)
enddo
call locate_side_chain(2)
return
enddo
return
end
+c------------------------------------------
+ subroutine returnbox
+ include 'DIMENSIONS'
+#ifdef MPI
+ include 'mpif.h'
+#endif
+ include 'COMMON.CONTROL'
+ include 'COMMON.VAR'
+ include 'COMMON.MD'
+#ifndef LANG0
+ include 'COMMON.LANGEVIN'
+#else
+ include 'COMMON.LANGEVIN.lang0'
+#endif
+ include 'COMMON.CHAIN'
+ include 'COMMON.DERIV'
+ include 'COMMON.GEO'
+ include 'COMMON.LOCAL'
+ include 'COMMON.INTERACT'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.NAMES'
+ include 'COMMON.TIME1'
+ include 'COMMON.REMD'
+ include 'COMMON.SETUP'
+ include 'COMMON.MUCA'
+ include 'COMMON.HAIRPIN'
+C change suggested by Ana - begin
+ integer allareout
+C change suggested by Ana - end
+ j=1
+ chain_beg=1
+C do i=1,nres
+C write(*,*) 'initial', i,j,c(j,i)
+C enddo
+C change suggested by Ana - begin
+ allareout=1
+C change suggested by Ana -end
+ do i=1,nres-1
+ if ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1)) then
+ chain_end=i
+ if (allareout.eq.1) then
+ ireturnval=int(c(j,i)/boxxsize)
+ if (c(j,i).le.0) ireturnval=ireturnval-1
+ do k=chain_beg,chain_end
+ c(j,k)=c(j,k)-ireturnval*boxxsize
+ c(j,k+nres)=c(j,k+nres)-ireturnval*boxxsize
+ enddo
+C Suggested by Ana
+ if (chain_beg.eq.1)
+ & dc_old(1,0)=dc_old(1,0)-ireturnval*boxxsize
+C Suggested by Ana -end
+ endif
+ chain_beg=i+1
+ allareout=1
+ else
+ if (int(c(j,i)/boxxsize).eq.0) allareout=0
+ endif
+ enddo
+ if (allareout.eq.1) then
+ ireturnval=int(c(j,i)/boxxsize)
+ if (c(j,i).le.0) ireturnval=ireturnval-1
+ do k=chain_beg,nres
+ c(j,k)=c(j,k)-ireturnval*boxxsize
+ c(j,k+nres)=c(j,k+nres)-ireturnval*boxxsize
+ enddo
+ endif
+C NO JUMP
+C do i=1,nres
+C write(*,*) 'befor no jump', i,j,c(j,i)
+C enddo
+ nojumpval=0
+ do i=2,nres
+ if (itype(i).eq.ntyp1 .and. itype(i-1).eq.ntyp1) then
+ difference=abs(c(j,i-1)-c(j,i))
+C print *,'diff', difference
+ if (difference.gt.boxxsize/2.0) then
+ if (c(j,i-1).gt.c(j,i)) then
+ nojumpval=1
+ else
+ nojumpval=-1
+ endif
+ else
+ nojumpval=0
+ endif
+ endif
+ c(j,i)=c(j,i)+nojumpval*boxxsize
+ c(j,i+nres)=c(j,i+nres)+nojumpval*boxxsize
+ enddo
+ nojumpval=0
+ do i=2,nres
+ if (itype(i).eq.ntyp1 .and. itype(i-1).eq.ntyp1) then
+ difference=abs(c(j,i-1)-c(j,i))
+ if (difference.gt.boxxsize/2.0) then
+ if (c(j,i-1).gt.c(j,i)) then
+ nojumpval=1
+ else
+ nojumpval=-1
+ endif
+ else
+ nojumpval=0
+ endif
+ endif
+ c(j,i)=c(j,i)+nojumpval*boxxsize
+ c(j,i+nres)=c(j,i+nres)+nojumpval*boxxsize
+ enddo
+
+C do i=1,nres
+C write(*,*) 'after no jump', i,j,c(j,i)
+C enddo
+
+C NOW Y dimension
+C suggesed by Ana begins
+ allareout=1
+C suggested by Ana ends
+ j=2
+ chain_beg=1
+ do i=1,nres-1
+ if ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1)) then
+ chain_end=i
+ if (allareout.eq.1) then
+ ireturnval=int(c(j,i)/boxysize)
+ if (c(j,i).le.0) ireturnval=ireturnval-1
+ do k=chain_beg,chain_end
+ c(j,k)=c(j,k)-ireturnval*boxysize
+ c(j,k+nres)=c(j,k+nres)-ireturnval*boxysize
+ enddo
+C Suggested by Ana
+ if (chain_beg.eq.1)
+ & dc_old(1,0)=dc_old(1,0)-ireturnval*boxxsize
+C Suggested by Ana -end
+ endif
+ chain_beg=i+1
+ allareout=1
+ else
+ if (int(c(j,i)/boxysize).eq.0) allareout=0
+ endif
+ enddo
+ if (allareout.eq.1) then
+ ireturnval=int(c(j,i)/boxysize)
+ if (c(j,i).le.0) ireturnval=ireturnval-1
+ do k=chain_beg,nres
+ c(j,k)=c(j,k)-ireturnval*boxysize
+ c(j,k+nres)=c(j,k+nres)-ireturnval*boxysize
+ enddo
+ endif
+ nojumpval=0
+ do i=2,nres
+ if (itype(i).eq.ntyp1 .and. itype(i-1).eq.ntyp1) then
+ difference=abs(c(j,i-1)-c(j,i))
+ if (difference.gt.boxysize/2.0) then
+ if (c(j,i-1).gt.c(j,i)) then
+ nojumpval=1
+ else
+ nojumpval=-1
+ endif
+ else
+ nojumpval=0
+ endif
+ endif
+ c(j,i)=c(j,i)+nojumpval*boxysize
+ c(j,i+nres)=c(j,i+nres)+nojumpval*boxysize
+ enddo
+ nojumpval=0
+ do i=2,nres
+ if (itype(i).eq.ntyp1 .and. itype(i-1).eq.ntyp1) then
+ difference=abs(c(j,i-1)-c(j,i))
+ if (difference.gt.boxysize/2.0) then
+ if (c(j,i-1).gt.c(j,i)) then
+ nojumpval=1
+ else
+ nojumpval=-1
+ endif
+ else
+ nojumpval=0
+ endif
+ endif
+ c(j,i)=c(j,i)+nojumpval*boxysize
+ c(j,i+nres)=c(j,i+nres)+nojumpval*boxysize
+ enddo
+C Now Z dimension
+C Suggested by Ana -begins
+ allareout=1
+C Suggested by Ana -ends
+ j=3
+ chain_beg=1
+ do i=1,nres-1
+ if ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1)) then
+ chain_end=i
+ if (allareout.eq.1) then
+ ireturnval=int(c(j,i)/boxysize)
+ if (c(j,i).le.0) ireturnval=ireturnval-1
+ do k=chain_beg,chain_end
+ c(j,k)=c(j,k)-ireturnval*boxzsize
+ c(j,k+nres)=c(j,k+nres)-ireturnval*boxzsize
+ enddo
+C Suggested by Ana
+ if (chain_beg.eq.1)
+ & dc_old(1,0)=dc_old(1,0)-ireturnval*boxxsize
+C Suggested by Ana -end
+ endif
+ chain_beg=i+1
+ allareout=1
+ else
+ if (int(c(j,i)/boxzsize).eq.0) allareout=0
+ endif
+ enddo
+ if (allareout.eq.1) then
+ ireturnval=int(c(j,i)/boxzsize)
+ if (c(j,i).le.0) ireturnval=ireturnval-1
+ do k=chain_beg,nres
+ c(j,k)=c(j,k)-ireturnval*boxzsize
+ c(j,k+nres)=c(j,k+nres)-ireturnval*boxzsize
+ enddo
+ endif
+ nojumpval=0
+ do i=2,nres
+ if (itype(i).eq.ntyp1 .and. itype(i-1).eq.ntyp1) then
+ difference=abs(c(j,i-1)-c(j,i))
+ if (difference.gt.(boxzsize/2.0)) then
+ if (c(j,i-1).gt.c(j,i)) then
+ nojumpval=1
+ else
+ nojumpval=-1
+ endif
+ else
+ nojumpval=0
+ endif
+ endif
+ c(j,i)=c(j,i)+nojumpval*boxzsize
+ c(j,i+nres)=c(j,i+nres)+nojumpval*boxzsize
+ enddo
+ nojumpval=0
+ do i=2,nres
+ if (itype(i).eq.ntyp1 .and. itype(i-1).eq.ntyp1) then
+ difference=abs(c(j,i-1)-c(j,i))
+ if (difference.gt.boxzsize/2.0) then
+ if (c(j,i-1).gt.c(j,i)) then
+ nojumpval=1
+ else
+ nojumpval=-1
+ endif
+ else
+ nojumpval=0
+ endif
+ endif
+ c(j,i)=c(j,i)+nojumpval*boxzsize
+ c(j,i+nres)=c(j,i+nres)+nojumpval*boxzsize
+ enddo
+
+ return
+ end
+
integer uiparm(1)
double precision urparm(1)
external fdum
- r_cut=2.0d0
- rlambd=0.3d0
+c r_cut=2.0d0
+c rlambd=0.3d0
icg=1
nf=0
nfl=0
c call intcartderiv
c call checkintcartgrad
call zerograd
- aincr=1.0D-4
+ aincr=1.0D-5
write(iout,*) 'Calling CHECK_ECARTINT.'
nf=0
icall=0
c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
dc(j,i)=ddc(j)-aincr
call chainbuild_cart
+C print *,c(j,i)
c call int_from_cart1(.false.)
if (.not.split_ene) then
call etotal(energia1(0))
C DO NOT EDIT THIS FILE - IT HAS BEEN GENERATED BY COMPINFO.C
-<<<<<<< HEAD
-C 0 40360 9
+C 0 40376 1
subroutine cinfo
include 'COMMON.IOUNITS'
write(iout,*)'++++ Compile info ++++'
- write(iout,*)'Version 0.40360 build 9'
- write(iout,*)'compiled Fri Jan 23 21:00:08 2015'
- write(iout,*)'compiled by adam@mmka'
-=======
-C 0 40360 1
- subroutine cinfo
- include 'COMMON.IOUNITS'
- write(iout,*)'++++ Compile info ++++'
- write(iout,*)'Version 0.40360 build 1'
- write(iout,*)'compiled Wed Jan 7 10:41:15 2015'
+ write(iout,*)'Version 0.40376 build 1'
+ write(iout,*)'compiled Tue Oct 6 15:04:07 2015'
write(iout,*)'compiled by czarek@piasek4'
->>>>>>> 9a082c1ab203120d8e865971546d473fb146fcdc
write(iout,*)'OS name: Linux '
- write(iout,*)'OS release: 3.2.0-72-generic '
+ write(iout,*)'OS release: 3.2.0-70-generic '
write(iout,*)'OS version:',
- & ' #107-Ubuntu SMP Thu Nov 6 14:24:01 UTC 2014 '
+ & ' #105-Ubuntu SMP Wed Sep 24 19:49:16 UTC 2014 '
write(iout,*)'flags:'
-<<<<<<< HEAD
- write(iout,*)'INSTALL_DIR = /users/software/mpich-1.2.7p1_int...'
-=======
write(iout,*)'INSTALL_DIR = /users/software/mpich2-1.4.1p1_in...'
->>>>>>> 9a082c1ab203120d8e865971546d473fb146fcdc
write(iout,*)'FC= ifort'
write(iout,*)'OPT = -O3 -ip '
write(iout,*)'FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include '
ncont=0
kkk=3
do i=nnt+kkk,nct
- iti=itype(i)
+ iti=iabs(itype(i))
do j=nnt,i-kkk
- itj=itype(j)
+ itj=iabs(itype(j))
if (ipot.ne.4) then
c rcomp=sigmaii(iti,itj)+1.0D0
rcomp=facont*sigmaii(iti,itj)
c write (iout,*)'i',i,' iharp',(iharp(k,i),k=1,4)
c enddo
if (lprint) then
- write (iout,*) "Hairpins:"
+ write (iout,*) "Hairpins:",nharp
do i=1,nharp
i1=iharp(1,i)
j1=iharp(2,i)
ees=0.0
evdw=0.0
do 1 i=nnt,nct-2
- if (itype(i).eq.21 .or. itype(i+1).eq.21) goto 1
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) goto 1
xi=c(1,i)
yi=c(2,i)
zi=c(3,i)
xmedi=xi+0.5*dxi
ymedi=yi+0.5*dyi
zmedi=zi+0.5*dzi
+ xmedi=mod(xmedi,boxxsize)
+ if (xmedi.lt.0) xmedi=xmedi+boxxsize
+ ymedi=mod(ymedi,boxysize)
+ if (ymedi.lt.0) ymedi=ymedi+boxysize
+ zmedi=mod(zmedi,boxzsize)
+ if (zmedi.lt.0) zmedi=zmedi+boxzsize
do 4 j=i+2,nct-1
- if (itype(j).eq.21 .or. itype(j+1).eq.21) goto 4
+ if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) goto 4
ind=ind+1
iteli=itel(i)
itelj=itel(j)
dxj=c(1,j+1)-c(1,j)
dyj=c(2,j+1)-c(2,j)
dzj=c(3,j+1)-c(3,j)
- xj=c(1,j)+0.5*dxj-xmedi
- yj=c(2,j)+0.5*dyj-ymedi
- zj=c(3,j)+0.5*dzj-zmedi
+ xj=c(1,j)+0.5*dxj
+ yj=c(2,j)+0.5*dyj
+ zj=c(3,j)+0.5*dzj
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ isubchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ isubchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (isubchap.eq.1) then
+ xj=xj_temp-xmedi
+ yj=yj_temp-ymedi
+ zj=zj_temp-zmedi
+ else
+ xj=xj_safe-xmedi
+ yj=yj_safe-ymedi
+ zj=zj_safe-zmedi
+ endif
+ rij=xj*xj+yj*yj+zj*zj
+ sss=sscale(sqrt(rij))
+ sssgrad=sscagrad(sqrt(rij))
rrmij=1.0/(xj*xj+yj*yj+zj*zj)
rmij=sqrt(rrmij)
r3ij=rrmij*rmij
econt(ncont)=eesij
endif
ees=ees+eesij
- evdw=evdw+evdwij
+ evdw=evdw+evdwij*sss
4 continue
1 continue
if (lprint) then
double precision p1,p2
external freeres
- if(.not.dccart) call chainbuild
+cc???? if(.not.dccart) call chainbuild
cd call write_pdb(99,'sec structure',0d0)
ncont=0
nbfrag=0
double precision function sscale(r)
double precision r,gamm
include "COMMON.SPLITELE"
+ include "COMMON.CHAIN"
if(r.lt.r_cut-rlamb) then
sscale=1.0d0
else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
return
end
C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+ double precision function sscagrad(r)
+ double precision r,gamm
+ include "COMMON.SPLITELE"
+ include "COMMON.CHAIN"
+ if(r.lt.r_cut-rlamb) then
+ sscagrad=0.0d0
+ else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
+ gamm=(r-(r_cut-rlamb))/rlamb
+ sscagrad=gamm*(6*gamm-6.0d0)/rlamb
+ else
+ sscagrad=0.0d0
+ endif
+ return
+ end
+C-----------------------------------------------------------------------
+
subroutine elj_long(evdw)
C
C This subroutine calculates the interaction energy of nonbonded side chains
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
+ xmedi=mod(xmedi,boxysize)
+ if (xmedi.lt.0) xmedi=xmedi+boxxsize
+ ymedi=mod(ymedi,boxysize)
+ if (ymedi.lt.0) ymedi=ymedi+boxysize
+ zmedi=mod(zmedi,boxzsize)
+ if (zmedi.lt.0) zmedi=zmedi+boxzsize
num_conti=0
c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
do j=ielstart(i),ielend(i)
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
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ isubchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ isubchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (isubchap.eq.1) then
+ xj=xj_temp-xmedi
+ yj=yj_temp-ymedi
+ zj=zj_temp-zmedi
+ else
+ xj=xj_safe-xmedi
+ yj=yj_safe-ymedi
+ zj=zj_safe-zmedi
+ endif
+ rij=xj*xj+yj*yj+zj*zj
rrmij=1.0D0/rij
rij=dsqrt(rij)
sss=sscale(rij/rpp(iteli,itelj))
+ sssgrad=sscagrad(sqrt(rij))
if (sss.lt.1.0d0) then
rmij=1.0D0/rij
r3ij=rrmij*rmij
C Calculate contributions to the Cartesian gradient.
C
facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
+ ggg(1)=facvdw*xj-sssgrad*rmij*evdwij*xj
+ ggg(2)=facvdw*yj-sssgrad*rmij*evdwij*yj
+ ggg(3)=facvdw*zj-sssgrad*rmij*evdwij*zj
do k=1,3
ghalf=0.5D0*ggg(k)
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
+ xmedi=mod(xmedi,boxysize)
+ if (xmedi.lt.0) xmedi=xmedi+boxxsize
+ ymedi=mod(ymedi,boxysize)
+ if (ymedi.lt.0) ymedi=ymedi+boxysize
+ zmedi=mod(zmedi,boxzsize)
+ if (zmedi.lt.0) zmedi=zmedi+boxzsize
num_conti=0
c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
do j=ielstart(i),ielend(i)
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
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ isubchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ isubchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (isubchap.eq.1) then
+ xj=xj_temp-xmedi
+ yj=yj_temp-ymedi
+ zj=zj_temp-zmedi
+ else
+ xj=xj_safe-xmedi
+ yj=yj_safe-ymedi
+ zj=zj_safe-zmedi
+ endif
rij=xj*xj+yj*yj+zj*zj
rrmij=1.0D0/rij
rij=dsqrt(rij)
sss=sscale(rij/rpp(iteli,itelj))
+ sssgrad=sscagrad(sqrt(rij))
if (sss.gt.0.0d0) then
rmij=1.0D0/rij
r3ij=rrmij*rmij
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
+ ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
+ ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
+ ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
do k=1,3
ghalf=0.5D0*ggg(k)
C-----------------------------------------------------------------------
+ double precision function sscalelip(r)
+ double precision r,gamm
+ include "COMMON.SPLITELE"
+C if(r.lt.r_cut-rlamb) then
+C sscale=1.0d0
+C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
+C gamm=(r-(r_cut-rlamb))/rlamb
+ sscalelip=1.0d0+r*r*(2*r-3.0d0)
+C else
+C sscale=0d0
+C endif
+ return
+ end
+C-----------------------------------------------------------------------
+ double precision function sscagradlip(r)
+ double precision r,gamm
+ include "COMMON.SPLITELE"
+C if(r.lt.r_cut-rlamb) then
+C sscagrad=0.0d0
+C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
+C gamm=(r-(r_cut-rlamb))/rlamb
+ sscagradlip=r*(6*r-6.0d0)
+C else
+C sscagrad=0.0d0
+C endif
+ return
+ end
+
+C-----------------------------------------------------------------------
double precision function sscale(r)
double precision r,gamm
include "COMMON.SPLITELE"
return
end
C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+ double precision function sscagrad(r)
+ double precision r,gamm
+ include "COMMON.SPLITELE"
+ if(r.lt.r_cut-rlamb) then
+ sscagrad=0.0d0
+ else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
+ gamm=(r-(r_cut-rlamb))/rlamb
+ sscagrad=gamm*(6*gamm-6.0d0)/rlamb
+ else
+ sscagrad=0.0d0
+ endif
+ return
+ end
+C-----------------------------------------------------------------------
subroutine elj_long(evdw)
C
C This subroutine calculates the interaction energy of nonbonded side chains
evdw=0.0D0
do i=iatsc_s,iatsc_e
itypi=itype(i)
- if (itypi.eq.21) cycle
+ if (itypi.eq.ntyp1) cycle
itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
cd & 'iend=',iend(i,iint)
do j=istart(i,iint),iend(i,iint)
itypj=itype(j)
- if (itypj.eq.21) cycle
+ if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
rrij=1.0D0/rij
eps0ij=eps(itypi,itypj)
fac=rrij**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa
+ e2=fac*bb
evdwij=e1+e2
evdw=evdw+(1.0d0-sss)*evdwij
C
evdw=0.0D0
do i=iatsc_s,iatsc_e
itypi=itype(i)
- if (itypi.eq.21) cycle
+ if (itypi.eq.ntyp1) cycle
itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
cd & 'iend=',iend(i,iint)
do j=istart(i,iint),iend(i,iint)
itypj=itype(j)
- if (itypj.eq.21) cycle
+ if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
rrij=1.0D0/rij
eps0ij=eps(itypi,itypj)
fac=rrij**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa
+ e2=fac*bb
evdwij=e1+e2
evdw=evdw+sss*evdwij
C
evdw=0.0D0
do i=iatsc_s,iatsc_e
itypi=itype(i)
- if (itypi.eq.21) cycle
+ if (itypi.eq.ntyp1) cycle
itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
itypj=itype(j)
- if (itypj.eq.21) cycle
+ if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
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)
+ e1=fac*fac*aa
+ e2=fac*bb
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)
evdw=0.0D0
do i=iatsc_s,iatsc_e
itypi=itype(i)
- if (itypi.eq.21) cycle
+ if (itypi.eq.ntyp1) cycle
itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
itypj=itype(j)
- if (itypj.eq.21) cycle
+ if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
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)
+ e1=fac*fac*aa
+ e2=fac*bb
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)
ind=0
do i=iatsc_s,iatsc_e
itypi=itype(i)
- if (itypi.eq.21) cycle
+ if (itypi.eq.ntyp1) cycle
itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
itypj=itype(j)
- if (itypj.eq.21) cycle
+ if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
chi1=chi(itypi,itypj)
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)
+ e1=fac*fac*aa
+ e2=fac*bb
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)
+ sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+ epsi=bb**2/aa
cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
cd & restyp(itypi),i,restyp(itypj),j,
cd & epsi,sigm,chi1,chi2,chip1,chip2,
ind=0
do i=iatsc_s,iatsc_e
itypi=itype(i)
- if (itypi.eq.21) cycle
+ if (itypi.eq.ntyp1) cycle
itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
itypj=itype(j)
- if (itypj.eq.21) cycle
+ if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
chi1=chi(itypi,itypj)
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)
+ e1=fac*fac*aa
+ e2=fac*bb
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)
+ sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+ epsi=bb**2/aa
cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
cd & restyp(itypi),i,restyp(itypj),j,
cd & epsi,sigm,chi1,chi2,chip1,chip2,
ind=0
do i=iatsc_s,iatsc_e
itypi=itype(i)
- if (itypi.eq.21) cycle
+ if (itypi.eq.ntyp1) cycle
itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
itypj=itype(j)
- if (itypj.eq.21) cycle
+ if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
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
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.gt.bordlipbot)
+ &.and.(zj.lt.bordliptop)) then
+C the energy transfer exist
+ if (zj.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((positi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipj=1.0d0
+ ssgradlipj=0.0
+ endif
+ else
+ sslipj=0.0d0
+ ssgradlipj=0.0
+ endif
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
+
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
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)))
-
+ sssgrad=sscagrad((1.0d0/rij)/sigmaii(itypi,itypj))
if (sss.lt.1.0d0) then
C Calculate angle-dependent terms of energy and contributions to their
c---------------------------------------------------------------
rij_shift=1.0D0/rij_shift
fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa
+ e2=fac*bb
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)
+ sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+ epsi=bb**2/aa
write (iout,'(2(a3,i3,2x),17(0pf7.3))')
& restyp(itypi),i,restyp(itypj),j,
& epsi,sigm,chi1,chi2,chip1,chip2,
fac=-expon*(e1+evdwij)*rij_shift
sigder=fac*sigder
fac=rij*fac
+ fac=fac+evdwij/(1.0-sss)*(-sssgrad)/sigmaii(itypi,itypj)*rij
c fac=0.0d0
C Calculate the radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
+ gg_lipi(3)=ssgradlipi*evdwij
+ gg_lipj(3)=ssgradlipj*evdwij
C Calculate angular part of the gradient.
call sc_grad_scale(1.0d0-sss)
endif
ind=0
do i=iatsc_s,iatsc_e
itypi=itype(i)
- if (itypi.eq.21) cycle
+ if (itypi.eq.ntyp1) cycle
itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
itypj=itype(j)
- if (itypj.eq.21) cycle
+ if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
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
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.gt.bordlipbot)
+ &.and.(zj.lt.bordliptop)) then
+C the energy transfer exist
+ if (zj.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((positi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipj=1.0d0
+ ssgradlipj=0.0
+ endif
+ else
+ sslipj=0.0d0
+ ssgradlipj=0.0
+ endif
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
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)))
-
+ sssgrad=sscagrad((1.0d0/rij)/sigmaii(itypi,itypj))
if (sss.gt.0.0d0) then
C Calculate angle-dependent terms of energy and contributions to their
c---------------------------------------------------------------
rij_shift=1.0D0/rij_shift
fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa
+ e2=fac*bb
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)
+ sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+ epsi=bb**2/aa
write (iout,'(2(a3,i3,2x),17(0pf7.3))')
& restyp(itypi),i,restyp(itypj),j,
& epsi,sigm,chi1,chi2,chip1,chip2,
fac=-expon*(e1+evdwij)*rij_shift
sigder=fac*sigder
fac=rij*fac
+ fac=fac+evdwij/sss*sssgrad/sigmaii(itypi,itypj)*rij
c fac=0.0d0
C Calculate the radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
+ gg_lipi(3)=ssgradlipi*evdwij
+ gg_lipj(3)=ssgradlipj*evdwij
C Calculate angular part of the gradient.
call sc_grad_scale(sss)
endif
ind=0
do i=iatsc_s,iatsc_e
itypi=itype(i)
- if (itypi.eq.21) cycle
+ if (itypi.eq.ntyp1) cycle
itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
itypj=itype(j)
- if (itypj.eq.21) cycle
+ if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
sig0ij=sigma(itypi,itypj)
c---------------------------------------------------------------
rij_shift=1.0D0/rij_shift
fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa
+ e2=fac*bb
evdwij=eps1*eps2rt*eps3rt*(e1+e2)
eps2der=evdwij*eps3rt
eps3der=evdwij*eps2rt
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)
+ sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+ epsi=bb**2/aa
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),
ind=0
do i=iatsc_s,iatsc_e
itypi=itype(i)
- if (itypi.eq.21) cycle
+ if (itypi.eq.ntyp1) cycle
itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
itypj=itype(j)
- if (itypj.eq.21) cycle
+ if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
sig0ij=sigma(itypi,itypj)
c---------------------------------------------------------------
rij_shift=1.0D0/rij_shift
fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa
+ e2=fac*bb
evdwij=eps1*eps2rt*eps3rt*(e1+e2)
eps2der=evdwij*eps3rt
eps3der=evdwij*eps2rt
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)
+ sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+ epsi=bb**2/aa
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),
enddo
c write (iout,*) "gg",(gg(k),k=1,3)
do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
+ gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
& +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
& +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
+ gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
& +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
& +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac
c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
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)
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(k)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(k)
enddo
return
end
cd enddo
cd call check_vecgrad
cd stop
+C print *,"WCHODZE3"
if (icheckgrad.eq.1) then
do i=1,nres-1
fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
C Loop over i,i+2 and i,i+3 pairs of the peptide groups
C
do i=iturn3_start,iturn3_end
- if (itype(i).eq.21 .or. itype(i+1).eq.21
- & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21) cycle
+ if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
+ & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1
+ & .or. itype(i-1).eq.ntyp1
+ & .or. itype(i+4).eq.ntyp1
+ & ) cycle
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
+ xmedi=mod(xmedi,boxxsize)
+ if (xmedi.lt.0) xmedi=xmedi+boxxsize
+ ymedi=mod(ymedi,boxysize)
+ if (ymedi.lt.0) ymedi=ymedi+boxysize
+ zmedi=mod(zmedi,boxzsize)
+ if (zmedi.lt.0) zmedi=zmedi+boxzsize
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
- if (itype(i).eq.21 .or. itype(i+1).eq.21
- & .or. itype(i+3).eq.21
- & .or. itype(i+4).eq.21) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+ & .or. itype(i+3).eq.ntyp1
+ & .or. itype(i+4).eq.ntyp1
+ & .or. itype(i+5).eq.ntyp1
+ & .or. itype(i-1).eq.ntyp1
+ & ) cycle
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
+ xmedi=mod(xmedi,boxxsize)
+ if (xmedi.lt.0) xmedi=xmedi+boxxsize
+ ymedi=mod(ymedi,boxysize)
+ if (ymedi.lt.0) ymedi=ymedi+boxysize
+ zmedi=mod(zmedi,boxzsize)
+ if (zmedi.lt.0) zmedi=zmedi+boxzsize
num_conti=num_cont_hb(i)
call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
- if (wturn4.gt.0.0d0 .and. itype(i+2).ne.21)
+ if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
& call eturn4(i,eello_turn4)
num_cont_hb(i)=num_conti
enddo ! i
c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
c
do i=iatel_s,iatel_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+ & .or. itype(i+2).eq.ntyp1
+ & .or. itype(i-1).eq.ntyp1
+ &) cycle
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
+ xmedi=mod(xmedi,boxxsize)
+ if (xmedi.lt.0) xmedi=xmedi+boxxsize
+ ymedi=mod(ymedi,boxysize)
+ if (ymedi.lt.0) ymedi=ymedi+boxysize
+ zmedi=mod(zmedi,boxzsize)
+ if (zmedi.lt.0) zmedi=zmedi+boxzsize
c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
num_conti=num_cont_hb(i)
do j=ielstart(i),ielend(i)
- if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
+ if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
+ & .or.itype(j+2).eq.ntyp1
+ & .or.itype(j-1).eq.ntyp1
+ &) cycle
call eelecij_scale(i,j,ees,evdw1,eel_loc)
enddo ! j
num_cont_hb(i)=num_conti
& 0.0d0,0.0d0,1.0d0/
c time00=MPI_Wtime()
cd write (iout,*) "eelecij",i,j
+C print *,"WCHODZE2"
ind=ind+1
iteli=itel(i)
itelj=itel(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
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ isubchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ isubchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (isubchap.eq.1) then
+ xj=xj_temp-xmedi
+ yj=yj_temp-ymedi
+ zj=zj_temp-zmedi
+ else
+ xj=xj_safe-xmedi
+ yj=yj_safe-ymedi
+ zj=zj_safe-zmedi
+ endif
+
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))
-
+ sssgrad=sscagrad(rij/rpp(iteli,itelj))
r3ij=rrmij*rmij
r6ij=r3ij*r3ij
cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
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
+ ggg(1)=facvdw*xj-sssgrad*rmij*evdwij*xj/rpp(iteli,itelj)
+ ggg(2)=facvdw*yj-sssgrad*rmij*evdwij*yj/rpp(iteli,itelj)
+ ggg(3)=facvdw*zj-sssgrad*rmij*evdwij*zj/rpp(iteli,itelj)
c do k=1,3
c ghalf=0.5D0*ggg(k)
c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
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
+C ggg(1)=facvdw*xj
+C ggg(2)=facvdw*yj
+C ggg(3)=facvdw*zj
+ ggg(1)=facvdw*xj-sssgrad*rmij*evdwij*xj/rpp(iteli,itelj)
+ ggg(2)=facvdw*yj-sssgrad*rmij*evdwij*yj/rpp(iteli,itelj)
+ ggg(3)=facvdw*zj-sssgrad*rmij*evdwij*zj/rpp(iteli,itelj)
do k=1,3
gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
double precision scal_el /0.5d0/
#endif
evdw1=0.0D0
+C print *,"WCHODZE"
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
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle
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
+ xmedi=mod(xmedi,boxxsize)
+ if (xmedi.lt.0) xmedi=xmedi+boxxsize
+ ymedi=mod(ymedi,boxysize)
+ if (ymedi.lt.0) ymedi=ymedi+boxysize
+ zmedi=mod(zmedi,boxzsize)
+ if (zmedi.lt.0) zmedi=zmedi+boxzsize
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)
- if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
+ if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
ind=ind+1
iteli=itel(i)
itelj=itel(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
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ isubchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ isubchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (isubchap.eq.1) then
+ xj=xj_temp-xmedi
+ yj=yj_temp-ymedi
+ zj=zj_temp-zmedi
+ else
+ xj=xj_safe-xmedi
+ yj=yj_safe-ymedi
+ zj=zj_safe-zmedi
+ endif
rij=xj*xj+yj*yj+zj*zj
rrmij=1.0D0/rij
rij=dsqrt(rij)
sss=sscale(rij/rpp(iteli,itelj))
+ sssgrad=sscagrad(rij/rpp(iteli,itelj))
if (sss.gt.0.0d0) then
rmij=1.0D0/rij
r3ij=rrmij*rmij
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
+ ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj/rpp(iteli,itelj)
+ ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj/rpp(iteli,itelj)
+ ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj/rpp(iteli,itelj)
+C ggg(1)=facvdw*xj
+C ggg(2)=facvdw*yj
+C ggg(3)=facvdw*zj
do k=1,3
gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
dimension ggg(3)
evdw2=0.0D0
evdw2_14=0.0d0
-cd print '(a)','Enter ESCP'
+CD print '(a)','Enter ESCP KURWA'
cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
do i=iatscp_s,iatscp_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
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))
-
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
itypj=itype(j)
- if (itypj.eq.21) cycle
+ if (itypj.eq.ntyp1) cycle
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
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
+
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
-
+ sssgrad=sscagrad(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)
C
C Calculate contributions to the gradient in the virtual-bond and SC vectors.
C
+
fac=-(evdwij+e1)*rrij*(1.0d0-sss)
+ fac=fac-(evdwij)*sssgrad*dsqrt(rrij)/rscp(itypj,iteli)
ggg(1)=xj*fac
ggg(2)=yj*fac
ggg(3)=zj*fac
cd print '(a)','Enter ESCP'
cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
do i=iatscp_s,iatscp_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
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))
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
itypj=itype(j)
- if (itypj.eq.21) cycle
+ if (itypj.eq.ntyp1) cycle
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
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-
sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
-
+ sssgrad=sscagrad(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
if (sss.gt.0.0d0) then
fac=rrij**expon2
C Calculate contributions to the gradient in the virtual-bond and SC vectors.
C
fac=-(evdwij+e1)*rrij*sss
+ fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/rscp(itypj,iteli)
ggg(1)=xj*fac
ggg(2)=yj*fac
ggg(3)=zj*fac
include 'COMMON.MD'
include 'COMMON.CONTROL'
include 'COMMON.TIME1'
+ include 'COMMON.SPLITELE'
#ifdef MPI
c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
c & " nfgtasks",nfgtasks
time_Bcastw=time_Bcastw+MPI_Wtime()-time00
c call chainbuild_cart
endif
-C print *,'Processor',myrank,' calling etotal ipot=',ipot
+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
C Compute the side-chain and electrostatic interaction energy
C
-C write(iout,*) "zaczynam liczyc energie"
+C print *,ipot
goto (101,102,103,104,105,106) ipot
C Lennard-Jones potential.
101 call elj(evdw)
goto 107
C Gay-Berne potential (shifted LJ, angular dependence).
104 call egb(evdw)
+C print *,"bylem w egb"
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 write(iout,*) "skonczylem ipoty"
-
C
C Calculate electrostatic (H-bonding) energy of the main chain.
C
107 continue
-C write(iout,*) "skonczylem ipoty"
cmc
cmc Sep-06: egb takes care of dynamic ss bonds too
cmc
eello_turn4=0.0d0
endif
else
-c write (iout,*) "Soft-spheer ELEC potential"
+ write (iout,*) "Soft-spheer ELEC potential"
call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
& eello_turn4)
endif
C
C Calculate the SC local energy.
C
+C print *,"TU DOCHODZE?"
call esc(escloc)
c print *,"Processor",myrank," computed USC"
C
else
esccor=0.0d0
endif
+C print *,"PRZED MULIt"
c print *,"Processor",myrank," computed Usccorr"
C
C 12/1/95 Multi-body terms
Uconst=0.0d0
Uconst_back=0.0d0
endif
+C 01/27/2015 added by adasko
+C the energy component below is energy transfer into lipid environment
+C based on partition function
+C print *,"przed lipidami"
+ if (wliptran.gt.0) then
+ call Eliptransfer(eliptran)
+ endif
+C print *,"za lipidami"
+ if (AFMlog.gt.0) then
+ call AFMforce(Eafmforce)
+ else if (selfguide.gt.0) then
+ call AFMvel(Eafmforce)
+ endif
#ifdef TIMING
time_enecalc=time_enecalc+MPI_Wtime()-time00
#endif
energia(17)=estr
energia(20)=Uconst+Uconst_back
energia(21)=esccor
+ energia(22)=eliptran
+ energia(23)=Eafmforce
+c Here are the energies showed per procesor if the are more processors
+c per molecule then we sum it up in sum_energy subroutine
c print *," Processor",myrank," calls SUM_ENERGY"
call sum_energy(energia,.true.)
if (dyn_ss) call dyn_set_nss
estr=energia(17)
Uconst=energia(20)
esccor=energia(21)
+ eliptran=energia(22)
+ Eafmforce=energia(23)
#ifdef SPLITELE
etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
& +wang*ebe+wtor*etors+wscloc*escloc
& +wstrain*ehpb+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
+ & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce
#else
etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
& +wang*ebe+wtor*etors+wscloc*escloc
& +wstrain*ehpb+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
+ & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
+ & +Eafmforce
#endif
energia(0)=etot
c detecting NaNQ
#ifdef MPI
include 'mpif.h'
#endif
- double precision gradbufc(3,maxres),gradbufx(3,maxres),
- & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
+ double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
+ & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
+ & ,gloc_scbuf(3,-1:maxres)
include 'COMMON.SETUP'
include 'COMMON.IOUNITS'
include 'COMMON.FFIELD'
call flush(iout)
#endif
#ifdef SPLITELE
- do i=1,nct
+ do i=0,nct
do j=1,3
gradbufc(j,i)=wsc*gvdwc(j,i)+
& wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
& wcorr6*gradcorr6_long(j,i)+
& wturn6*gcorr6_turn_long(j,i)+
& wstrain*ghpbc(j,i)
+ & +wliptran*gliptranc(j,i)
+ & +gradafm(j,i)
+
enddo
enddo
#else
- do i=1,nct
+ do i=0,nct
do j=1,3
gradbufc(j,i)=wsc*gvdwc(j,i)+
& wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
& wcorr6*gradcorr6_long(j,i)+
& wturn6*gcorr6_turn_long(j,i)+
& wstrain*ghpbc(j,i)
+ & +wliptran*gliptranc(j,i)
+ & +gradafm(j,i)
+
enddo
enddo
#endif
enddo
call flush(iout)
#endif
- do i=1,nres
+ do i=0,nres
do j=1,3
gradbufc_sum(j,i)=gradbufc(j,i)
enddo
do j=1,3
gradbufc(j,nres-1)=gradbufc_sum(j,nres)
enddo
- do i=nres-2,nnt,-1
+ do i=nres-2,-1,-1
do j=1,3
gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
enddo
enddo
call flush(iout)
#endif
- do i=1,nres
+ do i=-1,nres
do j=1,3
gradbufc_sum(j,i)=gradbufc(j,i)
gradbufc(j,i)=0.0d0
do j=1,3
gradbufc(j,nres-1)=gradbufc_sum(j,nres)
enddo
- do i=nres-2,nnt,-1
+ do i=nres-2,-1,-1
do j=1,3
gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
enddo
do k=1,3
gradbufc(k,nres)=0.0d0
enddo
- do i=1,nct
+ do i=-1,nct
do j=1,3
#ifdef SPLITELE
gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
& wturn6*gcorr6_turn(j,i)+
& wsccor*gsccorc(j,i)
& +wscloc*gscloc(j,i)
+ & +wliptran*gliptranc(j,i)
+ & +gradafm(j,i)
#else
gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
& wel_loc*gel_loc(j,i)+
& wturn6*gcorr6_turn(j,i)+
& wsccor*gsccorc(j,i)
& +wscloc*gscloc(j,i)
+ & +wliptran*gliptranc(j,i)
+ & +gradafm(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)
+ & +wliptran*gliptranx(j,i)
enddo
enddo
#ifdef DEBUG
do i=1,4*nres
glocbuf(i)=gloc(i,icg)
enddo
-#define DEBUG
+c#define DEBUG
#ifdef DEBUG
write (iout,*) "gloc_sc before reduce"
do i=1,nres
enddo
enddo
#endif
-#undef DEBUG
+c#undef DEBUG
do i=1,nres
do j=1,3
gloc_scbuf(j,i)=gloc_sc(j,i,icg)
call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
& MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
time_reduce=time_reduce+MPI_Wtime()-time00
-#define DEBUG
+c#define DEBUG
#ifdef DEBUG
write (iout,*) "gloc_sc after reduce"
do i=1,nres
enddo
enddo
#endif
-#undef DEBUG
+c#undef DEBUG
#ifdef DEBUG
write (iout,*) "gloc after reduce"
do i=1,4*nres
estr=energia(17)
Uconst=energia(20)
esccor=energia(21)
+ eliptran=energia(22)
+ Eafmforce=energia(23)
#ifdef SPLITELE
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
& estr,wbond,ebe,wang,
& ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
& eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
& edihcnstr,ebr*nss,
- & Uconst,etot
+ & Uconst,eliptran,wliptran,Eafmforce,etot
10 format (/'Virtual-chain energies:'//
& 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
& 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
& 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
& 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
& 'UCONST= ',1pE16.6,' (Constraint energy)'/
+ & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
+ & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
& 'ETOT= ',1pE16.6,' (total)')
+
#else
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
& estr,wbond,ebe,wang,
& 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
+ & ebr*nss,Uconst,eliptran,wliptran,Eafmforc,etot
10 format (/'Virtual-chain energies:'//
& 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
& 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
& 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
& 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
& 'UCONST=',1pE16.6,' (Constraint energy)'/
+ & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
+ & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
& 'ETOT= ',1pE16.6,' (total)')
#endif
return
c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+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)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
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)
+C have you changed here?
+ e1=fac*fac*aa
+ e2=fac*bb
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 & restyp(itypi),i,restyp(itypj),j,a(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 print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
C
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
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)
+C have you changed here?
+ e1=fac*fac*aa
+ e2=fac*bb
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)
c endif
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
chi1=chi(itypi,itypj)
call sc_angular
C Calculate whole angle-dependent part of epsilon and contributions
C to its derivatives
+C have you changed here?
fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa
+ e2=fac*bb
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)
+ sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+ epsi=bb**2/aa
cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
cd & restyp(itypi),i,restyp(itypj),j,
cd & epsi,sigm,chi1,chi2,chip1,chip2,
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
include 'COMMON.CONTROL'
+ include 'COMMON.SPLITELE'
include 'COMMON.SBRIDGE'
logical lprn
+ integer xshift,yshift,zshift
evdw=0.0D0
ccccc energy_dec=.false.
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
+C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
lprn=.false.
c if (icall.eq.0) lprn=.false.
ind=0
+C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
+C we have the original box)
+C do xshift=-1,1
+C do yshift=-1,1
+C do zshift=-1,1
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+C Return atom into box, boxxsize is size of box in x dimension
+c 134 continue
+c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
+c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
+C Condition for being inside the proper box
+c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
+c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
+c go to 134
+c endif
+c 135 continue
+c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
+c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
+C Condition for being inside the proper box
+c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
+c & (yi.lt.((yshift-0.5d0)*boxysize))) then
+c go to 135
+c endif
+c 136 continue
+c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
+c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
+C Condition for being inside the proper box
+c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
+c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
+c go to 136
+c endif
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
+C define scaling factor for lipids
+
+C if (positi.le.0) positi=positi+boxzsize
+C print *,i
+C first for peptide groups
+c for each residue check if it is in lipid or lipid water border area
+ if ((zi.gt.bordlipbot)
+ &.and.(zi.lt.bordliptop)) then
+C the energy transfer exist
+ if (zi.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((zi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipi=1.0d0
+ ssgradlipi=0.0
+ endif
+ else
+ sslipi=0.0d0
+ ssgradlipi=0.0
+ endif
+
+C xi=xi+xshift*boxxsize
+C yi=yi+yshift*boxysize
+C zi=zi+zshift*boxzsize
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
& 'evdw',i,j,evdwij,' ss'
ELSE
ind=ind+1
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
c alf1=0.0D0
c alf2=0.0D0
c alf12=0.0D0
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+C Return atom J into box the original box
+c 137 continue
+c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
+c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
+C Condition for being inside the proper box
+c if ((xj.gt.((0.5d0)*boxxsize)).or.
+c & (xj.lt.((-0.5d0)*boxxsize))) then
+c go to 137
+c endif
+c 138 continue
+c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
+c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
+C Condition for being inside the proper box
+c if ((yj.gt.((0.5d0)*boxysize)).or.
+c & (yj.lt.((-0.5d0)*boxysize))) then
+c go to 138
+c endif
+c 139 continue
+c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
+c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
+C Condition for being inside the proper box
+c if ((zj.gt.((0.5d0)*boxzsize)).or.
+c & (zj.lt.((-0.5d0)*boxzsize))) then
+c go to 139
+c endif
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.gt.bordlipbot)
+ &.and.(zj.lt.bordliptop)) then
+C the energy transfer exist
+ if (zj.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((zj-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zj.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipj=1.0d0
+ ssgradlipj=0.0
+ endif
+ else
+ sslipj=0.0d0
+ ssgradlipj=0.0
+ endif
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
+C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
+C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
+C print *,sslipi,sslipj,bordlipbot,zi,zj
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
+C xj=xj-xi
+C yj=yj-yi
+C zj=zj-zi
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)
+ sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
+ sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
+
+c write (iout,'(a7,4f8.3)')
+c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
+ if (sss.gt.0.0d0) then
C Calculate angle-dependent terms of energy and contributions to their
C derivatives.
call sc_angular
c---------------------------------------------------------------
rij_shift=1.0D0/rij_shift
fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+C here to start with
+C if (c(i,3).gt.
+ faclip=fac
+ e1=fac*fac*aa
+ e2=fac*bb
evdwij=eps1*eps2rt*eps3rt*(e1+e2)
eps2der=evdwij*eps3rt
eps3der=evdwij*eps2rt
+C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
+C &((sslipi+sslipj)/2.0d0+
+C &(2.0d0-sslipi-sslipj)/2.0d0)
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
+ 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)
+ sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+ epsi=bb**2/aa
write (iout,'(2(a3,i3,2x),17(0pf7.3))')
& restyp(itypi),i,restyp(itypj),j,
& epsi,sigm,chi1,chi2,chip1,chip2,
fac=-expon*(e1+evdwij)*rij_shift
sigder=fac*sigder
fac=rij*fac
+c print '(2i4,6f8.4)',i,j,sss,sssgrad*
+c & evdwij,fac,sigma(itypi,itypj),expon
+ fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
c fac=0.0d0
C Calculate the radial part of the gradient
+ gg_lipi(3)=eps1*(eps2rt*eps2rt)
+ &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
+ & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
+ &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
+ gg_lipj(3)=ssgradlipj*gg_lipi(3)
+ gg_lipi(3)=gg_lipi(3)*ssgradlipi
+C gg_lipi(3)=0.0d0
+C gg_lipj(3)=0.0d0
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
C Calculate angular part of the gradient.
call sc_grad
+ endif
ENDIF ! dyn_ss
enddo ! j
enddo ! iint
enddo ! i
+C enddo ! zshift
+C enddo ! yshift
+C enddo ! xshift
c write (iout,*) "Number of loop steps in EGB:",ind
cccc energy_dec=.false.
return
c if (icall.eq.0) lprn=.true.
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
+C define scaling factor for lipids
+
+C if (positi.le.0) positi=positi+boxzsize
+C print *,i
+C first for peptide groups
+c for each residue check if it is in lipid or lipid water border area
+ if ((zi.gt.bordlipbot)
+ &.and.(zi.lt.bordliptop)) then
+C the energy transfer exist
+ if (zi.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((zi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipi=1.0d0
+ ssgradlipi=0.0
+ endif
+ else
+ sslipi=0.0d0
+ ssgradlipi=0.0
+ endif
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
sig0ij=sigma(itypi,itypj)
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
+C xj=c(1,nres+j)-xi
+C yj=c(2,nres+j)-yi
+C zj=c(3,nres+j)-zi
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.gt.bordlipbot)
+ &.and.(zj.lt.bordliptop)) then
+C the energy transfer exist
+ if (zj.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((zj-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zj.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipj=1.0d0
+ ssgradlipj=0.0
+ endif
+ else
+ sslipj=0.0d0
+ ssgradlipj=0.0
+ endif
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
+C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
c---------------------------------------------------------------
rij_shift=1.0D0/rij_shift
fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa
+ e2=fac*bb
evdwij=eps1*eps2rt*eps3rt*(e1+e2)
eps2der=evdwij*eps3rt
eps3der=evdwij*eps2rt
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)
+ sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+ epsi=bb**2/aa
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),
fac=-expon*(e1+evdwij)*rij_shift
sigder=fac*sigder
fac=rij*fac-2*expon*rrij*e_augm
+ fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
C Calculate the radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
include 'COMMON.CALC'
include 'COMMON.IOUNITS'
double precision dcosom1(3),dcosom2(3)
+cc print *,'sss=',sss
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
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)
+ gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
enddo
c write (iout,*) "gg",(gg(k),k=1,3)
do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
+ gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
& +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
- & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
+ & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
+ gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
& +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
- & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
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))
cgrad enddo
cgrad enddo
do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
enddo
return
end
cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+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)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
dimension ggg(3)
-cd write(iout,*) 'In EELEC_soft_sphere'
+C write(iout,*) 'In EELEC_soft_sphere'
ees=0.0D0
evdw1=0.0D0
eel_loc=0.0d0
eello_turn4=0.0d0
ind=0
do i=iatel_s,iatel_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
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
+ xmedi=mod(xmedi,boxxsize)
+ if (xmedi.lt.0) xmedi=xmedi+boxxsize
+ ymedi=mod(ymedi,boxysize)
+ if (ymedi.lt.0) ymedi=ymedi+boxysize
+ zmedi=mod(zmedi,boxzsize)
+ if (zmedi.lt.0) zmedi=zmedi+boxzsize
num_conti=0
c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
do j=ielstart(i),ielend(i)
- if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
+ if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
ind=ind+1
iteli=itel(i)
itelj=itel(j)
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
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ isubchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ isubchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (isubchap.eq.1) then
+ xj=xj_temp-xmedi
+ yj=yj_temp-ymedi
+ zj=zj_temp-zmedi
+ else
+ xj=xj_safe-xmedi
+ yj=yj_safe-ymedi
+ zj=zj_safe-zmedi
+ endif
rij=xj*xj+yj*yj+zj*zj
+ sss=sscale(sqrt(rij))
+ sssgrad=sscagrad(sqrt(rij))
if (rij.lt.r0ijsq) then
evdw1ij=0.25d0*(rij-r0ijsq)**2
fac=rij-r0ijsq
evdw1ij=0.0d0
fac=0.0d0
endif
- evdw1=evdw1+evdw1ij
+ evdw1=evdw1+evdw1ij*sss
C
C Calculate contributions to the Cartesian gradient.
C
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
+ ggg(1)=fac*xj*sssgrad
+ ggg(2)=fac*yj*sssgrad
+ ggg(3)=fac*zj*sssgrad
do k=1,3
gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
C Compute the virtual-bond-torsional-angle dependent quantities needed
C to calculate the el-loc multibody terms of various order.
C
+c write(iout,*) 'nphi=',nphi,nres
+#ifdef PARMAT
+ do i=ivec_start+2,ivec_end+2
+#else
+ do i=3,nres+1
+#endif
+#ifdef NEWCORR
+ 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
+c write(iout,*),i
+ b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
+ & +bnew1(2,1,iti)*dsin(theta(i-1))
+ & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
+ gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
+ & +bnew1(2,1,iti)*dcos(theta(i-1))
+ & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
+c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
+c &*(cos(theta(i)/2.0)
+ b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
+ & +bnew2(2,1,iti)*dsin(theta(i-1))
+ & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
+c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
+c &*(cos(theta(i)/2.0)
+ gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
+ & +bnew2(2,1,iti)*dcos(theta(i-1))
+ & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
+c if (ggb1(1,i).eq.0.0d0) then
+c write(iout,*) 'i=',i,ggb1(1,i),
+c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
+c &bnew1(2,1,iti)*cos(theta(i)),
+c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
+c endif
+ b1(2,i-2)=bnew1(1,2,iti)
+ gtb1(2,i-2)=0.0
+ b2(2,i-2)=bnew2(1,2,iti)
+ gtb2(2,i-2)=0.0
+ EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
+ EE(1,2,i-2)=eeold(1,2,iti)
+ EE(2,1,i-2)=eeold(2,1,iti)
+ EE(2,2,i-2)=eeold(2,2,iti)
+ gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
+ gtEE(1,2,i-2)=0.0d0
+ gtEE(2,2,i-2)=0.0d0
+ gtEE(2,1,i-2)=0.0d0
+c EE(2,2,iti)=0.0d0
+c EE(1,2,iti)=0.5d0*eenew(1,iti)
+c EE(2,1,iti)=0.5d0*eenew(1,iti)
+c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
+c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
+ b1tilde(1,i-2)=b1(1,i-2)
+ b1tilde(2,i-2)=-b1(2,i-2)
+ b2tilde(1,i-2)=b2(1,i-2)
+ b2tilde(2,i-2)=-b2(2,i-2)
+c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
+c write(iout,*) 'b1=',b1(1,i-2)
+c write (iout,*) 'theta=', theta(i-1)
+ enddo
+#else
+ 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
+ b1(1,i-2)=b(3,iti)
+ b1(2,i-2)=b(5,iti)
+ b2(1,i-2)=b(2,iti)
+ b2(2,i-2)=b(4,iti)
+ b1tilde(1,i-2)=b1(1,i-2)
+ b1tilde(2,i-2)=-b1(2,i-2)
+ b2tilde(1,i-2)=b2(1,i-2)
+ b2tilde(2,i-2)=-b2(2,i-2)
+ EE(1,2,i-2)=eeold(1,2,iti)
+ EE(2,1,i-2)=eeold(2,1,iti)
+ EE(2,2,i-2)=eeold(2,2,iti)
+ EE(1,1,i-2)=eeold(1,1,iti)
+ enddo
+#endif
#ifdef PARMAT
do i=ivec_start+2,ivec_end+2
#else
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
-c write(iout,*) (itype(i-2))
iti = itortyp(itype(i-2))
else
- iti=ntortyp+1
+ iti=ntortyp
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
+ iti1=ntortyp
endif
cd write (iout,*) '*******i',i,' iti1',iti
cd write (iout,*) 'b1',b1(:,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))
+ call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
+#ifdef NEWCORR
+ call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
+c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
+#endif
+c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
+c & EE(1,2,iti),EE(2,2,iti)
+ call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
+ call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
+c write(iout,*) "Macierz EUG",
+c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
+c & eug(2,2,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))
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))
+ call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
+ call matmat2(EE(1,1,i-2),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))
+ if (itype(i-1).le.ntyp) then
+ iti1 = itortyp(itype(i-1))
+ else
+ iti1=ntortyp
+ endif
else
- iti1=ntortyp+1
+ iti1=ntortyp
endif
do k=1,2
- mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
+ mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
enddo
-cd write (iout,*) 'mu ',mu(:,i-2)
+C write (iout,*) 'mumu',i,b1(1,i-1),Ub2(1,i-2)
+c write (iout,*) 'mu ',mu(:,i-2),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)
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(DD(1,1,iti),b1tilde(1,i-1),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))
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
include 'COMMON.TIME1'
+ include 'COMMON.SPLITELE'
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),eel_loc_ij
+ & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(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
time01=MPI_Wtime()
#endif
call set_matrices
-c write (iout,*) "after set matrices"
#ifdef TIMING
time_mat=time_mat+MPI_Wtime()-time01
#endif
C
C Loop over i,i+2 and i,i+3 pairs of the peptide groups
C
-c write(iout,*) "przed turnem3 loop"
+C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
do i=iturn3_start,iturn3_end
- if (itype(i).eq.21 .or. itype(i+1).eq.21
- & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21) cycle
+ if (i.le.1) cycle
+C write(iout,*) "tu jest i",i
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+C changes suggested by Ana to avoid out of bounds
+ & .or.((i+4).gt.nres)
+ & .or.((i-1).le.0)
+C end of changes by Ana
+ & .or. itype(i+2).eq.ntyp1
+ & .or. itype(i+3).eq.ntyp1) cycle
+ if(i.gt.1)then
+ if(itype(i-1).eq.ntyp1)cycle
+ end if
+ if(i.LT.nres-3)then
+ if (itype(i+4).eq.ntyp1) cycle
+ end if
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
+ xmedi=mod(xmedi,boxxsize)
+ if (xmedi.lt.0) xmedi=xmedi+boxxsize
+ ymedi=mod(ymedi,boxysize)
+ if (ymedi.lt.0) ymedi=ymedi+boxysize
+ zmedi=mod(zmedi,boxzsize)
+ if (zmedi.lt.0) zmedi=zmedi+boxzsize
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
- if (itype(i).eq.21 .or. itype(i+1).eq.21
- & .or. itype(i+3).eq.21
- & .or. itype(i+4).eq.21) cycle
+ if (i.le.1) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+C changes suggested by Ana to avoid out of bounds
+ & .or.((i+5).gt.nres)
+ & .or.((i-1).le.0)
+C end of changes suggested by Ana
+ & .or. itype(i+3).eq.ntyp1
+ & .or. itype(i+4).eq.ntyp1
+ & .or. itype(i+5).eq.ntyp1
+ & .or. itype(i).eq.ntyp1
+ & .or. itype(i-1).eq.ntyp1
+ & ) cycle
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
+C Return atom into box, boxxsize is size of box in x dimension
+c 194 continue
+c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
+c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
+C Condition for being inside the proper box
+c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
+c & (xmedi.lt.((-0.5d0)*boxxsize))) then
+c go to 194
+c endif
+c 195 continue
+c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
+c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
+C Condition for being inside the proper box
+c if ((ymedi.gt.((0.5d0)*boxysize)).or.
+c & (ymedi.lt.((-0.5d0)*boxysize))) then
+c go to 195
+c endif
+c 196 continue
+c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
+c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
+C Condition for being inside the proper box
+c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
+c & (zmedi.lt.((-0.5d0)*boxzsize))) then
+c go to 196
+c endif
+ xmedi=mod(xmedi,boxxsize)
+ if (xmedi.lt.0) xmedi=xmedi+boxxsize
+ ymedi=mod(ymedi,boxysize)
+ if (ymedi.lt.0) ymedi=ymedi+boxysize
+ zmedi=mod(zmedi,boxzsize)
+ if (zmedi.lt.0) zmedi=zmedi+boxzsize
+
num_conti=num_cont_hb(i)
+c write(iout,*) "JESTEM W PETLI"
call eelecij(i,i+3,ees,evdw1,eel_loc)
- if (wturn4.gt.0.0d0 .and. itype(i+2).ne.21)
+ if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
& call eturn4(i,eello_turn4)
num_cont_hb(i)=num_conti
enddo ! i
+C Loop over all neighbouring boxes
+C do xshift=-1,1
+C do yshift=-1,1
+C do zshift=-1,1
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
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (i.le.1) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+C changes suggested by Ana to avoid out of bounds
+ & .or.((i+2).gt.nres)
+ & .or.((i-1).le.0)
+C end of changes by Ana
+ & .or. itype(i+2).eq.ntyp1
+ & .or. itype(i-1).eq.ntyp1
+ & ) cycle
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
+ xmedi=mod(xmedi,boxxsize)
+ if (xmedi.lt.0) xmedi=xmedi+boxxsize
+ ymedi=mod(ymedi,boxysize)
+ if (ymedi.lt.0) ymedi=ymedi+boxysize
+ zmedi=mod(zmedi,boxzsize)
+ if (zmedi.lt.0) zmedi=zmedi+boxzsize
+C xmedi=xmedi+xshift*boxxsize
+C ymedi=ymedi+yshift*boxysize
+C zmedi=zmedi+zshift*boxzsize
+
+C Return tom into box, boxxsize is size of box in x dimension
+c 164 continue
+c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
+c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
+C Condition for being inside the proper box
+c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
+c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
+c go to 164
+c endif
+c 165 continue
+c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
+c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
+C Condition for being inside the proper box
+c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
+c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
+c go to 165
+c endif
+c 166 continue
+c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
+c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
+cC Condition for being inside the proper box
+c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
+c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
+c go to 166
+c endif
+
c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
num_conti=num_cont_hb(i)
do j=ielstart(i),ielend(i)
-c write (iout,*) i,j,itype(i),itype(j)
- if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
+C write (iout,*) i,j
+ if (j.le.1) cycle
+ if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
+C changes suggested by Ana to avoid out of bounds
+ & .or.((j+2).gt.nres)
+ & .or.((j-1).le.0)
+C end of changes by Ana
+ & .or.itype(j+2).eq.ntyp1
+ & .or.itype(j-1).eq.ntyp1
+ &) cycle
call eelecij(i,j,ees,evdw1,eel_loc)
enddo ! j
num_cont_hb(i)=num_conti
enddo ! i
+C enddo ! zshift
+C enddo ! yshift
+C enddo ! xshift
+
c write (iout,*) "Number of loop steps in EELEC:",ind
cd do i=1,nres
cd write (iout,'(i3,3f10.5,5x,3f10.5)')
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
include 'COMMON.TIME1'
+ include 'COMMON.SPLITELE'
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),a22,a23,a32,a33
+ & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
+ & gmuij2(4),gmuji2(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
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
+C xj=c(1,j)+0.5D0*dxj-xmedi
+C yj=c(2,j)+0.5D0*dyj-ymedi
+C zj=c(3,j)+0.5D0*dzj-zmedi
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
+ dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ isubchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ isubchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (isubchap.eq.1) then
+ xj=xj_temp-xmedi
+ yj=yj_temp-ymedi
+ zj=zj_temp-zmedi
+ else
+ xj=xj_safe-xmedi
+ yj=yj_safe-ymedi
+ zj=zj_safe-zmedi
+ endif
+C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
+c 174 continue
+c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
+c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
+C Condition for being inside the proper box
+c if ((xj.gt.((0.5d0)*boxxsize)).or.
+c & (xj.lt.((-0.5d0)*boxxsize))) then
+c go to 174
+c endif
+c 175 continue
+c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
+c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
+C Condition for being inside the proper box
+c if ((yj.gt.((0.5d0)*boxysize)).or.
+c & (yj.lt.((-0.5d0)*boxysize))) then
+c go to 175
+c endif
+c 176 continue
+c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
+c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
+C Condition for being inside the proper box
+c if ((zj.gt.((0.5d0)*boxzsize)).or.
+c & (zj.lt.((-0.5d0)*boxzsize))) then
+c go to 176
+c endif
+C endif !endPBC condintion
+C xj=xj-xmedi
+C yj=yj-ymedi
+C zj=zj-zmedi
rij=xj*xj+yj*yj+zj*zj
+
+ sss=sscale(sqrt(rij))
+ sssgrad=sscagrad(sqrt(rij))
+c if (sss.gt.0.0d0) then
rrmij=1.0D0/rij
rij=dsqrt(rij)
rmij=1.0D0/rij
ev2=bbb*r6ij
fac3=ael6i*r6ij
fac4=ael3i*r3ij
- evdwij=ev1+ev2
+ evdwij=(ev1+ev2)
el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
el2=fac4*fac
- eesij=el1+el2
+C MARYSIA
+ 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
+ evdw1=evdw1+evdwij*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)') 'evdw1',i,j,evdwij
+ write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
+ &'evdw1',i,j,evdwij
+ &,iteli,itelj,aaa,evdw1
write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
endif
C Calculate contributions to the Cartesian gradient.
C
#ifdef SPLITELE
- facvdw=-6*rrmij*(ev1+evdwij)
+ facvdw=-6*rrmij*(ev1+evdwij)*sss
facel=-3*rrmij*(el1+eesij)
fac1=fac
erij(1)=xj*rmij
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
+ if (sss.gt.0.0) then
+ ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
+ ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
+ ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
+ else
+ ggg(1)=0.0
+ ggg(2)=0.0
+ ggg(3)=0.0
+ endif
c do k=1,3
c ghalf=0.5D0*ggg(k)
c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
cgrad enddo
cgrad enddo
#else
- facvdw=ev1+evdwij
- facel=el1+eesij
+C MARYSIA
+ facvdw=(ev1+evdwij)*sss
+ facel=(el1+eesij)
fac1=fac
fac=-3*rrmij*(facvdw+facvdw+facel)
erij(1)=xj*rmij
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
+ ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
+ ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
+ ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
do k=1,3
gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
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)
+ & +(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)
+ & +(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
+C MARYSIA
+c endif !sscale
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 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
j2=j-2
endif
kkk=0
+ lll=0
do k=1,2
do l=1,2
kkk=kkk+1
muij(kkk)=mu(k,i)*mu(l,j)
+c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
+#ifdef NEWCORR
+ gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
+c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
+ gmuij2(kkk)=gUb2(k,i)*mu(l,j)
+ gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
+c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
+ gmuji2(kkk)=mu(k,i)*gUb2(l,j)
+#endif
enddo
enddo
cd write (iout,*) 'EELEC: i',i,' j',j
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)
+c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
+c & ' eel_loc_ij',eel_loc_ij
+C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
+C Calculate patrial derivative for theta angle
+#ifdef NEWCORR
+ geel_loc_ij=a22*gmuij1(1)
+ & +a23*gmuij1(2)
+ & +a32*gmuij1(3)
+ & +a33*gmuij1(4)
+c write(iout,*) "derivative over thatai"
+c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
+c & a33*gmuij1(4)
+ gloc(nphi+i,icg)=gloc(nphi+i,icg)+
+ & geel_loc_ij*wel_loc
+c write(iout,*) "derivative over thatai-1"
+c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
+c & a33*gmuij2(4)
+ geel_loc_ij=
+ & a22*gmuij2(1)
+ & +a23*gmuij2(2)
+ & +a32*gmuij2(3)
+ & +a33*gmuij2(4)
+ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
+ & geel_loc_ij*wel_loc
+c Derivative over j residue
+ geel_loc_ji=a22*gmuji1(1)
+ & +a23*gmuji1(2)
+ & +a32*gmuji1(3)
+ & +a33*gmuji1(4)
+c write(iout,*) "derivative over thataj"
+c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
+c & a33*gmuji1(4)
+
+ gloc(nphi+j,icg)=gloc(nphi+j,icg)+
+ & geel_loc_ji*wel_loc
+ geel_loc_ji=
+ & +a22*gmuji2(1)
+ & +a23*gmuji2(2)
+ & +a32*gmuji2(3)
+ & +a33*gmuji2(4)
+c write(iout,*) "derivative over thataj-1"
+c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
+c & a33*gmuji2(4)
+ gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
+ & geel_loc_ji*wel_loc
+#endif
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
+c if (eel_loc_ij.ne.0)
+c & write (iout,'(a4,2i4,8f9.5)')'chuj',
+c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
eel_loc=eel_loc+eel_loc_ij
C Partial derivatives in virtual-bond dihedral angles gamma
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)
+ 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
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)
+ & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
+ & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
+ & auxgmat2(2,2),auxgmatt2(2,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,
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))
+c auxalary matices for theta gradient
+c auxalary matrix for i+1 and constant i+2
+ call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
+c auxalary matrix for i+2 and constant i+1
+ call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
call transpose2(auxmat(1,1),auxmat1(1,1))
+ call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
+ call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
+ call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
+ call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
+C Derivatives in theta
+ gloc(nphi+i,icg)=gloc(nphi+i,icg)
+ & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
+ gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
+ & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
+
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',
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)
+ & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
+ & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
+ & gte1t(2,2),gte2t(2,2),gte3t(2,2),
+ & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
+ & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,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,
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
cd call checkint_turn4(i,a_temp,eello_turn4_num)
c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
+c write(iout,*)"WCHODZE W PROGRAM"
a_temp(1,1)=a22
a_temp(1,2)=a23
a_temp(2,1)=a32
iti1=itortyp(itype(i+1))
iti2=itortyp(itype(i+2))
iti3=itortyp(itype(i+3))
-C write(iout,*) i,"iti1",iti1," iti2",iti2," iti3",iti3,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))
+C Ematrix derivative in theta
+ call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
+ call transpose2(gtEug(1,1,i+2),gte2t(1,1))
+ call transpose2(gtEug(1,1,i+3),gte3t(1,1))
call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
+c eta1 in derivative theta
+ call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
+c auxgvec is derivative of Ub2 so i+3 theta
+ call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
+c auxalary matrix of E i+1
+ call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
+c s1=0.0
+c gs1=0.0
+ s1=scalar2(b1(1,i+2),auxvec(1))
+c derivative of theta i+2 with constant i+3
+ gs23=scalar2(gtb1(1,i+2),auxvec(1))
+c derivative of theta i+2 with constant i+2
+ gs32=scalar2(b1(1,i+2),auxgvec(1))
+c derivative of E matix in theta of i+1
+ gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
+
call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
+c ea31 in derivative theta
+ call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
+c auxilary matrix auxgvec of Ub2 with constant E matirx
+ call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
+c auxilary matrix auxgEvec1 of E matix with Ub2 constant
+ call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
+
+c s2=0.0
+c gs2=0.0
+ s2=scalar2(b1(1,i+1),auxvec(1))
+c derivative of theta i+1 with constant i+3
+ gs13=scalar2(gtb1(1,i+1),auxvec(1))
+c derivative of theta i+2 with constant i+1
+ gs21=scalar2(b1(1,i+1),auxgvec(1))
+c derivative of theta i+3 with constant i+1
+ gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
+c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
+c & gtb1(1,i+1)
call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
+c two derivatives over diffetent matrices
+c gtae3e2 is derivative over i+3
+ call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
+c ae3gte2 is derivative over i+2
+ call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
+c three possible derivative over theta E matices
+c i+1
+ call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
+c i+2
+ call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
+c i+3
+ call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
+
+ gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
+ gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
+ gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
+
eello_turn4=eello_turn4-(s1+s2+s3)
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'eturn4',i,j,-(s1+s2+s3)
+c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
+ & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
cd & ' eello_turn4_num',8*eello_turn4_num
+#ifdef NEWCORR
+ gloc(nphi+i,icg)=gloc(nphi+i,icg)
+ & -(gs13+gsE13+gsEE1)*wturn4
+ gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
+ & -(gs23+gs21+gsEE2)*wturn4
+ gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
+ & -(gs32+gsE31+gsEE3)*wturn4
+c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
+c & gs2
+#endif
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
+ & 'eturn4',i,j,-(s1+s2+s3)
+c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
+c & ' 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))
+ s1=scalar2(b1(1,i+2),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))
+ s2=scalar2(b1(1,i+1),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))
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))
+ s1=scalar2(b1(1,i+2),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))
+ s2=scalar2(b1(1,i+1),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))
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))
+ s1=scalar2(b1(1,i+2),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))
+ s2=scalar2(b1(1,i+1),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))
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))
+ s1=scalar2(b1(1,i+2),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))
+ s2=scalar2(b1(1,i+1),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))
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))
+ s1=scalar2(b1(1,i+2),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))
+ s2=scalar2(b1(1,i+1),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))
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))
+ s1=scalar2(b1(1,i+2),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))
+ s2=scalar2(b1(1,i+1),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))
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))
+ s1=scalar2(b1(1,i+2),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))
+ s2=scalar2(b1(1,i+1),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))
r0_scp=4.5d0
cd print '(a)','Enter ESCP'
cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
+C do xshift=-1,1
+C do yshift=-1,1
+C do zshift=-1,1
do i=iatscp_s,iatscp_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
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))
-
+C Return atom into box, boxxsize is size of box in x dimension
+c 134 continue
+c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
+c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
+C Condition for being inside the proper box
+c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
+c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
+c go to 134
+c endif
+c 135 continue
+c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
+c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
+C Condition for being inside the proper box
+c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
+c & (yi.lt.((yshift-0.5d0)*boxysize))) then
+c go to 135
+c c endif
+c 136 continue
+c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
+c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
+cC Condition for being inside the proper box
+c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
+c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
+c go to 136
+c endif
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
+C xi=xi+xshift*boxxsize
+C yi=yi+yshift*boxysize
+C zi=zi+zshift*boxzsize
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- if (itype(j).eq.21) cycle
- itypj=itype(j)
+ if (itype(j).eq.ntyp1) cycle
+ itypj=iabs(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
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+c 174 continue
+c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
+c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
+C Condition for being inside the proper box
+c if ((xj.gt.((0.5d0)*boxxsize)).or.
+c & (xj.lt.((-0.5d0)*boxxsize))) then
+c go to 174
+c endif
+c 175 continue
+c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
+c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
+cC Condition for being inside the proper box
+c if ((yj.gt.((0.5d0)*boxysize)).or.
+c & (yj.lt.((-0.5d0)*boxysize))) then
+c go to 175
+c endif
+c 176 continue
+c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
+c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
+C Condition for being inside the proper box
+c if ((zj.gt.((0.5d0)*boxzsize)).or.
+c & (zj.lt.((-0.5d0)*boxzsize))) then
+c go to 176
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
+c c endif
+C xj=xj-xi
+C yj=yj-yi
+C zj=zj-zi
rij=xj*xj+yj*yj+zj*zj
+
r0ij=r0_scp
r0ijsq=r0ij*r0ij
if (rij.lt.r0ijsq) then
enddo ! iint
enddo ! i
+C enddo !zshift
+C enddo !yshift
+C enddo !xshift
return
end
C-----------------------------------------------------------------------------
include 'COMMON.FFIELD'
include 'COMMON.IOUNITS'
include 'COMMON.CONTROL'
+ include 'COMMON.SPLITELE'
dimension ggg(3)
evdw2=0.0D0
evdw2_14=0.0d0
+c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
cd print '(a)','Enter ESCP'
cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
+C do xshift=-1,1
+C do yshift=-1,1
+C do zshift=-1,1
do i=iatscp_s,iatscp_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
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))
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
+c xi=xi+xshift*boxxsize
+c yi=yi+yshift*boxysize
+c zi=zi+zshift*boxzsize
+c print *,xi,yi,zi,'polozenie i'
+C Return atom into box, boxxsize is size of box in x dimension
+c 134 continue
+c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
+c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
+C Condition for being inside the proper box
+c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
+c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
+c go to 134
+c endif
+c 135 continue
+c print *,xi,boxxsize,"pierwszy"
+c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
+c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
+C Condition for being inside the proper box
+c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
+c & (yi.lt.((yshift-0.5d0)*boxysize))) then
+c go to 135
+c endif
+c 136 continue
+c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
+c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
+C Condition for being inside the proper box
+c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
+c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
+c go to 136
+c endif
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
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
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+c 174 continue
+c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
+c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
+C Condition for being inside the proper box
+c if ((xj.gt.((0.5d0)*boxxsize)).or.
+c & (xj.lt.((-0.5d0)*boxxsize))) then
+c go to 174
+c endif
+c 175 continue
+c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
+c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
+cC Condition for being inside the proper box
+c if ((yj.gt.((0.5d0)*boxysize)).or.
+c & (yj.lt.((-0.5d0)*boxysize))) then
+c go to 175
+c endif
+c 176 continue
+c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
+c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
+C Condition for being inside the proper box
+c if ((zj.gt.((0.5d0)*boxzsize)).or.
+c & (zj.lt.((-0.5d0)*boxzsize))) then
+c go to 176
+c endif
+CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
+c print *,xj,yj,zj,'polozenie j'
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+c print *,rrij
+ sss=sscale(1.0d0/(dsqrt(rrij)))
+c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
+c if (sss.eq.0) print *,'czasem jest OK'
+ if (sss.le.0.0d0) cycle
+ sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
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
+ evdw2_14=evdw2_14+(e1+e2)*sss
endif
evdwij=e1+e2
- evdw2=evdw2+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw2',i,j,evdwij
+ evdw2=evdw2+evdwij*sss
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
+ & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
+ & bad(itypj,iteli)
C
C Calculate contributions to the gradient in the virtual-bond and SC vectors.
C
- fac=-(evdwij+e1)*rrij
+ fac=-(evdwij+e1)*rrij*sss
+ fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
ggg(1)=xj*fac
ggg(2)=yj*fac
ggg(3)=zj*fac
gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
enddo
- enddo
+c endif !endif for sscale cutoff
+ enddo ! j
enddo ! iint
enddo ! i
+c enddo !zshift
+c enddo !yshift
+c enddo !xshift
do i=1,nct
do j=1,3
gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
c & dhpb(i),dhpb1(i),forcon(i)
C 24/11/03 AL: SS bridges handled separately because of introducing a specific
C distance and angle dependent SS bond potential.
+C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
+C & iabs(itype(jjj)).eq.1) then
cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
if (.not.dyn_ss .and. i.le.nss) then
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
- itypi=itype(i)
+ itypi=iabs(itype(i))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
dzi=dc_norm(3,nres+i)
c dsci_inv=dsc_inv(itypi)
dsci_inv=vbld_inv(nres+i)
- itypj=itype(j)
+ itypj=iabs(itype(j))
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(nres+j)
xj=c(1,nres+j)-xi
estr=0.0d0
estr1=0.0d0
do i=ibondp_start,ibondp_end
- if (itype(i-1).eq.21 .or. itype(i).eq.21) then
- estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
- do j=1,3
- gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
- & *dc(j,i-1)/vbld(i)
- enddo
- if (energy_dec) write(iout,*)
- & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
- else
+ if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
+c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
+c do j=1,3
+c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
+c & *dc(j,i-1)/vbld(i)
+c enddo
+c if (energy_dec) write(iout,*)
+c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
+c else
+C Checking if it involves dummy (NH3+ or COO-) group
+ if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
+C YES vbldpDUM is the equlibrium length of spring for Dummy atom
+ diff = vbld(i)-vbldpDUM
+ else
+C NO vbldp0 is the equlibrium lenght of spring for peptide group
diff = vbld(i)-vbldp0
- if (energy_dec) write (iout,*)
+ endif
+ if (energy_dec) write (iout,'(a7,i5,4f7.3)')
& "estr bb",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)
- endif
+c endif
enddo
estr=0.5d0*AKP*estr+estr1
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 .and. iti.ne.21) then
+ iti=iabs(itype(i))
+ if (iti.ne.10 .and. iti.ne.ntyp1) then
nbi=nbondterm(iti)
if (nbi.eq.1) then
diff=vbld(i+nres)-vbldsc0(1,iti)
- if (energy_dec) write (iout,*)
+ if (energy_dec) write (iout,*)
& "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
& AKSC(1,iti),AKSC(1,iti)*diff*diff
estr=estr+0.5d0*AKSC(1,iti)*diff*diff
etheta=0.0D0
c write (*,'(a,i2)') 'EBEND ICG=',icg
do i=ithet_start,ithet_end
- if (itype(i-1).eq.21) cycle
+ if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
+ & .or.itype(i).eq.ntyp1) cycle
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 .and. itype(i-2).ne.21) then
+ ichir1=isign(1,itype(i-2))
+ ichir2=isign(1,itype(i))
+ if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
+ if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
+ if (itype(i-1).eq.10) then
+ itype1=isign(10,itype(i-2))
+ ichir11=isign(1,itype(i-2))
+ ichir12=isign(1,itype(i-2))
+ itype2=isign(10,itype(i))
+ ichir21=isign(1,itype(i))
+ ichir22=isign(1,itype(i))
+ endif
+
+ if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
#ifdef OSF
phii=phi(i)
if (phii.ne.phii) phii=150.0
y(1)=0.0D0
y(2)=0.0D0
endif
- if (i.lt.nres .and. itype(i).ne.21) then
+ if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
#ifdef OSF
phii1=phi(i+1)
if (phii1.ne.phii1) phii1=150.0
z(1)=cos(phii1)
#else
phii1=phi(i+1)
- z(1)=dcos(phii1)
#endif
+ z(1)=dcos(phii1)
z(2)=dsin(phii1)
else
z(1)=0.0D0
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)
+ athetk=athet(k,it,ichir1,ichir2)
+ bthetk=bthet(k,it,ichir1,ichir2)
+ if (it.eq.10) then
+ athetk=athet(k,itype1,ichir11,ichir12)
+ bthetk=bthet(k,itype2,ichir21,ichir22)
+ endif
+ thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
+c write(iout,*) 'chuj tu', y(k),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
+ dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
+ &+athet(2,it,ichir1,ichir2)*y(1))*ss
+ dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
+ & +bthet(2,it,ichir1,ichir2)*z(1))*ss
+ if (it.eq.10) then
+ dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
+ &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
+ dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
+ & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
+ endif
if (theta(i).gt.pi-delta) then
call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
& E_tc0)
& E_theta,E_tc)
endif
etheta=etheta+ethetai
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'ebend',i,ethetai
+ if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
+ & 'ebend',i,ethetai,theta(i),itype(i)
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)
+ gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
enddo
C Ufff.... We've done all this!!!
return
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.
+C the distributioni.
+ccc write (iout,*) thetai,thet_pred_mean
sig=polthet(3,it)
do j=2,0,-1
sig=sig*thet_pred_mean+polthet(j,it)
delthe0=thetai-theta0i
term1=-0.5D0*sigcsq*delthec*delthec
term2=-0.5D0*sig0inv*delthe0*delthe0
+C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,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 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 write (iout,*) 'termexp',termexp,termm,termpre,i
C NOW the derivatives!!!
C 6/6/97 Take into account the deformation.
E_theta=(delthec*sigcsq*term1
logical lprn /.false./, lprn1 /.false./
etheta=0.0D0
do i=ithet_start,ithet_end
- if (itype(i-1).eq.21) cycle
+c print *,i,itype(i-1),itype(i),itype(i-2)
+ if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
+ & .or.itype(i).eq.ntyp1) cycle
+C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
+
+ if (iabs(itype(i+1)).eq.20) iblock=2
+ if (iabs(itype(i+1)).ne.20) iblock=1
dethetai=0.0d0
dephii=0.0d0
dephii1=0.0d0
theti2=0.5d0*theta(i)
- ityp2=ithetyp(itype(i-1))
+ ityp2=ithetyp((itype(i-1)))
do k=1,nntheterm
coskt(k)=dcos(k*theti2)
sinkt(k)=dsin(k*theti2)
enddo
- if (i.gt.3 .and. itype(i-2).ne.21) then
+ if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
#ifdef OSF
phii=phi(i)
if (phii.ne.phii) phii=150.0
#else
phii=phi(i)
#endif
- ityp1=ithetyp(itype(i-2))
+ ityp1=ithetyp((itype(i-2)))
+C propagation of chirality for glycine type
do k=1,nsingle
cosph1(k)=dcos(k*phii)
sinph1(k)=dsin(k*phii)
sinph1(k)=0.0d0
enddo
endif
- if (i.lt.nres .and. itype(i).ne.21) then
+ if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
#ifdef OSF
phii1=phi(i+1)
if (phii1.ne.phii1) phii1=150.0
#else
phii1=phi(i+1)
#endif
- ityp3=ithetyp(itype(i))
+ ityp3=ithetyp((itype(i)))
do k=1,nsingle
cosph2(k)=dcos(k*phii1)
sinph2(k)=dsin(k*phii1)
sinph2(k)=0.0d0
enddo
endif
- ethetai=aa0thet(ityp1,ityp2,ityp3)
+ ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
do k=1,ndouble
do l=1,k-1
ccl=cosph1(l)*cosph2(k-l)
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)
+ ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
+ dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
& *coskt(k)
if (lprn)
- & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
+ & write (iout,*) "k",k,"
+ & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
& " ethetai",ethetai
enddo
if (lprn) then
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)
+ aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
+ & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
+ & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
+ & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*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))
+ & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
+ & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
dephii1=dephii1+k*sinkt(m)*(
- & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
- & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
+ & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
+ & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*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
+ & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
+ & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
+ & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
+ & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
enddo
enddo
if (lprn)
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)
+ aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
+ & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
+ & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
+ & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*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))
+ & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
+ & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
+ & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
+ & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*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))
+ & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
+ & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
+ & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
+ & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*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
+ & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
+ & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
+ & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
+ & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
+ & " ethetai",ethetai
write (iout,*) cosph1ph2(l,k)*sinkt(m),
& cosph1ph2(k,l)*sinkt(m),
& sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
enddo
enddo
10 continue
- if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
+c lprn1=.true.
+ if (lprn1)
+ & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
& i,theta(i)*rad2deg,phii*rad2deg,
& phii1*rad2deg,ethetai
+c lprn1=.false.
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
+ gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
enddo
return
end
c write (iout,'(a)') 'ESC'
do i=loc_start,loc_end
it=itype(i)
- if (it.eq.21) cycle
+ if (it.eq.ntyp1) cycle
if (it.eq.10) goto 1
- nlobit=nlob(it)
+ nlobit=nlob(iabs(it))
c print *,'i=',i,' it=',it,' nlobit=',nlobit
c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
theti=theta(i+1)-pipol
do j=1,nlobit
#ifdef OSF
- adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
+ adexp=bsc(j,iabs(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)
+ expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
#endif
cd print *,'j=',j,' expfac=',expfac
escloc_i=escloc_i+expfac
dersc12=0.0d0
do j=1,nlobit
- expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
+ expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
escloc_i=escloc_i+expfac
do k=1,2
dersc(k)=dersc(k)+Ax(k,j)*expfac
delta=0.02d0*pi
escloc=0.0D0
do i=loc_start,loc_end
- if (itype(i).eq.21) cycle
+ if (itype(i).eq.ntyp1) cycle
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)))
cosfac=dsqrt(cosfac2)
sinfac2=0.5d0/(1.0d0-costtab(i+1))
sinfac=dsqrt(sinfac2)
- it=itype(i)
+ it=iabs(itype(i))
if (it.eq.10) goto 1
c
C Compute the axes of tghe local cartesian coordinates system; store in
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)
+ z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
enddo
c write (2,*) "i",i
c write (2,*) "x_prime",(x_prime(j),j=1,3)
C Compute the energy of the ith side cbain
C
c write (2,*) "xx",xx," yy",yy," zz",zz
- it=itype(i)
+ it=iabs(itype(i))
do j = 1,65
x(j) = sc_parmin(j,it)
enddo
Cc diagnostics - remove later
xx1 = dcos(alph(2))
yy1 = dsin(alph(2))*dcos(omeg(2))
- zz1 = -dsin(alph(2))*dsin(omeg(2))
+ zz1 = -dsign(1.0,dfloat(itype(i)))*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 & 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
+c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
+c & ,zz,xx,yy
+c#define DEBUG
#ifdef DEBUG
C
C This section to check the numerical derivatives of the energy of ith side
C
C Compute the gradient of esc
C
+c zz=zz*dsign(1.0,dfloat(itype(i)))
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
& +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
& +(pom1+pom2)*pom_dx
#ifdef DEBUG
- write(2,*), "de_dxx = ", de_dxx,de_dxx_num
+ write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
#endif
C
sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
& +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
& +(pom1-pom2)*pom_dy
#ifdef DEBUG
- write(2,*), "de_dyy = ", de_dyy,de_dyy_num
+ write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
#endif
C
de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*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
+ write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
#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
+ write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
#endif
+c#undef DEBUG
c
C
cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
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)
+ dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
+ & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
+ dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
+ & *dsign(1.0d0,dfloat(itype(i)))*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))
+ 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)
etors=0.0D0
do i=iphi_start,iphi_end
etors_ii=0.0D0
- if (itype(i-2).eq.21 .or. itype(i-1).eq.21
- & .or. itype(i).eq.21) cycle
- itori=itortyp(itype(i-2))
- itori1=itortyp(itype(i-1))
+ if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
+ & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
+ itori=itortyp(itype(i-2))
+ itori1=itortyp(itype(i-1))
phii=phi(i)
gloci=0.0D0
C Proline-Proline pair is a special case...
c lprn=.true.
etors=0.0D0
do i=iphi_start,iphi_end
- if (itype(i-2).eq.21 .or. itype(i-1).eq.21
- & .or. itype(i).eq.21
- & .or. itype(i-3).eq.ntyp1) cycle
- etors_ii=0.0D0
+C ANY TWO ARE DUMMY ATOMS in row CYCLE
+c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
+c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
+c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
+ if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
+ & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
+C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
+C For introducing the NH3+ and COO- group please check the etor_d for reference
+C and guidance
+ etors_ii=0.0D0
+ if (iabs(itype(i)).eq.20) then
+ iblock=2
+ else
+ iblock=1
+ endif
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)
+ do j=1,nterm(itori,itori1,iblock)
+ v1ij=v1(j,itori,itori1,iblock)
+ v2ij=v2(j,itori,itori1,iblock)
cosphi=dcos(j*phii)
sinphi=dsin(j*phii)
etors=etors+v1ij*cosphi+v2ij*sinphi
C
cosphi=dcos(0.5d0*phii)
sinphi=dsin(0.5d0*phii)
- do j=1,nlor(itori,itori1)
+ do j=1,nlor(itori,itori1,iblock)
vl1ij=vlor1(j,itori,itori1)
vl2ij=vlor2(j,itori,itori1)
vl3ij=vlor3(j,itori,itori1)
gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
enddo
C Subtract the constant term
- etors=etors-v0(itori,itori1)
+ etors=etors-v0(itori,itori1,iblock)
if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'etor',i,etors_ii-v0(itori,itori1)
+ & 'etor',i,etors_ii-v0(itori,itori1,iblock)
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)
+ & (v1(j,itori,itori1,iblock),j=1,6),
+ & (v2(j,itori,itori1,iblock),j=1,6)
gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
enddo
lprn=.false.
c lprn=.true.
etors_d=0.0D0
-C write(iout,*) "a tu??"
+c write(iout,*) "a tu??"
do i=iphid_start,iphid_end
- if (itype(i-2).eq.21 .or. itype(i-1).eq.21
- & .or. itype(i).eq.21 .or. itype(i+1).eq.21
- & .or. itype(i-3).eq.ntyp1) cycle
+C ANY TWO ARE DUMMY ATOMS in row CYCLE
+C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
+C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
+C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
+C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
+ if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
+ & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
+ & (itype(i+1).eq.ntyp1)) cycle
+C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
itori=itortyp(itype(i-2))
itori1=itortyp(itype(i-1))
itori2=itortyp(itype(i))
phii1=phi(i+1)
gloci1=0.0D0
gloci2=0.0D0
+ iblock=1
+ if (iabs(itype(i+1)).eq.20) iblock=2
+C Iblock=2 Proline type
+C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
+C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
+C if (itype(i+1).eq.ntyp1) iblock=3
+C The problem of NH3+ group can be resolved by adding new parameters please note if there
+C IS or IS NOT need for this
+C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
+C is (itype(i-3).eq.ntyp1) ntblock=2
+C ntblock is N-terminal blocking group
+
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)
+ do j=1,ntermd_1(itori,itori1,itori2,iblock)
+C Example of changes for NH3+ blocking group
+C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
+C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
+ v1cij=v1c(1,j,itori,itori1,itori2,iblock)
+ v1sij=v1s(1,j,itori,itori1,itori2,iblock)
+ v2cij=v1c(2,j,itori,itori1,itori2,iblock)
+ v2sij=v1s(2,j,itori,itori1,itori2,iblock)
cosphi1=dcos(j*phii)
sinphi1=dsin(j*phii)
cosphi2=dcos(j*phii1)
gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
enddo
- do k=2,ntermd_2(itori,itori1,itori2)
+ do k=2,ntermd_2(itori,itori1,itori2,iblock)
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)
+ v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
+ v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
+ v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
+ v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
cosphi1p2=dcos(l*phii+(k-l)*phii1)
cosphi1m2=dcos(l*phii-(k-l)*phii1)
sinphi1p2=dsin(l*phii+(k-l)*phii1)
if (j.lt.nres-1) then
itj1 = itortyp(itype(j+1))
else
- itj1=ntortyp+1
+ itj1=ntortyp
endif
do iii=1,2
dipi(iii,1)=Ub2(iii,i)
dipderi(iii)=Ub2der(iii,i)
- dipi(iii,2)=b1(iii,iti1)
+ dipi(iii,2)=b1(iii,i+1)
dipj(iii,1)=Ub2(iii,j)
dipderj(iii)=Ub2der(iii,j)
- dipj(iii,2)=b1(iii,itj1)
+ dipj(iii,2)=b1(iii,j+1)
enddo
kkk=0
do iii=1,2
if (i.gt.1) then
iti=itortyp(itype(i))
else
- iti=ntortyp+1
+ iti=ntortyp
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
+ itl1=ntortyp
endif
C A1 kernel(j+1) A2T
cd do iii=1,2
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),b1(1,i),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),b1(1,i),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),b1(1,k+1),AEAb1(1,2,1))
+ call matvec2(AEAderg(1,1,1),b1(1,k+1),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),b1(1,j),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),b1(1,j),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),b1(1,l+1),AEAb1(1,2,2))
+ call matvec2(AEAderg(1,1,2),b1(1,l+1),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))
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),
+ call matvec2(auxmat(1,1),b1(1,i),
& 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),
+ call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
& 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),
+ call matvec2(auxmat(1,1),b1(1,j),
& 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),
+ call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
& 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))
if (i.gt.1) then
iti=itortyp(itype(i))
else
- iti=ntortyp+1
+ iti=ntortyp
endif
itk1=itortyp(itype(k+1))
itl=itortyp(itype(l))
if (j.lt.nres-1) then
itj1=itortyp(itype(j+1))
else
- itj1=ntortyp+1
+ itj1=ntortyp
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),
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),b1(1,i),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),b1(1,i),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),b1(1,k+1),AEAb1(1,2,1))
+ call matvec2(AEAderg(1,1,1),b1(1,k+1),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),b1(1,j+1),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),b1(1,l),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),b1(1,j+1),AEAb1(1,2,2))
+ call matvec2(AEAderg(1,1,2),b1(1,j+1),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))
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),
+ call matvec2(auxmat(1,1),b1(1,i),
& 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),
+ call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
& 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),
+ call matvec2(auxmat(1,1),b1(1,l),
& 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),
+ call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
& 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))
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))
+ eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
& -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)
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))
+ & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
& -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))
+ & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
& -0.5d0*scalar2(vv(1),Ctobr(1,k)))
endif
C Cartesian gradient
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))
+ & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
& -0.5d0*scalar2(vv(1),Ctobr(1,k))
enddo
enddo
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))
+ eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
& -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)
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))
+ & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
& -0.5d0*scalar2(vv(1),Ctobr(1,l)))
C Cartesian gradient
do iii=1,2
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))
+ & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
& -0.5d0*scalar2(vv(1),Ctobr(1,l))
enddo
enddo
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))
+ eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
& -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)
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))
+ & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
& -0.5d0*scalar2(vv(1),Ctobr(1,j)))
C Cartesian gradient
do iii=1,2
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))
+ & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
& -0.5d0*scalar2(vv(1),Ctobr(1,j))
enddo
enddo
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)
+ vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
+ vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
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)
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)
+ vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
+ vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
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))
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)
+ vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
+ & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
+ vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
+ & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
s5=scalar2(vv(1),Dtobr2(1,i))
derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
enddo
if (j.lt.nres-1) then
itj1=itortyp(itype(j+1))
else
- itj1=ntortyp+1
+ itj1=ntortyp
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
+ itl1=ntortyp
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 matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
+ s2=0.5d0*scalar2(b1(1,k),auxvec(1))
+ call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
+ s3=0.5d0*scalar2(b1(1,j+1),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)
#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))
+ call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
+ s3=0.5d0*scalar2(b1(1,j+1),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 matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
+ s2=0.5d0*scalar2(b1(1,k),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)
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),
+ call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
& auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
+ s2=0.5d0*scalar2(b1(1,k),auxvec(1))
+ call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
& auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
+ s3=0.5d0*scalar2(b1(1,j+1),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)
if (j.lt.nres-1) then
itj1=itortyp(itype(j+1))
else
- itj1=ntortyp+1
+ itj1=ntortyp
endif
itk=itortyp(itype(k))
if (k.lt.nres-1) then
itk1=itortyp(itype(k+1))
else
- itk1=ntortyp+1
+ itk1=ntortyp
endif
itl=itortyp(itype(l))
if (l.lt.nres-1) then
itl1=itortyp(itype(l+1))
else
- itl1=ntortyp+1
+ itl1=ntortyp
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,
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))
+ call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
else
- call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
+ call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
endif
call transpose2(EUg(1,1,k),auxmat(1,1))
call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
#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))
+ call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,j),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))
+ call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,l),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
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))
+ call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,j),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))
+ call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
endif
call transpose2(EUgder(1,1,k),auxmat1(1,1))
call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,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))
+ & b1(1,j+1),auxvec(1))
+ s3=-0.5d0*scalar2(b1(1,j),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))
+ & b1(1,l+1),auxvec(1))
+ s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
endif
call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
& pizda(1,1))
#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))
+ ss1=scalar2(Ub2(1,i+2),b1(1,l))
s1 = (auxmat(1,1)+auxmat(2,2))*ss1
#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
+ call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
- s2 = scalar2(b1(1,itk),vtemp1(1))
+ s2 = scalar2(b1(1,k),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 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))
+ ss13 = scalar2(b1(1,k),vtemp4(1))
s13 = (gtemp(1,1)+gtemp(2,2))*ss13
#endif
c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
#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))
+ ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
#endif
- call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
+ call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
+ s2d = scalar2(b1(1,k),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))
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(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
+ s2d = scalar2(b1(1,k),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))
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))
+ ss13d = scalar2(b1(1,k),vtemp4d(1))
s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
#endif
c s1d=0.0d0
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(EUg(1,1,i+2),b1(1,l),vtemp1(1))
call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
& vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
+ s2d = scalar2(b1(1,k),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))
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))
+ ss13d = scalar2(b1(1,k),vtemp4d(1))
s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
enddo
return
end
+CCC----------------------------------------------
+ subroutine Eliptransfer(eliptran)
+ 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'
+ include 'COMMON.SPLITELE'
+ include 'COMMON.SBRIDGE'
+C this is done by Adasko
+C print *,"wchodze"
+C structure of box:
+C water
+C--bordliptop-- buffore starts
+C--bufliptop--- here true lipid starts
+C lipid
+C--buflipbot--- lipid ends buffore starts
+C--bordlipbot--buffore ends
+ eliptran=0.0
+ do i=ilip_start,ilip_end
+C do i=1,1
+ if (itype(i).eq.ntyp1) cycle
+
+ positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
+ if (positi.le.0) positi=positi+boxzsize
+C print *,i
+C first for peptide groups
+c for each residue check if it is in lipid or lipid water border area
+ if ((positi.gt.bordlipbot)
+ &.and.(positi.lt.bordliptop)) then
+C the energy transfer exist
+ if (positi.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((positi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*pepliptran
+ gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
+ gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
+C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
+
+C print *,"doing sccale for lower part"
+C print *,i,sslip,fracinbuf,ssgradlip
+ elseif (positi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*pepliptran
+ gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
+ gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
+C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
+C print *, "doing sscalefor top part"
+C print *,i,sslip,fracinbuf,ssgradlip
+ else
+ eliptran=eliptran+pepliptran
+C print *,"I am in true lipid"
+ endif
+C else
+C eliptran=elpitran+0.0 ! I am in water
+ endif
+ enddo
+C print *, "nic nie bylo w lipidzie?"
+C now multiply all by the peptide group transfer factor
+C eliptran=eliptran*pepliptran
+C now the same for side chains
+CV do i=1,1
+ do i=ilip_start,ilip_end
+ if (itype(i).eq.ntyp1) cycle
+ positi=(mod(c(3,i+nres),boxzsize))
+ if (positi.le.0) positi=positi+boxzsize
+C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
+c for each residue check if it is in lipid or lipid water border area
+C respos=mod(c(3,i+nres),boxzsize)
+C print *,positi,bordlipbot,buflipbot
+ if ((positi.gt.bordlipbot)
+ & .and.(positi.lt.bordliptop)) then
+C the energy transfer exist
+ if (positi.lt.buflipbot) then
+ fracinbuf=1.0d0-
+ & ((positi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*liptranene(itype(i))
+ gliptranx(3,i)=gliptranx(3,i)
+ &+ssgradlip*liptranene(itype(i))
+ gliptranc(3,i-1)= gliptranc(3,i-1)
+ &+ssgradlip*liptranene(itype(i))
+C print *,"doing sccale for lower part"
+ elseif (positi.gt.bufliptop) then
+ fracinbuf=1.0d0-
+ &((bordliptop-positi)/lipbufthick)
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*liptranene(itype(i))
+ gliptranx(3,i)=gliptranx(3,i)
+ &+ssgradlip*liptranene(itype(i))
+ gliptranc(3,i-1)= gliptranc(3,i-1)
+ &+ssgradlip*liptranene(itype(i))
+C print *, "doing sscalefor top part",sslip,fracinbuf
+ else
+ eliptran=eliptran+liptranene(itype(i))
+C print *,"I am in true lipid"
+ endif
+ endif ! if in lipid or buffor
+C else
+C eliptran=elpitran+0.0 ! I am in water
+ enddo
+ return
+ end
+C---------------------------------------------------------
+C AFM soubroutine for constant force
+ subroutine AFMforce(Eafmforce)
+ 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'
+ include 'COMMON.SPLITELE'
+ include 'COMMON.SBRIDGE'
+ real*8 diffafm(3)
+ dist=0.0d0
+ Eafmforce=0.0d0
+ do i=1,3
+ diffafm(i)=c(i,afmend)-c(i,afmbeg)
+ dist=dist+diffafm(i)**2
+ enddo
+ dist=dsqrt(dist)
+ Eafmforce=-forceAFMconst*(dist-distafminit)
+ do i=1,3
+ gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
+ gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
+ enddo
+C print *,'AFM',Eafmforce
+ return
+ end
+C---------------------------------------------------------
+C AFM subroutine with pseudoconstant velocity
+ subroutine AFMvel(Eafmforce)
+ 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'
+ include 'COMMON.SPLITELE'
+ include 'COMMON.SBRIDGE'
+ real*8 diffafm(3)
+C Only for check grad COMMENT if not used for checkgrad
+C totT=3.0d0
+C--------------------------------------------------------
+C print *,"wchodze"
+ dist=0.0d0
+ Eafmforce=0.0d0
+ do i=1,3
+ diffafm(i)=c(i,afmend)-c(i,afmbeg)
+ dist=dist+diffafm(i)**2
+ enddo
+ dist=dsqrt(dist)
+ Eafmforce=0.5d0*forceAFMconst
+ & *(distafminit+totTafm*velAFMconst-dist)**2
+C Eafmforce=-forceAFMconst*(dist-distafminit)
+ do i=1,3
+ gradafm(i,afmend-1)=-forceAFMconst*
+ &(distafminit+totTafm*velAFMconst-dist)
+ &*diffafm(i)/dist
+ gradafm(i,afmbeg-1)=forceAFMconst*
+ &(distafminit+totTafm*velAFMconst-dist)
+ &*diffafm(i)/dist
+ enddo
+C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
+ return
+ end
maxsi=100
cd write (iout,*) 'Gen_Rand_conf: nstart=',nstart
if (nstart.lt.5) then
- it1=itype(2)
- phi(4)=gen_phi(4,itype(2),itype(3))
+ it1=iabs(itype(2))
+ phi(4)=gen_phi(4,iabs(itype(2)),iabs(itype(3)))
c write(iout,*)'phi(4)=',rad2deg*phi(4)
- if (nstart.lt.3) theta(3)=gen_theta(itype(2),pi,phi(4))
+ if (nstart.lt.3) theta(3)=gen_theta(iabs(itype(2)),pi,phi(4))
c write(iout,*)'theta(3)=',rad2deg*theta(3)
if (it1.ne.10) then
nsi=0
endif
return1
endif
- it1=itype(i-1)
- it2=itype(i-2)
- it=itype(i)
+ it1=iabs(itype(i-1))
+ it2=iabs(itype(i-2))
+ it=iabs(itype(i))
c print *,'Gen_Rand_Conf: i=',i,' it=',it,' it1=',it1,' it2=',it2,
c & ' nit=',nit,' niter=',niter,' maxgen=',maxgen
phi(i+1)=gen_phi(i+1,it1,it)
include 'COMMON.FFIELD'
data redfac /0.5D0/
overlap=.false.
- iti=itype(i)
+ iti=iabs(itype(i))
if (iti.gt.ntyp) return
C Check for SC-SC overlaps.
cd print *,'nnt=',nnt,' nct=',nct
do j=nnt,i-1
- itj=itype(j)
+ itj=iabs(itype(j))
if (j.lt.i-1 .or. ipot.ne.4) then
rcomp=sigmaii(iti,itj)
else
c(j,maxres2+1)=0.5D0*(c(j,i)+c(j,i+1))
enddo
do j=nnt,i-2
- itj=itype(j)
+ itj=iabs(itype(j))
cd print *,'overlap, p-Sc: i=',i,' j=',j,
cd & ' dist=',dist(nres+j,maxres2+1)
if (dist(nres+j,maxres2+1).lt.4.0D0*redfac) then
endif
thet_pred_mean=a0thet(it)
do k=1,2
- thet_pred_mean=thet_pred_mean+athet(k,it)*y(k)+bthet(k,it)*z(k)
+ thet_pred_mean=thet_pred_mean+athet(k,it,1,1)*y(k)
+ & +bthet(k,it,1,1)*z(k)
enddo
sig=polthet(3,it)
do j=2,0,-1
do ires=1,ioverlap_last
i=ioverlap(ires)
- iti=itype(i)
+ iti=iabs(itype(i))
if (iti.ne.10) then
nsi=0
fail=.true.
c print *,'>>overlap_sc nnt=',nnt,' nct=',nct
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
- itypj=itype(j)
+ itypj=iabs(itype(j))
dscj_inv=dsc_inv(itypj)
sig0ij=sigma(itypi,itypj)
chi1=chi(itypi,itypj)
ires=0
do i=nnt,nct
iti=itype(i)
- if (iti.eq.21) then
+ if ((iti.eq.ntyp1).and.((itype(i+1)).eq.ntyp1)) then
ichain=ichain+1
ires=0
write (iunit,'(a)') 'TER'
ires=ires+1
iatom=iatom+1
ica(i)=iatom
+ if (iti.ne.ntyp1) then
write (iunit,10) iatom,restyp(iti),chainid(ichain),
& ires,(c(j,i),j=1,3),vtot(i)
if (iti.ne.10) then
write (iunit,20) iatom,restyp(iti),chainid(ichain),
& ires,(c(j,nres+i),j=1,3),
& vtot(i+nres)
+ endif
endif
endif
enddo
write (iunit,'(a)') 'TER'
do i=nnt,nct-1
- if (itype(i).eq.21) cycle
- if (itype(i).eq.10 .and. itype(i+1).ne.21) then
+ if (itype(i).eq.ntyp1) cycle
+ if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then
write (iunit,30) ica(i),ica(i+1)
- else if (itype(i).ne.10 .and. itype(i+1).ne.21) then
+ else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then
write (iunit,30) ica(i),ica(i+1),ica(i)+1
- else if (itype(i).ne.10 .and. itype(i+1).eq.21) then
+ else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then
write (iunit,30) ica(i),ica(i)+1
endif
enddo
open(istat,file=statname,access="append")
#endif
#endif
+ if (AFMlog.gt.0) then
+ if (refstr) then
+ call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
+ write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,4f12.3,i5,$)')
+ & itime,totT,EK,potE,totE,
+ & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(),
+ & potEcomp(23),me
+ format1="a133"
+ else
+C print *,'A CHUJ',potEcomp(23)
+ write (line1,'(i10,f15.2,7f12.3,i5,$)')
+ & itime,totT,EK,potE,totE,
+ & kinetic_T,t_bath,gyrate(),
+ & potEcomp(23),me
+ format1="a114"
+ endif
+ else if (selfguide.gt.0) then
+ distance=0.0
+ do j=1,3
+ distance=distance+(c(j,afmend)-c(j,afmbeg))**2
+ enddo
+ distance=dsqrt(distance)
+ if (refstr) then
+ call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
+ write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,f12.3,f10.1,2f8.2,
+ & f9.2,i5,$)')
+ & itime,totT,EK,potE,totE,
+ & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(),
+ & distance,potEcomp(23),me
+ format1="a133"
+C print *,"CHUJOWO"
+ else
+C print *,'A CHUJ',potEcomp(23)
+ write (line1,'(i10,f15.2,8f12.3,i5,$)')
+ & itime,totT,EK,potE,totE,
+ & kinetic_T,t_bath,gyrate(),
+ & distance,potEcomp(23),me
+ format1="a114"
+ endif
+ else
if (refstr) then
call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
& 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),
do i=1,nres-3
gloc(i,icg)=gloc(i,icg)+dugamma(i)
enddo
- write(iout,*) "TU JESTEM?"
do i=1,nres-2
gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
enddo
- write(iout,*) "TU JESTEM?"
endif
#ifdef TIMING
time01=MPI_Wtime()
#ifdef DEBUG
write (iout,*) "gcart, gxcart, gloc before int_to_cart"
#endif
- do i=1,nct
+ do i=0,nct
do j=1,3
gcart(j,i)=gradc(j,i,icg)
gxcart(j,i)=gradx(j,i,icg)
C
C Initialize Cartesian-coordinate gradient
C
- do i=1,nres
+ do i=-1,nres
do j=1,3
gvdwx(j,i)=0.0D0
gradx_scp(j,i)=0.0D0
gradx(j,i,icg)=0.0d0
gscloc(j,i)=0.0d0
gsclocx(j,i)=0.0d0
+ gliptranc(j,i)=0.0d0
+ gliptranx(j,i)=0.0d0
+ gradafm(j,i)=0.0d0
do intertyp=1,3
gloc_sc(intertyp,i,icg)=0.0d0
enddo
igeom= 8
intin= 9
ithep= 11
+ ithep_pdb=51
irotam=12
+ irotam_pdb=52
itorp= 13
itordp= 23
ielep= 14
icsa_in=40
crc for ifc error 118
icsa_pdb=42
+C Lipidic input file for parameters range 60-79
+ iliptranpar=60
+C input file for transfer sidechain and peptide group inside the
+C lipidic environment if lipid is implicite
+
+C DNA input files for parameters range 80-99
+C Suger input files for parameters range 100-119
+C All-atom input files for parameters range 120-149
C
C Set default weights of the energy terms.
C
enddo
do i=1,ntyp
do j=1,ntyp
- aa(i,j)=0.0D0
- bb(i,j)=0.0D0
+ aa_aq(i,j)=0.0D0
+ bb_aq(i,j)=0.0D0
+ aa_lip(i,j)=0.0D0
+ bb_lip(i,j)=0.0D0
augm(i,j)=0.0D0
sigma(i,j)=0.0D0
r0(i,j)=0.0D0
rr0(i)=0.0D0
a0thet(i)=0.0D0
do j=1,2
- athet(j,i)=0.0D0
- bthet(j,i)=0.0D0
+ do ichir1=-1,1
+ do ichir2=-1,1
+ athet(j,i,ichir1,ichir2)=0.0D0
+ bthet(j,i,ichir1,ichir2)=0.0D0
+ enddo
+ enddo
enddo
- do j=0,3
+ do j=0,3
polthet(j,i)=0.0D0
enddo
do j=1,3
enddo
nlob(ntyp1)=0
dsc(ntyp1)=0.0D0
- do i=1,maxtor
- itortyp(i)=0
- do j=1,maxtor
- do k=1,maxterm
- v1(k,j,i)=0.0D0
- v2(k,j,i)=0.0D0
+ do i=-maxtor,maxtor
+ itortyp(i)=0
+cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
+ do iblock=1,2
+ do j=-maxtor,maxtor
+ do k=1,maxterm
+ v1(k,j,i,iblock)=0.0D0
+ v2(k,j,i,iblock)=0.0D0
enddo
enddo
+ enddo
enddo
+ do iblock=1,2
+ do i=-maxtor,maxtor
+ do j=-maxtor,maxtor
+ do k=-maxtor,maxtor
+ do l=1,maxtermd_1
+ v1c(1,l,i,j,k,iblock)=0.0D0
+ v1s(1,l,i,j,k,iblock)=0.0D0
+ v1c(2,l,i,j,k,iblock)=0.0D0
+ v1s(2,l,i,j,k,iblock)=0.0D0
+ enddo !l
+ do l=1,maxtermd_2
+ do m=1,maxtermd_2
+ v2c(m,l,i,j,k,iblock)=0.0D0
+ v2s(m,l,i,j,k,iblock)=0.0D0
+ enddo !m
+ enddo !l
+ enddo !k
+ enddo !j
+ enddo !i
+ enddo !iblock
+
do i=1,maxres
itype(i)=0
itel(i)=0
ihpb(i)=0
jhpb(i)=0
enddo
+C Initialize correlation arrays
+ do i=1,maxres
+ do k=1,2
+ b1(k,i)=0.0
+ b2(k,i)=0.0
+ b1tilde(k,i)=0.0
+c b2tilde(k,i)=0.0
+ do j=1,2
+C CC(j,k,i)=0.0
+C Ctilde(j,k,i)=0.0
+C DD(j,k,i)=0.0
+C Dtilde(j,k,i)=0.0
+ EE(j,k,i)=0.0
+ enddo
+ enddo
+ enddo
+ do i=-maxtor,maxtor
+ do k=1,2
+ do j=1,2
+ CC(j,k,i)=0.0
+ Ctilde(j,k,i)=0.0
+ DD(j,k,i)=0.0
+ Dtilde(j,k,i)=0.0
+ enddo
+ enddo
+ enddo
C
C Initialize timing.
C
C Initialize constants used to split the energy into long- and short-range
C components
C
- r_cut=2.0d0
- rlamb=0.3d0
+C r_cut=2.0d0
+C rlamb=0.3d0
#ifndef SPLITELE
nprint_ene=nprint_ene-1
#endif
include 'COMMON.NAMES'
include 'COMMON.FFIELD'
data restyp /
+ &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
+ & 'DSG','DGN','DSN','DTH',
+ &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
&'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
- &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
+ &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
+ &'AIB','ABU','D'/
data onelet /
+ &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
+ &'a','y','w','v','l','i','f','m','c','x',
&'C','M','F','I','L','V','W','Y','A','G','T',
- &'S','Q','N','E','D','H','R','K','P','X'/
+ &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
data potname /'LJ','LJK','BP','GB','GBV'/
data ename /
& "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
call int_bounds(nct-nnt,ibondp_start,ibondp_end)
ibondp_start=ibondp_start+nnt
ibondp_end=ibondp_end+nnt
+ call int_bounds(nres,ilip_start,ilip_end)
+ ilip_start=ilip_start
call int_bounds1(nres-1,ivec_start,ivec_end)
c print *,"Processor",myrank,fg_rank,fg_rank1,
c & " ivec_start",ivec_start," ivec_end",ivec_end
ibond_start=2
ibond_end=nres-1
ibondp_start=nnt
- ibondp_end=nct-1
+C ibondp_end=nct-1
+ ibondp_end=nct
ivec_start=1
ivec_end=nres-1
iset_start=3
iset_end=nres+1
iint_start=2
iint_end=nres-1
+ ilip_start=1
+ ilip_end=nres
#endif
return
end
include 'COMMON.MD'
include 'COMMON.IOUNITS'
include 'COMMON.SCCOR'
-c calculating dE/ddc1
+ include 'COMMON.CONTROL'
+c calculating dE/ddc1
+C print *,"wchodze22",ialph(2,1)
if (nres.lt.3) go to 18
do j=1,3
gcart(j,1)=gcart(j,1)+gloc(1,icg)*dphi(j,1,4)
& gloc(ialph(2,1)+nside,icg)*domega(j,1,2)
endif
enddo
-C write (iout,*) "????A CO TO??"
+C print *,"wchodze22",ialph(2,1)
c Calculating the remainder of dE/ddc2
do j=1,3
gcart(j,2)=gcart(j,2)+gloc(1,icg)*dphi(j,2,4)+
& gloc(nres-2,icg)*dtheta(j,2,3)+gloc(nres-1,icg)*dtheta(j,1,4)
- if((itype(2).ne.10).and.(itype(2).ne.ntyp1)) then
+ if(itype(2).ne.10) then
gcart(j,2)=gcart(j,2)+gloc(ialph(2,1),icg)*dalpha(j,2,2)+
& gloc(ialph(2,1)+nside,icg)*domega(j,2,2)
endif
- if((itype(3).ne.10).and.(itype(3).ne.21)) then
+ if(itype(3).ne.10) then
gcart(j,2)=gcart(j,2)+gloc(ialph(3,1),icg)*dalpha(j,1,3)+
& gloc(ialph(3,1)+nside,icg)*domega(j,1,3)
endif
gcart(j,2)=gcart(j,2)+gloc(2,icg)*dphi(j,1,5)
endif
enddo
+C print *,"wchodze22",ialph(2,1)
c If there are only five residues
if(nres.eq.5) then
do j=1,3
endif
enddo
endif
-C write (iout,*) "Poniezej blad??",ialph(3,1),nside,ialph(4,1)
c If there are more than five residues
if(nres.gt.5) then
+C print *,"wchodze22",ialph(2,1)
do i=3,nres-3
+C print *,i,ialph(i,1)+nside
do j=1,3
gcart(j,i)=gcart(j,i)+gloc(i-2,icg)*dphi(j,3,i+1)
& +gloc(i-1,icg)*dphi(j,2,i+2)+
enddo
enddo
endif
-c Setting dE/ddnres-2
-C write(iout,*) "ATUCHUJ?"
+C print *,"wchodze22",ialph(2,1)
+
+c Setting dE/ddnres-2
if(nres.gt.5) then
do j=1,3
gcart(j,nres-2)=gcart(j,nres-2)+gloc(nres-4,icg)*
& dphi(j,3,nres-1)+gloc(nres-3,icg)*dphi(j,2,nres)
& +gloc(2*nres-6,icg)*
& dtheta(j,2,nres-1)+gloc(2*nres-5,icg)*dtheta(j,1,nres)
- if((itype(nres-2).ne.10).and.(itype(nres-2).ne.ntyp1)) then
+ if(itype(nres-2).ne.10) then
gcart(j,nres-2)=gcart(j,nres-2)+gloc(ialph(nres-2,1),icg)*
& dalpha(j,2,nres-2)+gloc(ialph(nres-2,1)+nside,icg)*
& domega(j,2,nres-2)
endif
- if((itype(nres-1).ne.10).and.(itype(nres-1).ne.ntyp1)) then
+ if(itype(nres-1).ne.10) then
gcart(j,nres-2)=gcart(j,nres-2)+gloc(ialph(nres-1,1),icg)*
& dalpha(j,1,nres-1)+gloc(ialph(nres-1,1)+nside,icg)*
& domega(j,1,nres-1)
do j=1,3
gcart(j,nres-1)=gcart(j,nres-1)+gloc(nres-3,icg)*dphi(j,3,nres)+
& gloc(2*nres-5,icg)*dtheta(j,2,nres)
- if((itype(nres-1).ne.10).and.(itype(nres-1).ne.ntyp1)) then
+ if(itype(nres-1).ne.10) then
gcart(j,nres-1)=gcart(j,nres-1)+gloc(ialph(nres-1,1),icg)*
& dalpha(j,2,nres-1)+gloc(ialph(nres-1,1)+nside,icg)*
& domega(j,2,nres-1)
& +gloc(ialph(i,1)+nside,icg)*domega(j,3,i)
enddo
endif
- enddo
-C write(iout,*) "TU DOCHODZE"
-
+ enddo
c----------------------------------------------------------------------
C INTERTYP=1 SC...Ca...Ca...Ca
C INTERTYP=2 Ca...Ca...Ca...SC
c gloc(i,icg)=0.0D0
c write (iout,*) "poczotkoawy",i,gloc_sc(1,i,icg)
c enddo
+C print *,"tu dochodze??"
if (nres.lt.2) return
if ((nres.lt.3).and.(itype(1).eq.10)) return
if ((itype(1).ne.10).and.(itype(1).ne.ntyp1)) then
enddo
endif
c The side-chain vector derivatives
+C if (SELFGUIDE.gt.0) then
+C do j=1,3
+C gcart(j,afmbeg)=gcart(j,afmbeg)+gcart(j,afmend)
+C gcart(j,afmbeg)=0.0d0
+C gcart(j,afmend)=0.0d0
+C enddo
+C endif
return
end
cost=dcos(theta(i))
sint=sqrt(1-cost*cost)
do j=1,3
-C if (itype(i-1).ne.21) then
dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/
& vbld(i-1)
- if (itype(i-1).ne.21) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
+c if (itype(i-1).ne.ntyp1)
+ dtheta(j,1,i)=-dcostheta(j,1,i)/sint
dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/
& vbld(i)
- if (itype(i-1).ne.21) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
-C endif
+c if (itype(i-1).ne.ntyp1)
+ dtheta(j,2,i)=-dcostheta(j,2,i)/sint
enddo
enddo
#if defined(MPI) && defined(PARINTDER)
#else
do i=4,nres
#endif
-c if (itype(i-1).eq.21 .or. itype(i-2).eq.21 ) cycle
+c if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
+c & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
c the conventional case
sint=dsin(theta(i))
sint1=dsin(theta(i-1))
ctgt=cost/sint
ctgt1=cost1/sint1
cosg_inv=1.0d0/cosg
- if (itype(i-1).ne.21 .and. itype(i-2).ne.21) then
- dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1)
+c if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
+ dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1)
& -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
dsinphi(j,2,i)=
& +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
- endif
+c endif
c Bug fixed 3/24/05 (AL)
enddo
c Obtaining the gamma derivatives from cosine derivative
else
do j=1,3
- if (itype(i-1).ne.21 .and. itype(i-2).ne.21) then
+c if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3*
& dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp*
& dc_norm(j,i-3))/vbld(i-2)
& dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp*
& dc_norm(j,i-1))/vbld(i)
dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
- endif
+c endif
enddo
endif
enddo
- do i=1,nres-1
- do j=1,3
- dc_norm2(j,i+nres)=-dc_norm(j,i+nres)
- enddo
- enddo
Calculate derivative of Tauangle
#ifdef PARINTDER
do i=itau_start,itau_end
cost=dcos(theta(i))
cost1=dcos(omicron(2,i-1))
cosg=dcos(tauangle(1,i))
-C do j=1,3
-C dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
+ do j=1,3
+ dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
cc write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
-C enddo
+ enddo
scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
fac0=1.0d0/(sint1*sint)
fac1=cost*fac0
cost=dcos(omicron(1,i))
cost1=dcos(theta(i-1))
cosg=dcos(tauangle(2,i))
-C do j=1,3
-C dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
-C enddo
+c do j=1,3
+c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
+c enddo
scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
fac0=1.0d0/(sint1*sint)
fac1=cost*fac0
call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
-C print *,"chuj"
do j=1,3
ctgt=cost/sint
ctgt1=cost1/sint1
cosg_inv=1.0d0/cosg
dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1)
& +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
-
-C write(12,*) i,j,dc_norm2(1,i-1+nres),dc_norm(1,i-2)
-
+c write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
+c &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
-
dsintau(j,2,2,i)=
& -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i))
& -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
-
+c write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
+c & sing*ctgt*domicron(j,1,2,i),
+c & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
-
+c Bug fixed 3/24/05 (AL)
dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i)
& +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
-
c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
-
-
-
enddo
c Obtaining the gamma derivatives from cosine derivative
else
cost=dcos(omicron(1,i))
cost1=dcos(omicron(2,i-1))
cosg=dcos(tauangle(3,i))
-C do j=1,3
-C dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
-C dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
-C enddo
+ do j=1,3
+ dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
+c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
+ enddo
scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
fac0=1.0d0/(sint1*sint)
fac1=cost*fac0
& *vbld_inv(i-1+nres)
c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
-
-
enddo
c Obtaining the gamma derivatives from cosine derivative
else
#else
do i=2,nres-1
#endif
- if(itype(i).ne.10 .and. itype(i).ne.21) then
+ if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then
fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
fac6=fac5/vbld(i)
fac7=fac5*fac5
write (iout,*)
& "Analytical (upper) and numerical (lower) gradient of alpha"
do i=2,nres-1
- if((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then
+ if(itype(i).ne.10) then
do j=1,3
dcji=dc(j,i-1)
dc(j,i-1)=dcji+aincr
write (iout,*)
& "Analytical (upper) and numerical (lower) gradient of omega"
do i=2,nres-1
- if((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then
+ if(itype(i).ne.10) then
do j=1,3
dcji=dc(j,i-1)
dc(j,i-1)=dcji+aincr
enddo
return
end
-
+c------------------------------------------------------------
subroutine chainbuild_cart
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
#endif
do j=1,3
c(j,1)=dc(j,0)
+c c(j,1)=c(j,1)
enddo
do i=2,nres
do j=1,3
c(j,i+nres)=c(j,i)+dc(j,i+nres)
enddo
enddo
+C print *,'tutu'
c write (iout,*) "CHAINBUILD_CART"
c call cartprint
call int_from_cart1(.false.)
c The rotational part of the side chain virtual bond
KEr_sc=0.0D0
do i=nnt,nct
- iti=itype(i)
+ iti=iabs(itype(i))
if (itype(i).ne.10) then
do j=1,3
incr(j)=d_t(j,nres+i)
enddo
if (lprn) write (iout,*) "Potential forces sidechain"
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
if (lprn) write (iout,'(i5,3e15.5,5x,3e15.5)')
& i,(-gcart(j,i),j=1,3)
do j=1,3
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
ind=ind+1
d_a(j,i+nres)=d_a_work(ind)
m1=nct-nnt+1
ind=0
ind1=0
- msc(21)=1.0d0
+ msc(ntyp1)=1.0d0
do i=nnt,nct
ind=ind+1
ii = ind+m
do while (iorder.ge.0)
c write (*,*) 'Processor',fg_rank,' CG group',kolor,
c & ' receives order from Master'
+#ifdef MPI
time00=MPI_Wtime()
call MPI_Bcast(iorder,1,MPI_INTEGER,king,FG_COMM,IERR)
time_Bcast=time_Bcast+MPI_Wtime()-time00
if (icall.gt.4 .and. iorder.ge.0)
& time_order(iorder)=time_order(iorder)+MPI_Wtime()-time00
+#endif
icall=icall+1
c write (*,*)
c & 'Processor',fg_rank,' completed receive MPI_BCAST order',iorder
enddo
do i=nnt,nct
- iti=itype(i)
+ iti=iabs(itype(i))
inres=i+nres
do j=1,3
pr(j)=c(j,inres)-cm(j)
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
- iti=itype(i)
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
+ iti=iabs(itype(i))
inres=i+nres
Im(1,1)=Im(1,1)+Isc(iti)*(1-dc_norm(1,inres)*
& dc_norm(1,inres))*vbld(inres)*vbld(inres)
enddo
enddo
do i=nnt,nct
- if(itype(i).ne.10 .and. itype(i).ne.21) then
+ if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then
inres=i+nres
call vecpr(vrot(1),dc(1,inres),vp)
do j=1,3
incr(j)=d_t(j,0)
enddo
do i=nnt,nct
- iti=itype(i)
+ iti=iabs(itype(i))
inres=i+nres
do j=1,3
pr(j)=c(j,inres)-cm(j)
enddo
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
v(j)=incr(j)+d_t(j,inres)
enddo
L(j)=L(j)+msc(iabs(iti))*vp(j)
enddo
c write (iout,*) "L",(l(j),j=1,3)
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
v(j)=incr(j)+d_t(j,inres)
enddo
vcm(j)=vcm(j)+mp*(vv(j)+0.5d0*d_t(j,i))
enddo
endif
- amas=msc(itype(i))
+ amas=msc(iabs(itype(i)))
summas=summas+amas
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
vcm(j)=vcm(j)+amas*(vv(j)+d_t(j,i+nres))
enddo
include 'COMMON.SETUP'
character*1 t1,t2,t3
character*1 onelett(4) /"G","A","P","D"/
+ character*1 toronelet(-2:2) /"p","a","G","A","P"/
logical lprint,LaTeX
dimension blower(3,3,maxlob)
- dimension b(13)
+C dimension b(13)
character*3 lancuch,ucase
C
C For printing parameters after they are read set the following in the UNRES
c and Stokes' radii of the peptide group and side chains
c
#ifdef CRYST_BOND
- read (ibond,*) vbldp0,akp,mp,ip,pstok
+ read (ibond,*) vbldp0,vbldpdum,akp,mp,ip,pstok
do i=1,ntyp
nbondterm(i)=1
read (ibond,*) vbldsc0(1,i),aksc(1,i),msc(i),isc(i),restok(i)
endif
enddo
#else
- read (ibond,*) junk,vbldp0,akp,rjunk,mp,ip,pstok
+ read (ibond,*) junk,vbldp0,vbldpdum,akp,rjunk,mp,ip,pstok
do i=1,ntyp
read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i),
& j=1,nbondterm(i)),msc(i),isc(i),restok(i)
enddo
enddo
endif
+C reading lipid parameters
+ read(iliptranpar,*) pepliptran
+ do i=1,ntyp
+ read(iliptranpar,*) liptranene(i)
+ enddo
+ close(iliptranpar)
#ifdef CRYST_THETA
C
C Read the parameters of the probability distribution/energy expression
C of the virtual-bond valence angles theta
C
do i=1,ntyp
- read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2),
- & (bthet(j,i),j=1,2)
+ read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i,1,1),j=1,2),
+ & (bthet(j,i,1,1),j=1,2)
read (ithep,*,err=111,end=111) (polthet(j,i),j=0,3)
- read (ithep,*,err=111,end=111) (gthet(j,i),j=1,3)
- read (ithep,*,err=111,end=111) theta0(i),sig0(i),sigc0(i)
- sigc0(i)=sigc0(i)**2
+ read (ithep,*,err=111,end=111) (gthet(j,i),j=1,3)
+ read (ithep,*,err=111,end=111) theta0(i),sig0(i),sigc0(i)
+ sigc0(i)=sigc0(i)**2
enddo
+ do i=1,ntyp
+ athet(1,i,1,-1)=athet(1,i,1,1)
+ athet(2,i,1,-1)=athet(2,i,1,1)
+ bthet(1,i,1,-1)=-bthet(1,i,1,1)
+ bthet(2,i,1,-1)=-bthet(2,i,1,1)
+ athet(1,i,-1,1)=-athet(1,i,1,1)
+ athet(2,i,-1,1)=-athet(2,i,1,1)
+ bthet(1,i,-1,1)=bthet(1,i,1,1)
+ bthet(2,i,-1,1)=bthet(2,i,1,1)
+ enddo
+ do i=-ntyp,-1
+ a0thet(i)=a0thet(-i)
+ athet(1,i,-1,-1)=athet(1,-i,1,1)
+ athet(2,i,-1,-1)=-athet(2,-i,1,1)
+ bthet(1,i,-1,-1)=bthet(1,-i,1,1)
+ bthet(2,i,-1,-1)=-bthet(2,-i,1,1)
+ athet(1,i,-1,1)=athet(1,-i,1,1)
+ athet(2,i,-1,1)=-athet(2,-i,1,1)
+ bthet(1,i,-1,1)=-bthet(1,-i,1,1)
+ bthet(2,i,-1,1)=bthet(2,-i,1,1)
+ athet(1,i,1,-1)=-athet(1,-i,1,1)
+ athet(2,i,1,-1)=athet(2,-i,1,1)
+ bthet(1,i,1,-1)=bthet(1,-i,1,1)
+ bthet(2,i,1,-1)=-bthet(2,-i,1,1)
+ theta0(i)=theta0(-i)
+ sig0(i)=sig0(-i)
+ sigc0(i)=sigc0(-i)
+ do j=0,3
+ polthet(j,i)=polthet(j,-i)
+ enddo
+ do j=1,3
+ gthet(j,i)=gthet(j,-i)
+ enddo
+ enddo
+
close (ithep)
if (lprint) then
if (.not.LaTeX) then
& ' B1 ',' B2 '
do i=1,ntyp
write(iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i,
- & a0thet(i),(athet(j,i),j=1,2),(bthet(j,i),j=1,2)
+ & a0thet(i),(athet(j,i,1,1),j=1,2),(bthet(j,i,1,1),j=1,2)
enddo
write (iout,'(/a/9x,5a/79(1h-))')
& 'Parameters of the expression for sigma(theta_c):',
& ' b1*10^1 ',' b2*10^1 '
do i=1,ntyp
write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i),
- & a0thet(i),(100*athet(j,i),j=1,2),(10*bthet(j,i),j=1,2)
+ & a0thet(i),(100*athet(j,i,1,1),j=1,2),
+ & (10*bthet(j,i,1,1),j=1,2)
enddo
write (iout,'(/a/9x,5a/79(1h-))')
& 'Parameters of the expression for sigma(theta_c):',
& ntheterm3,nsingle,ndouble
nntheterm=max0(ntheterm,ntheterm2,ntheterm3)
read (ithep,*,err=111,end=111) (ithetyp(i),i=1,ntyp1)
- do i=1,maxthetyp
- do j=1,maxthetyp
- do k=1,maxthetyp
- aa0thet(i,j,k)=0.0d0
+ do i=-ntyp1,-1
+ ithetyp(i)=-ithetyp(-i)
+ enddo
+ do iblock=1,2
+ do i=-maxthetyp,maxthetyp
+ do j=-maxthetyp,maxthetyp
+ do k=-maxthetyp,maxthetyp
+ aa0thet(i,j,k,iblock)=0.0d0
do l=1,ntheterm
- aathet(l,i,j,k)=0.0d0
+ aathet(l,i,j,k,iblock)=0.0d0
enddo
do l=1,ntheterm2
do m=1,nsingle
- bbthet(m,l,i,j,k)=0.0d0
- ccthet(m,l,i,j,k)=0.0d0
- ddthet(m,l,i,j,k)=0.0d0
- eethet(m,l,i,j,k)=0.0d0
+ bbthet(m,l,i,j,k,iblock)=0.0d0
+ ccthet(m,l,i,j,k,iblock)=0.0d0
+ ddthet(m,l,i,j,k,iblock)=0.0d0
+ eethet(m,l,i,j,k,iblock)=0.0d0
enddo
enddo
do l=1,ntheterm3
do m=1,ndouble
do mm=1,ndouble
- ffthet(mm,m,l,i,j,k)=0.0d0
- ggthet(mm,m,l,i,j,k)=0.0d0
+ ffthet(mm,m,l,i,j,k,iblock)=0.0d0
+ ggthet(mm,m,l,i,j,k,iblock)=0.0d0
enddo
enddo
enddo
enddo
enddo
- enddo
- do i=1,nthetyp
- do j=1,nthetyp
- do k=1,nthetyp
- read (ithep,'(3a)',end=111,err=111) res1,res2,res3
- read (ithep,*,end=111,err=111) aa0thet(i,j,k)
- read (ithep,*,end=111,err=111)(aathet(l,i,j,k),l=1,ntheterm)
+ enddo
+ enddo
+c VAR:iblock means terminally blocking group 1=non-proline 2=proline
+ do iblock=1,2
+c VAR:ntethtyp is type of theta potentials type currently 0=glycine
+c VAR:1=non-glicyne non-proline 2=proline
+c VAR:negative values for D-aminoacid
+ do i=0,nthetyp
+ do j=-nthetyp,nthetyp
+ do k=-nthetyp,nthetyp
+ read (ithep,'(6a)',end=111,err=111) res1
+ read (ithep,*,end=111,err=111) aa0thet(i,j,k,iblock)
+c VAR: aa0thet is variable describing the average value of Foureir
+c VAR: expansion series
+c VAR: aathet is foureir expansion in theta/2 angle for full formula
+c VAR: look at the fitting equation in Kozlowska et al., J. Phys.:
+Condens. Matter 19 (2007) 285203 and Sieradzan et al., unpublished
+ read (ithep,*,end=111,err=111)
+ &(aathet(l,i,j,k,iblock),l=1,ntheterm)
read (ithep,*,end=111,err=111)
- & ((bbthet(lll,ll,i,j,k),lll=1,nsingle),
- & (ccthet(lll,ll,i,j,k),lll=1,nsingle),
- & (ddthet(lll,ll,i,j,k),lll=1,nsingle),
- & (eethet(lll,ll,i,j,k),lll=1,nsingle),ll=1,ntheterm2)
+ & ((bbthet(lll,ll,i,j,k,iblock),lll=1,nsingle),
+ & (ccthet(lll,ll,i,j,k,iblock),lll=1,nsingle),
+ & (ddthet(lll,ll,i,j,k,iblock),lll=1,nsingle),
+ & (eethet(lll,ll,i,j,k,iblock),lll=1,nsingle),
+ & ll=1,ntheterm2)
read (ithep,*,end=111,err=111)
- & (((ffthet(llll,lll,ll,i,j,k),ffthet(lll,llll,ll,i,j,k),
- & ggthet(llll,lll,ll,i,j,k),ggthet(lll,llll,ll,i,j,k),
+ & (((ffthet(llll,lll,ll,i,j,k,iblock),
+ & ffthet(lll,llll,ll,i,j,k,iblock),
+ & ggthet(llll,lll,ll,i,j,k,iblock),
+ & ggthet(lll,llll,ll,i,j,k,iblock),
& llll=1,lll-1),lll=2,ndouble),ll=1,ntheterm3)
enddo
enddo
C
C For dummy ends assign glycine-type coefficients of theta-only terms; the
C coefficients of theta-and-gamma-dependent terms are zero.
-C
+C IF YOU WANT VALENCE POTENTIALS FOR DUMMY ATOM UNCOMENT BELOW (NOT
+C RECOMENTDED AFTER VERSION 3.3)
+c do i=1,nthetyp
+c do j=1,nthetyp
+c do l=1,ntheterm
+c aathet(l,i,j,nthetyp+1,iblock)=aathet(l,i,j,1,iblock)
+c aathet(l,nthetyp+1,i,j,iblock)=aathet(l,1,i,j,iblock)
+c enddo
+c aa0thet(i,j,nthetyp+1,iblock)=aa0thet(i,j,1,iblock)
+c aa0thet(nthetyp+1,i,j,iblock)=aa0thet(1,i,j,iblock)
+c enddo
+c do l=1,ntheterm
+c aathet(l,nthetyp+1,i,nthetyp+1,iblock)=aathet(l,1,i,1,iblock)
+c enddo
+c aa0thet(nthetyp+1,i,nthetyp+1,iblock)=aa0thet(1,i,1,iblock)
+c enddo
+c enddo
+C AND COMMENT THE LOOPS BELOW
do i=1,nthetyp
do j=1,nthetyp
do l=1,ntheterm
- aathet(l,i,j,nthetyp+1)=aathet(l,i,j,1)
- aathet(l,nthetyp+1,i,j)=aathet(l,1,i,j)
+ aathet(l,i,j,nthetyp+1,iblock)=0.0d0
+ aathet(l,nthetyp+1,i,j,iblock)=0.0d0
enddo
- aa0thet(i,j,nthetyp+1)=aa0thet(i,j,1)
- aa0thet(nthetyp+1,i,j)=aa0thet(1,i,j)
+ aa0thet(i,j,nthetyp+1,iblock)=0.0d0
+ aa0thet(nthetyp+1,i,j,iblock)=0.0d0
enddo
do l=1,ntheterm
- aathet(l,nthetyp+1,i,nthetyp+1)=aathet(l,1,i,1)
+ aathet(l,nthetyp+1,i,nthetyp+1,iblock)=0.0d0
enddo
- aa0thet(nthetyp+1,i,nthetyp+1)=aa0thet(1,i,1)
+ aa0thet(nthetyp+1,i,nthetyp+1,iblock)=0.0d0
+ enddo
enddo
+C TILL HERE
+C Substitution for D aminoacids from symmetry.
+ do iblock=1,2
+ do i=-nthetyp,0
+ do j=-nthetyp,nthetyp
+ do k=-nthetyp,nthetyp
+ aa0thet(i,j,k,iblock)=aa0thet(-i,-j,-k,iblock)
+ do l=1,ntheterm
+ aathet(l,i,j,k,iblock)=aathet(l,-i,-j,-k,iblock)
+ enddo
+ do ll=1,ntheterm2
+ do lll=1,nsingle
+ bbthet(lll,ll,i,j,k,iblock)=bbthet(lll,ll,-i,-j,-k,iblock)
+ ccthet(lll,ll,i,j,k,iblock)=-ccthet(lll,ll,-i,-j,-k,iblock)
+ ddthet(lll,ll,i,j,k,iblock)=ddthet(lll,ll,-i,-j,-k,iblock)
+ eethet(lll,ll,i,j,k,iblock)=-eethet(lll,ll,-i,-j,-k,iblock)
+ enddo
+ enddo
+ do ll=1,ntheterm3
+ do lll=2,ndouble
+ do llll=1,lll-1
+ ffthet(llll,lll,ll,i,j,k,iblock)=
+ & ffthet(llll,lll,ll,-i,-j,-k,iblock)
+ ffthet(lll,llll,ll,i,j,k,iblock)=
+ & ffthet(lll,llll,ll,-i,-j,-k,iblock)
+ ggthet(llll,lll,ll,i,j,k,iblock)=
+ & -ggthet(llll,lll,ll,-i,-j,-k,iblock)
+ ggthet(lll,llll,ll,i,j,k,iblock)=
+ & -ggthet(lll,llll,ll,-i,-j,-k,iblock)
+ enddo !ll
+ enddo !lll
+ enddo !llll
+ enddo !k
+ enddo !j
+ enddo !i
+ enddo !iblock
C
C Control printout of the coefficients of virtual-bond-angle potentials
C
write (iout,'(//4a)')
& 'Type ',onelett(i),onelett(j),onelett(k)
write (iout,'(//a,10x,a)') " l","a[l]"
- write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k)
+ write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k,iblock)
write (iout,'(i2,1pe15.5)')
- & (l,aathet(l,i,j,k),l=1,ntheterm)
+ & (l,aathet(l,i,j,k,iblock),l=1,ntheterm)
do l=1,ntheterm2
write (iout,'(//2h m,4(9x,a,3h[m,,i1,1h]))')
& "b",l,"c",l,"d",l,"e",l
do m=1,nsingle
write (iout,'(i2,4(1pe15.5))') m,
- & bbthet(m,l,i,j,k),ccthet(m,l,i,j,k),
- & ddthet(m,l,i,j,k),eethet(m,l,i,j,k)
+ & bbthet(m,l,i,j,k,iblock),ccthet(m,l,i,j,k,iblock),
+ & ddthet(m,l,i,j,k,iblock),eethet(m,l,i,j,k,iblock)
enddo
enddo
do l=1,ntheterm3
do m=2,ndouble
do n=1,m-1
write (iout,'(i1,1x,i1,4(1pe15.5))') n,m,
- & ffthet(n,m,l,i,j,k),ffthet(m,n,l,i,j,k),
- & ggthet(n,m,l,i,j,k),ggthet(m,n,l,i,j,k)
+ & ffthet(n,m,l,i,j,k,iblock),
+ & ffthet(m,n,l,i,j,k,iblock),
+ & ggthet(n,m,l,i,j,k,iblock),
+ & ggthet(m,n,l,i,j,k,iblock)
enddo
enddo
enddo
enddo
call flush(iout)
endif
+ write (2,*) "Start reading THETA_PDB",ithep_pdb
+ do i=1,ntyp
+c write (2,*) 'i=',i
+ read (ithep_pdb,*,err=111,end=111)
+ & a0thet(i),(athet(j,i,1,1),j=1,2),
+ & (bthet(j,i,1,1),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
+ do i=1,ntyp
+ athet(1,i,1,-1)=athet(1,i,1,1)
+ athet(2,i,1,-1)=athet(2,i,1,1)
+ bthet(1,i,1,-1)=-bthet(1,i,1,1)
+ bthet(2,i,1,-1)=-bthet(2,i,1,1)
+ athet(1,i,-1,1)=-athet(1,i,1,1)
+ athet(2,i,-1,1)=-athet(2,i,1,1)
+ bthet(1,i,-1,1)=bthet(1,i,1,1)
+ bthet(2,i,-1,1)=bthet(2,i,1,1)
+ enddo
+ do i=-ntyp,-1
+ a0thet(i)=a0thet(-i)
+ athet(1,i,-1,-1)=athet(1,-i,1,1)
+ athet(2,i,-1,-1)=-athet(2,-i,1,1)
+ bthet(1,i,-1,-1)=bthet(1,-i,1,1)
+ bthet(2,i,-1,-1)=-bthet(2,-i,1,1)
+ athet(1,i,-1,1)=athet(1,-i,1,1)
+ athet(2,i,-1,1)=-athet(2,-i,1,1)
+ bthet(1,i,-1,1)=-bthet(1,-i,1,1)
+ bthet(2,i,-1,1)=bthet(2,-i,1,1)
+ athet(1,i,1,-1)=-athet(1,-i,1,1)
+ athet(2,i,1,-1)=athet(2,-i,1,1)
+ bthet(1,i,1,-1)=bthet(1,-i,1,1)
+ bthet(2,i,1,-1)=-bthet(2,-i,1,1)
+ theta0(i)=theta0(-i)
+ sig0(i)=sig0(-i)
+ sigc0(i)=sigc0(-i)
+ do j=0,3
+ polthet(j,i)=polthet(j,-i)
+ enddo
+ do j=1,3
+ gthet(j,i)=gthet(j,-i)
+ enddo
+ enddo
+ write (2,*) "End reading THETA_PDB"
+ close (ithep_pdb)
#endif
close(ithep)
#ifdef CRYST_SC
bsc(1,i)=0.0D0
read(irotam,*,end=112,err=112)(censc(k,1,i),k=1,3),
& ((blower(k,l,1),l=1,k),k=1,3)
+ censc(1,1,-i)=censc(1,1,i)
+ censc(2,1,-i)=censc(2,1,i)
+ censc(3,1,-i)=-censc(3,1,i)
do j=2,nlob(i)
read (irotam,*,end=112,err=112) bsc(j,i)
read (irotam,*,end=112,err=112) (censc(k,j,i),k=1,3),
& ((blower(k,l,j),l=1,k),k=1,3)
+ censc(1,j,-i)=censc(1,j,i)
+ censc(2,j,-i)=censc(2,j,i)
+ censc(3,j,-i)=-censc(3,j,i)
+C BSC is amplitude of Gaussian
enddo
do j=1,nlob(i)
do k=1,3
enddo
gaussc(k,l,j,i)=akl
gaussc(l,k,j,i)=akl
+ if (((k.eq.3).and.(l.ne.3))
+ & .or.((l.eq.3).and.(k.ne.3))) then
+ gaussc(k,l,j,-i)=-akl
+ gaussc(l,k,j,-i)=-akl
+ else
+ gaussc(k,l,j,-i)=akl
+ gaussc(l,k,j,-i)=akl
+ endif
enddo
enddo
enddo
enddo
endif
enddo
+C
+C Read the parameters of the probability distribution/energy expression
+C of the side chains.
+C
+ write (2,*) "Start reading ROTAM_PDB"
+ 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)
+ write (2,*) "End reading ROTAM_PDB"
#endif
close(irotam)
C
read (itorp,*,end=113,err=113) ntortyp
read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp)
- itortyp(ntyp1)=ntortyp+1
-c write (iout,*) 'ntortyp',ntortyp
- do i=1,ntortyp
- do j=1,ntortyp
- read (itorp,*,end=113,err=113) nterm(i,j),nlor(i,j)
+ do iblock=1,2
+ do i=-ntyp,-1
+ itortyp(i)=-itortyp(-i)
+ enddo
+ write (iout,*) 'ntortyp',ntortyp
+ do i=0,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ read (itorp,*,end=113,err=113) nterm(i,j,iblock),
+ & nlor(i,j,iblock)
+ nterm(-i,-j,iblock)=nterm(i,j,iblock)
+ nlor(-i,-j,iblock)=nlor(i,j,iblock)
v0ij=0.0d0
si=-1.0d0
- do k=1,nterm(i,j)
- read (itorp,*,end=113,err=113) kk,v1(k,i,j),v2(k,i,j)
- v0ij=v0ij+si*v1(k,i,j)
+ do k=1,nterm(i,j,iblock)
+ read (itorp,*,end=113,err=113) kk,v1(k,i,j,iblock),
+ & v2(k,i,j,iblock)
+ v1(k,-i,-j,iblock)=v1(k,i,j,iblock)
+ v2(k,-i,-j,iblock)=-v2(k,i,j,iblock)
+ v0ij=v0ij+si*v1(k,i,j,iblock)
si=-si
+c write(iout,*) i,j,k,iblock,nterm(i,j,iblock)
+c write(iout,*) v1(k,-i,-j,iblock),v1(k,i,j,iblock),
+c &v2(k,-i,-j,iblock),v2(k,i,j,iblock)
enddo
- do k=1,nlor(i,j)
+ do k=1,nlor(i,j,iblock)
read (itorp,*,end=113,err=113) kk,vlor1(k,i,j),
- & vlor2(k,i,j),vlor3(k,i,j)
+ & vlor2(k,i,j),vlor3(k,i,j)
v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2)
enddo
- v0(i,j)=v0ij
+ v0(i,j,iblock)=v0ij
+ v0(-i,-j,iblock)=v0ij
enddo
enddo
+ enddo
close (itorp)
if (lprint) then
- write (iout,'(/a/)') 'Torsional constants:'
- do i=1,ntortyp
- do j=1,ntortyp
+ write (iout,'(/a/)') 'Torsional constants:'
+ do i=1,ntortyp
+ do j=1,ntortyp
write (iout,*) 'ityp',i,' jtyp',j
write (iout,*) 'Fourier constants'
- do k=1,nterm(i,j)
- write (iout,'(2(1pe15.5))') v1(k,i,j),v2(k,i,j)
+ do k=1,nterm(i,j,iblock)
+ write (iout,'(2(1pe15.5))') v1(k,i,j,iblock),
+ & v2(k,i,j,iblock)
enddo
write (iout,*) 'Lorenz constants'
- do k=1,nlor(i,j)
- write (iout,'(3(1pe15.5))')
+ do k=1,nlor(i,j,iblock)
+ write (iout,'(3(1pe15.5))')
& vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j)
enddo
enddo
enddo
endif
+
C
C 6/23/01 Read parameters for double torsionals
C
- do i=1,ntortyp
- do j=1,ntortyp
- do k=1,ntortyp
+ do iblock=1,2
+ do i=0,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ do k=-ntortyp+1,ntortyp-1
read (itordp,'(3a1)',end=114,err=114) t1,t2,t3
- if (t1.ne.onelett(i) .or. t2.ne.onelett(j)
- & .or. t3.ne.onelett(k)) then
+c write (iout,*) "OK onelett",
+c & i,j,k,t1,t2,t3
+
+ if (t1.ne.toronelet(i) .or. t2.ne.toronelet(j)
+ & .or. t3.ne.toronelet(k)) then
write (iout,*) "Error in double torsional parameter file",
& i,j,k,t1,t2,t3
#ifdef MPI
#endif
stop "Error in double torsional parameter file"
endif
- read (itordp,*,end=114,err=114) ntermd_1(i,j,k),
- & ntermd_2(i,j,k)
- read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k),l=1,
- & ntermd_1(i,j,k))
- read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k),l=1,
- & ntermd_1(i,j,k))
- read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k),l=1,
- & ntermd_1(i,j,k))
- read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k),l=1,
- & ntermd_1(i,j,k))
- read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k),
- & v2c(m,l,i,j,k),v2s(l,m,i,j,k),v2s(m,l,i,j,k),
- & m=1,l-1),l=1,ntermd_2(i,j,k))
- enddo
- enddo
- enddo
+ read (itordp,*,end=114,err=114) ntermd_1(i,j,k,iblock),
+ & ntermd_2(i,j,k,iblock)
+ ntermd_1(-i,-j,-k,iblock)=ntermd_1(i,j,k,iblock)
+ ntermd_2(-i,-j,-k,iblock)=ntermd_2(i,j,k,iblock)
+ read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+ read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+ read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+ read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+C Martix of D parameters for one dimesional foureir series
+ do l=1,ntermd_1(i,j,k,iblock)
+ v1c(1,l,-i,-j,-k,iblock)=v1c(1,l,i,j,k,iblock)
+ v1s(1,l,-i,-j,-k,iblock)=-v1s(1,l,i,j,k,iblock)
+ v1c(2,l,-i,-j,-k,iblock)=v1c(2,l,i,j,k,iblock)
+ v1s(2,l,-i,-j,-k,iblock)=-v1s(2,l,i,j,k,iblock)
+c write(iout,*) "whcodze" ,
+c & v1s(2,l,-i,-j,-k,iblock),v1s(2,l,i,j,k,iblock)
+ enddo
+ read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k,iblock),
+ & v2c(m,l,i,j,k,iblock),v2s(l,m,i,j,k,iblock),
+ & v2s(m,l,i,j,k,iblock),
+ & m=1,l-1),l=1,ntermd_2(i,j,k,iblock))
+C Martix of D parameters for two dimesional fourier series
+ do l=1,ntermd_2(i,j,k,iblock)
+ do m=1,l-1
+ v2c(l,m,-i,-j,-k,iblock)=v2c(l,m,i,j,k,iblock)
+ v2c(m,l,-i,-j,-k,iblock)=v2c(m,l,i,j,k,iblock)
+ v2s(l,m,-i,-j,-k,iblock)=-v2s(l,m,i,j,k,iblock)
+ v2s(m,l,-i,-j,-k,iblock)=-v2s(m,l,i,j,k,iblock)
+ enddo!m
+ enddo!l
+ enddo!k
+ enddo!j
+ enddo!i
+ enddo!iblock
if (lprint) then
- write (iout,*)
+ write (iout,*)
write (iout,*) 'Constants for double torsionals'
- do i=1,ntortyp
- do j=1,ntortyp
- do k=1,ntortyp
+ do iblock=1,2
+ do i=0,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ do k=-ntortyp+1,ntortyp-1
write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k,
- & ' nsingle',ntermd_1(i,j,k),' ndouble',ntermd_2(i,j,k)
+ & ' nsingle',ntermd_1(i,j,k,iblock),
+ & ' ndouble',ntermd_2(i,j,k,iblock)
write (iout,*)
write (iout,*) 'Single angles:'
- do l=1,ntermd_1(i,j,k)
- write (iout,'(i5,2f10.5,5x,2f10.5)') l,
- & v1c(1,l,i,j,k),v1s(1,l,i,j,k),
- & v1c(2,l,i,j,k),v1s(2,l,i,j,k)
+ do l=1,ntermd_1(i,j,k,iblock)
+ write (iout,'(i5,2f10.5,5x,2f10.5,5x,2f10.5)') l,
+ & v1c(1,l,i,j,k,iblock),v1s(1,l,i,j,k,iblock),
+ & v1c(2,l,i,j,k,iblock),v1s(2,l,i,j,k,iblock),
+ & v1s(1,l,-i,-j,-k,iblock),v1s(2,l,-i,-j,-k,iblock)
enddo
write (iout,*)
write (iout,*) 'Pairs of angles:'
- write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k))
- do l=1,ntermd_2(i,j,k)
- write (iout,'(i5,20f10.5)')
- & l,(v2c(l,m,i,j,k),m=1,ntermd_2(i,j,k))
+ write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock))
+ do l=1,ntermd_2(i,j,k,iblock)
+ write (iout,'(i5,20f10.5)')
+ & l,(v2c(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock))
enddo
write (iout,*)
- write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k))
- do l=1,ntermd_2(i,j,k)
- write (iout,'(i5,20f10.5)')
- & l,(v2s(l,m,i,j,k),m=1,ntermd_2(i,j,k))
+ write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock))
+ do l=1,ntermd_2(i,j,k,iblock)
+ write (iout,'(i5,20f10.5)')
+ & l,(v2s(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock)),
+ & (v2s(l,m,-i,-j,-k,iblock),m=1,ntermd_2(i,j,k,iblock))
enddo
write (iout,*)
enddo
enddo
enddo
+ enddo
endif
#endif
C Read of Side-chain backbone correlation parameters
C Modified 11 May 2012 by Adasko
CCC
C
-C 5/21/07 (AL) Read coefficients of the backbone-local sidechain-local
-C
read (isccor,*,end=119,err=119) nsccortyp
#ifdef SCCORPDB
read (isccor,*,end=119,err=119) (isccortyp(i),i=1,ntyp)
si=-si
enddo
do k=1,nlor_sccor(i,j)
- read (isccor,*,end=113,err=113) kk,vlor1sccor(k,i,j),
+ read (isccor,*,end=119,err=119) kk,vlor1sccor(k,i,j),
& vlor2sccor(k,i,j),vlor3sccor(k,i,j)
v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/
&(1+vlor3sccor(k,i,j)**2)
enddo
close (isccor)
#else
- read (isccor,*,end=113,err=113) (isccortyp(i),i=1,ntyp)
+ read (isccor,*,end=119,err=119) (isccortyp(i),i=1,ntyp)
c write (iout,*) 'ntortyp',ntortyp
maxinter=3
cc maxinter is maximum interaction sites
do l=1,maxinter
do i=1,nsccortyp
do j=1,nsccortyp
- read (isccor,*,end=113,err=113)
+ read (isccor,*,end=119,err=119)
& nterm_sccor(i,j),nlor_sccor(i,j)
v0ijsccor=0.0d0
si=-1.0d0
do k=1,nterm_sccor(i,j)
- read (isccor,*,end=113,err=113) kk,v1sccor(k,l,i,j)
+ read (isccor,*,end=119,err=119) kk,v1sccor(k,l,i,j)
& ,v2sccor(k,l,i,j)
v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j)
si=-si
enddo
do k=1,nlor_sccor(i,j)
- read (isccor,*,end=113,err=113) kk,vlor1sccor(k,i,j),
+ read (isccor,*,end=119,err=119) kk,vlor1sccor(k,i,j),
& vlor2sccor(k,i,j),vlor3sccor(k,i,j)
v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/
&(1+vlor3sccor(k,i,j)**2)
enddo
- v0sccor(l,i,j)=v0ijsccor
+ v0sccor(i,j,iblock)=v0ijsccor
enddo
enddo
enddo
write (iout,*) "Coefficients of the cumulants"
endif
read (ifourier,*) nloctyp
- do i=1,nloctyp
+
+ do i=0,nloctyp-1
read (ifourier,*,end=115,err=115)
- read (ifourier,*,end=115,err=115) (b(ii),ii=1,13)
+ read (ifourier,*,end=115,err=115) (b(ii,i),ii=1,13)
+#ifdef NEWCORR
+ read (ifourier,*,end=115,err=115) (bnew1(ii,1,i),ii=1,3)
+ read (ifourier,*,end=115,err=115) (bnew2(ii,1,i),ii=1,3)
+ read (ifourier,*,end=115,err=115) (bnew1(ii,2,i),ii=1,1)
+ read (ifourier,*,end=115,err=115) (bnew2(ii,2,i),ii=1,1)
+ read (ifourier,*,end=115,err=115) (eenew(ii,i),ii=1,1)
+#endif
if (lprint) then
write (iout,*) 'Type',i
- write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii),ii=1,13)
+ write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii,i),ii=1,13)
endif
- B1(1,i) = b(3)
- B1(2,i) = b(5)
+c B1(1,i) = b(3)
+c B1(2,i) = b(5)
+c B1(1,-i) = b(3)
+c B1(2,-i) = -b(5)
c b1(1,i)=0.0d0
c b1(2,i)=0.0d0
- B1tilde(1,i) = b(3)
- B1tilde(2,i) =-b(5)
+c B1tilde(1,i) = b(3)
+c B1tilde(2,i) =-b(5)
+c B1tilde(1,-i) =-b(3)
+c B1tilde(2,-i) =b(5)
c b1tilde(1,i)=0.0d0
c b1tilde(2,i)=0.0d0
- B2(1,i) = b(2)
- B2(2,i) = b(4)
+c B2(1,i) = b(2)
+c B2(2,i) = b(4)
+c B2(1,-i) =b(2)
+c B2(2,-i) =-b(4)
+
c b2(1,i)=0.0d0
c b2(2,i)=0.0d0
- CC(1,1,i)= b(7)
- CC(2,2,i)=-b(7)
- CC(2,1,i)= b(9)
- CC(1,2,i)= b(9)
+ CC(1,1,i)= b(7,i)
+ CC(2,2,i)=-b(7,i)
+ CC(2,1,i)= b(9,i)
+ CC(1,2,i)= b(9,i)
+ CC(1,1,-i)= b(7,i)
+ CC(2,2,-i)=-b(7,i)
+ CC(2,1,-i)=-b(9,i)
+ CC(1,2,-i)=-b(9,i)
c CC(1,1,i)=0.0d0
c CC(2,2,i)=0.0d0
c CC(2,1,i)=0.0d0
c CC(1,2,i)=0.0d0
- Ctilde(1,1,i)=b(7)
- Ctilde(1,2,i)=b(9)
- Ctilde(2,1,i)=-b(9)
- Ctilde(2,2,i)=b(7)
+ Ctilde(1,1,i)=b(7,i)
+ Ctilde(1,2,i)=b(9,i)
+ Ctilde(2,1,i)=-b(9,i)
+ Ctilde(2,2,i)=b(7,i)
+ Ctilde(1,1,-i)=b(7,i)
+ Ctilde(1,2,-i)=-b(9,i)
+ Ctilde(2,1,-i)=b(9,i)
+ Ctilde(2,2,-i)=b(7,i)
+
c Ctilde(1,1,i)=0.0d0
c Ctilde(1,2,i)=0.0d0
c Ctilde(2,1,i)=0.0d0
c Ctilde(2,2,i)=0.0d0
- DD(1,1,i)= b(6)
- DD(2,2,i)=-b(6)
- DD(2,1,i)= b(8)
- DD(1,2,i)= b(8)
+ DD(1,1,i)= b(6,i)
+ DD(2,2,i)=-b(6,i)
+ DD(2,1,i)= b(8,i)
+ DD(1,2,i)= b(8,i)
+ DD(1,1,-i)= b(6,i)
+ DD(2,2,-i)=-b(6,i)
+ DD(2,1,-i)=-b(8,i)
+ DD(1,2,-i)=-b(8,i)
c DD(1,1,i)=0.0d0
c DD(2,2,i)=0.0d0
c DD(2,1,i)=0.0d0
c DD(1,2,i)=0.0d0
- Dtilde(1,1,i)=b(6)
- Dtilde(1,2,i)=b(8)
- Dtilde(2,1,i)=-b(8)
- Dtilde(2,2,i)=b(6)
+ Dtilde(1,1,i)=b(6,i)
+ Dtilde(1,2,i)=b(8,i)
+ Dtilde(2,1,i)=-b(8,i)
+ Dtilde(2,2,i)=b(6,i)
+ Dtilde(1,1,-i)=b(6,i)
+ Dtilde(1,2,-i)=-b(8,i)
+ Dtilde(2,1,-i)=b(8,i)
+ Dtilde(2,2,-i)=b(6,i)
+
c Dtilde(1,1,i)=0.0d0
c Dtilde(1,2,i)=0.0d0
c Dtilde(2,1,i)=0.0d0
c Dtilde(2,2,i)=0.0d0
- EE(1,1,i)= b(10)+b(11)
- EE(2,2,i)=-b(10)+b(11)
- EE(2,1,i)= b(12)-b(13)
- EE(1,2,i)= b(12)+b(13)
+ EEold(1,1,i)= b(10,i)+b(11,i)
+ EEold(2,2,i)=-b(10,i)+b(11,i)
+ EEold(2,1,i)= b(12,i)-b(13,i)
+ EEold(1,2,i)= b(12,i)+b(13,i)
+ EEold(1,1,-i)= b(10,i)+b(11,i)
+ EEold(2,2,-i)=-b(10,i)+b(11,i)
+ EEold(2,1,-i)=-b(12,i)+b(13,i)
+ EEold(1,2,-i)=-b(12,i)-b(13,i)
+ write(iout,*) "TU DOCHODZE"
+ print *,"JESTEM"
c ee(1,1,i)=1.0d0
c ee(2,2,i)=1.0d0
c ee(2,1,i)=0.0d0
c ee(1,2,i)=0.0d0
c ee(2,1,i)=ee(1,2,i)
enddo
-C write(iout,*) "parm", B1(1,nloctyp+1),B1(2,nloctyp+1)
+c lprint=.true.
if (lprint) then
- do i=1,nloctyp+1
+ do i=1,nloctyp
write (iout,*) 'Type',i
write (iout,*) 'B1'
write(iout,*) B1(1,i),B1(2,i)
enddo
write(iout,*) 'EE'
do j=1,2
- write (iout,'(2f10.5)') EE(j,1,i),EE(j,2,i)
+ write (iout,'(2f10.5)') EEold(j,1,i),EEold(j,2,i)
enddo
enddo
endif
+c lprint=.false.
+
C
C Read electrostatic-interaction parameters
C
bpp (i,j)=-2.0D0*epp(i,j)*rri
ael6(i,j)=elpp6(i,j)*4.2D0**6
ael3(i,j)=elpp3(i,j)*4.2D0**3
+c lprint=.true.
if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j),
& ael6(i,j),ael3(i,j)
+c lprint=.false.
enddo
enddo
C
endif
goto 50
C---------------------- GB or BP potential -----------------------------
- 30 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp),
- & (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip(i),i=1,ntyp),
- & (alp(i),i=1,ntyp)
+ 30 do i=1,ntyp
+ read (isidep,*,end=116,err=116)(eps(i,j),j=i,ntyp)
+ enddo
+ read (isidep,*,end=116,err=116)(sigma0(i),i=1,ntyp)
+ read (isidep,*,end=116,err=116)(sigii(i),i=1,ntyp)
+ read (isidep,*,end=116,err=116)(chip(i),i=1,ntyp)
+ read (isidep,*,end=116,err=116)(alp(i),i=1,ntyp)
+C now we start reading lipid
+ do i=1,ntyp
+ read (isidep,*,end=1161,err=1161)(epslip(i,j),j=i,ntyp)
+C print *,"WARNING!!"
+C do j=1,ntyp
+C epslip(i,j)=epslip(i,j)+0.05d0
+C enddo
+ enddo
+ write(iout,*) epslip(1,1),"OK?"
C For the GB potential convert sigma'**2 into chi'
if (ipot.eq.4) then
do i=1,ntyp
do i=2,ntyp
do j=1,i-1
eps(i,j)=eps(j,i)
+ epslip(i,j)=epslip(j,i)
enddo
enddo
do i=1,ntyp
epsij=eps(i,j)
sigeps=dsign(1.0D0,epsij)
epsij=dabs(epsij)
- aa(i,j)=epsij*rrij*rrij
- bb(i,j)=-sigeps*epsij*rrij
- aa(j,i)=aa(i,j)
- bb(j,i)=bb(i,j)
+ aa_aq(i,j)=epsij*rrij*rrij
+ bb_aq(i,j)=-sigeps*epsij*rrij
+ aa_aq(j,i)=aa_aq(i,j)
+ bb_aq(j,i)=bb_aq(i,j)
+ epsijlip=epslip(i,j)
+ sigeps=dsign(1.0D0,epsijlip)
+ epsijlip=dabs(epsijlip)
+ aa_lip(i,j)=epsijlip*rrij*rrij
+ bb_lip(i,j)=-sigeps*epsijlip*rrij
+ aa_lip(j,i)=aa_lip(i,j)
+ bb_lip(j,i)=bb_lip(i,j)
if (ipot.gt.2) then
sigt1sq=sigma0(i)**2
sigt2sq=sigma0(j)**2
endif
if (lprint) then
write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3))')
- & restyp(i),restyp(j),aa(i,j),bb(i,j),augm(i,j),
+ & restyp(i),restyp(j),aa_aq(i,j),bb_aq(i,j),augm(i,j),
& sigma(i,j),r0(i,j),chi(i,j),chi(j,i)
endif
enddo
C
C Define the SC-p interaction constants (hard-coded; old style)
C
- do i=1,20
+ do i=1,ntyp
C "Soft" SC-p repulsion (causes helices to be too flat, but facilitates
C helix formation)
c aad(i,1)=0.3D0*4.0D0**12
bad(i,1)=-2*eps_scp(i,1)*rscp(i,1)**6
bad(i,2)=-2*eps_scp(i,2)*rscp(i,2)**6
enddo
-
+c lprint=.true.
if (lprint) then
write (iout,*) "Parameters of SC-p interactions:"
- do i=1,20
+ do i=1,ntyp
write (iout,'(4f8.3,4e12.4)') eps_scp(i,1),rscp(i,1),
& eps_scp(i,2),rscp(i,2),aad(i,1),bad(i,1),aad(i,2),bad(i,2)
enddo
endif
+c lprint=.false.
#endif
C
C Define the constants of the disulfide bridge
goto 999
116 write (iout,*) "Error reading electrostatic energy parameters."
goto 999
+ 1161 write (iout,*) "Error reading electrostatic energy parameters.Lip"
+ goto 999
117 write (iout,*) "Error reading side chain interaction parameters."
goto 999
118 write (iout,*) "Error reading SCp interaction parameters."
character*80 card
dimension sccor(3,20)
double precision e1(3),e2(3),e3(3)
- integer rescode
+ integer rescode,iterter(maxres)
logical fail
+ do i=1,maxres
+ iterter(i)=0
+ enddo
ibeg=1
lsecondary=.false.
nhfrag=0
goto 10
else if (card(:3).eq.'TER') then
C End current chain
- ires_old=ires+1
- itype(ires_old)=21
+ ires_old=ires+2
+ itype(ires_old-1)=ntyp1
+ iterter(ires_old-1)=1
+ itype(ires_old)=ntyp1
+ iterter(ires_old)=1
ibeg=2
-c write (iout,*) "Chain ended",ires,ishift,ires_old
+ write (iout,*) "Chain ended",ires,ishift,ires_old
if (unres_pdb) then
do j=1,3
dc(j,ires)=sccor(j,iii)
endif
C Start new residue.
c write (iout,'(a80)') card
- read (card(24:26),*) ires
+ read (card(23:26),*) ires
read (card(18:20),'(a3)') res
if (ibeg.eq.1) then
ishift=ires-1
if (res.ne.'GLY' .and. res.ne. 'ACE') then
ishift=ishift-1
- itype(1)=21
+ itype(1)=ntyp1
endif
c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift
ibeg=0
ires=ires-ishift
c write (2,*) "ires",ires," ishift",ishift
if (res.eq.'ACE') then
- ity=10
+ itype(ires)=10
else
itype(ires)=rescode(ires,res,0)
endif
C system
nres=ires
do i=2,nres-1
-c write (iout,*) i,itype(i)
- if (itype(i).eq.21) then
-c write (iout,*) "dummy",i,itype(i)
- do j=1,3
- c(j,i)=((c(j,i-1)+c(j,i+1))/2+2*c(j,i-1)-c(j,i-2))/2
-c c(j,i)=(c(j,i-1)+c(j,i+1))/2
- dc(j,i)=c(j,i)
- enddo
- endif
+ write (iout,*) i,itype(i),itype(i+1)
+ if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then
+ if (itype(i+1).eq.ntyp1.and.iterter(i+1).eq.1 ) then
+C 16/01/2014 by Adasko: Adding to dummy atoms in the chain
+C first is connected prevous chain (itype(i+1).eq.ntyp1)=true
+C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false
+ if (unres_pdb) then
+C 2/15/2013 by Adam: corrected insertion of the last dummy residue
+ print *,i,'tu dochodze'
+ call refsys(i-3,i-2,i-1,e1,e2,e3,fail)
+ if (fail) then
+ e2(1)=0.0d0
+ e2(2)=1.0d0
+ e2(3)=0.0d0
+ endif !fail
+ print *,i,'a tu?'
+ do j=1,3
+ c(j,i)=c(j,i-1)-1.9d0*e2(j)
+ enddo
+ else !unres_pdb
+ do j=1,3
+ dcj=(c(j,i-2)-c(j,i-3))/2.0
+ if (dcj.eq.0) dcj=1.23591524223
+ c(j,i)=c(j,i-1)+dcj
+ c(j,nres+i)=c(j,i)
+ enddo
+ endif !unres_pdb
+ else !itype(i+1).eq.ntyp1
+ if (unres_pdb) then
+C 2/15/2013 by Adam: corrected insertion of the first dummy residue
+ call refsys(i+1,i+2,i+3,e1,e2,e3,fail)
+ if (fail) then
+ e2(1)=0.0d0
+ e2(2)=1.0d0
+ e2(3)=0.0d0
+ endif
+ do j=1,3
+ c(j,i)=c(j,i+1)-1.9d0*e2(j)
+ enddo
+ else !unres_pdb
+ do j=1,3
+ dcj=(c(j,i+3)-c(j,i+2))/2.0
+ if (dcj.eq.0) dcj=1.23591524223
+ c(j,i)=c(j,i+1)-dcj
+ c(j,nres+i)=c(j,i)
+ enddo
+ endif !unres_pdb
+ endif !itype(i+1).eq.ntyp1
+ endif !itype.eq.ntyp1
enddo
C Calculate the CM of the last side chain.
if (unres_pdb) then
nstart_sup=1
if (itype(nres).ne.10) then
nres=nres+1
- itype(nres)=21
+ itype(nres)=ntyp1
if (unres_pdb) then
C 2/15/2013 by Adam: corrected insertion of the last dummy residue
call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail)
e2(3)=0.0d0
endif
do j=1,3
- c(j,nres)=c(j,nres-1)-3.8d0*e2(j)
+ c(j,nres)=c(j,nres-1)-1.9d0*e2(j)
enddo
else
do j=1,3
- dcj=c(j,nres-2)-c(j,nres-3)
+ dcj=(c(j,nres-2)-c(j,nres-3))/2.0
+ if (dcj.eq.0) dcj=1.23591524223
c(j,nres)=c(j,nres-1)+dcj
c(j,2*nres)=c(j,nres)
enddo
c(j,nres+1)=c(j,1)
c(j,2*nres)=c(j,nres)
enddo
- if (itype(1).eq.21) then
+ if (itype(1).eq.ntyp1) then
nsup=nsup-1
nstart_sup=2
if (unres_pdb) then
e2(3)=0.0d0
endif
do j=1,3
- c(j,1)=c(j,2)-3.8d0*e2(j)
+ c(j,1)=c(j,2)-1.9d0*e2(j)
enddo
else
do j=1,3
- dcj=c(j,4)-c(j,3)
+ dcj=(c(j,4)-c(j,3))/2.0
c(j,1)=c(j,2)-dcj
c(j,nres+1)=c(j,1)
enddo
lll=lll+1
cc write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
if (i.gt.1) then
- if ((itype(i-1).eq.21)) then
+ if ((itype(i-1).eq.ntyp1).and.(i.gt.2)) then
chain_length=lll-1
kkk=kkk+1
c write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
endif
enddo
enddo
+ write (iout,*) chain_length
+ if (chain_length.eq.0) chain_length=nres
do j=1,3
chain_rep(j,chain_length,symetr)=chain_rep(j,chain_length,1)
chain_rep(j,chain_length+nres,symetr)
hfrag(i,j)=hfrag(i,j)-ishift
enddo
enddo
-
return
end
c---------------------------------------------------------------------------
#endif
do i=1,nres-1
iti=itype(i)
- if (iti.ne.21 .and. itype(i+1).ne.21 .and.
+ if (iti.ne.ntyp1 .and. itype(i+1).ne.ntyp1 .and.
& (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0)) then
write (iout,'(a,i4)') 'Bad Cartesians for residue',i
ctest stop
enddo
enddo
do i=2,nres-1
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
do j=1,3
dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i))
enddo
sinfac2=0.5d0/(1.0d0-costtab(i+1))
sinfac=dsqrt(sinfac2)
it=itype(i)
- if (it.ne.10 .and. itype(i).ne.21) then
+ if (it.ne.10 .and. itype(i).ne.ntyp1) then
c
C Compute the axes of tghe local cartesian coordinates system; store in
c x_prime, y_prime and z_prime
do i=1,nres-1
vbld(i+1)=vbl
vbld_inv(i+1)=1.0d0/vbld(i+1)
- vbld(i+1+nres)=dsc(itype(i+1))
- vbld_inv(i+1+nres)=dsc_inv(itype(i+1))
+ vbld(i+1+nres)=dsc(iabs(itype(i+1)))
+ vbld_inv(i+1+nres)=dsc_inv(iabs(itype(i+1)))
c print *,vbld(i+1),vbld(i+1+nres)
enddo
return
include 'COMMON.CONTROL'
include 'COMMON.SBRIDGE'
include 'COMMON.IOUNITS'
+ include 'COMMON.SPLITELE'
logical file_exist
C Read force-field parameters except weights
call parmread
include 'COMMON.FFIELD'
include 'COMMON.INTERACT'
include 'COMMON.SETUP'
+ include 'COMMON.SPLITELE'
COMMON /MACHSW/ KDIAG,ICORFL,IXDR
character*8 diagmeth(0:3) /'Library','EVVRSP','Givens','Jacobi'/
character*80 ucase
refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0)
indpdb=index(controlcard,'PDBSTART')
extconf=(index(controlcard,'EXTCONF').gt.0)
+ AFMlog=(index(controlcard,'AFM'))
+ selfguide=(index(controlcard,'SELFGUIDE'))
+ print *,'AFMlog',AFMlog,selfguide,"KUPA"
call readi(controlcard,'IPRINT',iprint,0)
call readi(controlcard,'MAXGEN',maxgen,10000)
call readi(controlcard,'MAXOVERLAP',maxoverlap,1000)
i2ndstr=index(controlcard,'USE_SEC_PRED')
gradout=index(controlcard,'GRADOUT').gt.0
gnorm_check=index(controlcard,'GNORM_CHECK').gt.0
+C DISTCHAINMAX become obsolete for periodic boundry condition
call reada(controlcard,'DISTCHAINMAX',distchainmax,5.0d0)
+C Reading the dimensions of box in x,y,z coordinates
+ call reada(controlcard,'BOXX',boxxsize,100.0d0)
+ call reada(controlcard,'BOXY',boxysize,100.0d0)
+ call reada(controlcard,'BOXZ',boxzsize,100.0d0)
+c Cutoff range for interactions
+ call reada(controlcard,"R_CUT",r_cut,15.0d0)
+ call reada(controlcard,"LAMBDA",rlamb,0.3d0)
+ call reada(controlcard,"LIPTHICK",lipthick,0.0d0)
+ call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0)
+ if (lipthick.gt.0.0d0) then
+ bordliptop=(boxzsize+lipthick)/2.0
+ bordlipbot=bordliptop-lipthick
+C endif
+ if ((bordliptop.gt.boxzsize).or.(bordlipbot.lt.0.0))
+ & write(iout,*) "WARNING WRONG SIZE OF LIPIDIC PHASE"
+ buflipbot=bordlipbot+lipbufthick
+ bufliptop=bordliptop-lipbufthick
+ if ((lipbufthick*2.0d0).gt.lipthick)
+ &write(iout,*) "WARNING WRONG SIZE OF LIP AQ BUF"
+ endif
+ write(iout,*) "bordliptop=",bordliptop
+ write(iout,*) "bordlipbot=",bordlipbot
+ write(iout,*) "bufliptop=",bufliptop
+ write(iout,*) "buflipbot=",buflipbot
+
+
if (me.eq.king .or. .not.out1file )
& write (iout,*) "DISTCHAINMAX",distchainmax
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)
+c call reada(controlcard,"R_CUT",r_cut,2.0d0)
+c call reada(controlcard,"LAMBDA",rlamb,0.3d0)
rest = index(controlcard,"REST").gt.0
tbf = index(controlcard,"TBF").gt.0
usampl = index(controlcard,"USAMPL").gt.0
call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0)
call reada(weightcard,'DELT_CORR',delt_corr,0.5d0)
call reada(weightcard,'TEMP0',temp0,300.0d0)
+ call reada(weightcard,'WLT',wliptran,0.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)
& 'General scaling factor of SC-p interactions:',scalscp
endif
r0_corr=cutoff_corr-delt_corr
- do i=1,20
+ do i=1,ntyp
aad(i,1)=scalscp*aad(i,1)
aad(i,2)=scalscp*aad(i,2)
bad(i,1)=scalscp*bad(i,1)
33 write (iout,'(a)') 'Error opening PDB file.'
stop
34 continue
-c write (iout,*) 'Begin reading pdb data'
-c call flush(iout)
+c print *,'Begin reading pdb data'
call readpdb
-c write (iout,*) 'Finished reading pdb data'
-c call flush(iout)
+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
maxsi=1000
do i=2,nres-1
iti=itype(i)
- if (iti.ne.10 .and. itype(i).ne.21) then
+ if (iti.ne.10 .and. itype(i).ne.ntyp1) then
nsi=0
fail=.true.
do while (fail.and.nsi.le.maxsi)
vbld_inv(i)=vblinv
enddo
do i=2,nres-1
- vbld(i+nres)=dsc(itype(i))
- vbld_inv(i+nres)=dsc_inv(itype(i))
+ vbld(i+nres)=dsc(iabs(itype(i)))
+ vbld_inv(i+nres)=dsc_inv(iabs(itype(i)))
c write (iout,*) "i",i," itype",itype(i),
c & " dsc",dsc(itype(i))," vbld",vbld(i),vbld(i+nres)
enddo
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
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) then
#else
- if (itype(i).eq.21) then
+ if (itype(i).eq.ntyp1) then
#endif
itel(i)=0
#ifdef PROCOR
- else if (itype(i+1).ne.20) then
+ else if (iabs(itype(i+1)).ne.20) then
#else
- else if (itype(i).ne.20) then
+ else if (iabs(itype(i)).ne.20) then
#endif
itel(i)=1
else
#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 (itype(1).eq.ntyp1) nnt=2
+ if (itype(nres).eq.ntyp1) nct=nct-1
if (pdbref) then
if(me.eq.king.or..not.out1file)
& write (iout,'(a,i3)') 'nsup=',nsup
call flush(iout)
if (constr_dist.gt.0) call read_dist_constr
write (iout,*) "After read_dist_constr nhpb",nhpb
+ if ((AFMlog.gt.0).or.(selfguide.gt.0)) call read_afminp
call hpb_partition
if(me.eq.king.or..not.out1file)
& write (iout,*) 'Contact order:',co
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) 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
do i=2,nres-1
omeg(i)=-120d0*deg2rad
+ if (itype(i).le.0) omeg(i)=-omeg(i)
enddo
else
if(me.eq.king.or..not.out1file)
enddo
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) 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)
nvar=ntheta+nphi
nside=0
do i=2,nres-1
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
nside=nside+1
ialph(i,1)=nvar+nside
ialph(nside,2)=i
open (itordp,file=tordname,status='old',readonly)
call getenv_loc('SCCORPAR',sccorname)
open (isccor,file=sccorname,status='old',readonly)
+#ifndef CRYST_THETA
+ call getenv_loc('THETPARPDB',thetname_pdb)
+ print *,"thetname_pdb ",thetname_pdb
+ open (ithep_pdb,file=thetname_pdb,status='old',action='read')
+ print *,ithep_pdb," opened"
+#endif
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)
+ call getenv_loc('LIPTRANPAR',liptranname)
+ open (iliptranpar,file=liptranname,status='old',action='read')
+#ifndef CRYST_SC
+ call getenv_loc('ROTPARPDB',rotname_pdb)
+ open (irotam_pdb,file=rotname_pdb,status='old',action='read')
+#endif
#endif
#ifndef OLDSCP
C
& thetname(:ilen(thetname))
write (iout,*) "Rotamer parameter file : ",
& rotname(:ilen(rotname))
+ write (iout,*) "Thetpdb parameter file : ",
+ & thetname_pdb(:ilen(thetname_pdb))
write (iout,*) "Threading database : ",
& patname(:ilen(patname))
if (lentmp.ne.0)
include 'COMMON.MD'
open(irest2,file=rest2name,status='unknown')
read(irest2,*) totT,EK,potE,totE,t_bath
+ totTafm=totT
do i=1,2*nres
read(irest2,'(3e15.5)') (d_t(j,i),j=1,3)
enddo
enddo
return
end
+C---------------------------------------------------------------------------
+ subroutine read_afminp
+ 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'
+ character*320 afmcard
+ print *, "wchodze"
+ call card_concat(afmcard)
+ call readi(afmcard,"BEG",afmbeg,0)
+ call readi(afmcard,"END",afmend,0)
+ call reada(afmcard,"FORCE",forceAFMconst,0.0d0)
+ call reada(afmcard,"VEL",velAFMconst,0.0d0)
+ print *,'FORCE=' ,forceAFMconst
+CCCC NOW PROPERTIES FOR AFM
+ distafminit=0.0d0
+ do i=1,3
+ distafminit=(c(i,afmend)-c(i,afmbeg))**2+distafminit
+ enddo
+ distafminit=dsqrt(distafminit)
+ print *,'initdist',distafminit
+ return
+ end
+
c-------------------------------------------------------------------------------
subroutine read_dist_constr
implicit real*8 (a-h,o-z)
subroutine refsys(i2,i3,i4,e1,e2,e3,fail)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-c this subroutine calculates unity vectors of a local reference system
-c defined by atoms (i2), (i3), and (i4). the x axis is the axis from
+c This subroutine calculates unit vectors of a local reference system
+c defined by atoms (i2), (i3), and (i4). The x axis is the axis from
c atom (i3) to atom (i2), and the xy plane is the plane defined by atoms
c (i2), (i3), and (i4). z axis is directed according to the sign of the
-c vector product (i3)-(i2) and (i3)-(i4). sets fail to .true. if atoms
+c vector product (i3)-(i2) and (i3)-(i4). Sets fail to .true. if atoms
c (i2) and (i3) or (i3) and (i4) coincide or atoms (i2), (i3), and (i4)
-c form a linear fragment. returns vectors e1, e2, and e3.
+c form a linear fragment. Returns vectors e1, e2, and e3.
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
logical fail
double precision e1(3),e2(3),e3(3)
double precision u(3),z(3)
include 'COMMON.IOUNITS'
- include "COMMON.CHAIN"
- data coinc /1.0d-13/,align /1.0d-13/
+ include 'COMMON.CHAIN'
+ double precision coinc/1.0D-13/,align /1.0D-13/
+c print *,'just initialize'
fail=.false.
- s1=0.0d0
- s2=0.0d0
+c print *,fail
+ s1=0.0
+ s2=0.0
+ print *,s1,s2
do 1 i=1,3
+ print *, i2,i3,i4
zi=c(i,i2)-c(i,i3)
ui=c(i,i4)-c(i,i3)
+ print *,zi,ui
s1=s1+zi*zi
s2=s2+ui*ui
z(i)=zi
if (s1.gt.coinc) goto 2
write (iout,1000) i2,i3,i1
fail=.true.
+c do 3 i=1,3
+c 3 c(i,i1)=0.0D0
return
2 if (s2.gt.coinc) goto 4
write(iout,1000) i3,i4,i1
fail=.true.
+ do 5 i=1,3
+ 5 c(i,i1)=0.0D0
return
+ print *,'two if pass'
4 s1=1.0/s1
s2=1.0/s2
v1=z(2)*u(3)-z(3)*u(2)
v2=z(3)*u(1)-z(1)*u(3)
v3=z(1)*u(2)-z(2)*u(1)
- anorm=sqrt(v1*v1+v2*v2+v3*v3)
+ anorm=dsqrt(v1*v1+v2*v2+v3*v3)
if (anorm.gt.align) goto 6
write (iout,1010) i2,i3,i4,i1
fail=.true.
+c do 7 i=1,3
+c 7 c(i,i1)=0.0D0
return
- 6 anorm=1.0/anorm
+ 6 anorm=1.0D0/anorm
e3(1)=v1*anorm
e3(2)=v2*anorm
e3(3)=v3*anorm
e2(1)=e1(3)*e3(2)-e1(2)*e3(3)
e2(2)=e1(1)*e3(3)-e1(3)*e3(1)
e2(3)=e1(2)*e3(1)-e1(1)*e3(2)
- 1000 format (/1x,' * * * error - atoms',i4,' and',i4,' coincide.')
- 1010 format (/1x,' * * * error - atoms',2(i4,2h, ),i4,' form a linear')
+ print *,'just before leave'
+ 1000 format (/1x,' * * * Error - atoms',i4,' and',i4,' coincide.',
+ 1 'coordinates of atom',i4,' are set to zero.')
+ 1010 format (/1x,' * * * Error - atoms',2(i4,2h, ),i4,' form a linear',
+ 1 ' fragment. coordinates of atom',i4,' are set to zero.')
return
end
if (itype.eq.0) then
- do i=1,ntyp1
+ do i=-ntyp1,ntyp1
if (ucase(nam).eq.restyp(i)) then
rescode=i
return
else
- do i=1,ntyp1
+ do i=-ntyp1,ntyp1
if (nam(1:1).eq.onelet(i)) then
rescode=i
return
c Don't do glycine or ends
i=itype(res_pick)
- if (i.eq.10 .or. i.eq.21) return
+ if (i.eq.10 .or. i.eq.ntyp1) return
c Freeze everything (later will relax only selected side-chains)
mask_r=.true.
n_try=0
do while (n_try.lt.n_maxtry .and. orig_e-cur_e.lt.e_drop)
c Move the selected residue (don't worry if it fails)
- call gen_side(itype(res_pick),theta(res_pick+1),
+ call gen_side(iabs(itype(res_pick)),theta(res_pick+1),
+ alph(res_pick),omeg(res_pick),fail)
c Minimize the side-chains starting from the new arrangement
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
+ if ((zi.gt.bordlipbot)
+ &.and.(zi.lt.bordliptop)) then
+C the energy transfer exist
+ if (zi.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((positi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipi=1.0d0
+ ssgradlipi=0.0
+ endif
+ else
+ sslipi=0.0d0
+ ssgradlipi=0.0
+ endif
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
do j=istart(i,iint),iend(i,iint)
IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN
ind=ind+1
- itypj=itype(j)
+ itypj=iabs(itype(j))
dscj_inv=dsc_inv(itypj)
sig0ij=sigma(itypi,itypj)
chi1=chi(itypi,itypj)
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
+C xj=c(1,nres+j)-xi
+C yj=c(2,nres+j)-yi
+C zj=c(3,nres+j)-zi
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.gt.bordlipbot)
+ &.and.(zj.lt.bordliptop)) then
+C the energy transfer exist
+ if (zj.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((positi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipj=1.0d0
+ ssgradlipj=0.0
+ endif
+ else
+ sslipj=0.0d0
+ ssgradlipj=0.0
+ endif
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
+
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
+
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)/sigma(itypi,itypj))
+ sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
+
C Calculate angle-dependent terms of energy and contributions to their
C derivatives.
call sc_angular
c---------------------------------------------------------------
rij_shift=1.0D0/rij_shift
fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa
+ e2=fac*bb
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)
+ sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+ epsi=bb**2/aa
cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
cd & restyp(itypi),i,restyp(itypj),j,
cd & epsi,sigm,chi1,chi2,chip1,chip2,
fac=-expon*(e1+evdwij)*rij_shift
sigder=fac*sigder
fac=rij*fac
+ fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
C Calculate the radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
+ gg_lipi(3)=ssgradlipi*evdwij
+ gg_lipj(3)=ssgradlipj*evdwij
C Calculate angular part of the gradient.
call sc_grad
ENDIF
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
dsci_inv=vbld_inv(i+nres)
-
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
+C define scaling factor for lipids
+
+C if (positi.le.0) positi=positi+boxzsize
+C print *,i
+C first for peptide groups
+c for each residue check if it is in lipid or lipid water border area
+ if ((zi.gt.bordlipbot)
+ &.and.(zi.lt.bordliptop)) then
+C the energy transfer exist
+ if (zi.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((positi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipi=1.0d0
+ ssgradlipi=0.0
+ endif
+ else
+ sslipi=0.0d0
+ ssgradlipi=0.0
+ endif
itypj=itype(j)
- xj=c(1,nres+j)-c(1,nres+i)
- yj=c(2,nres+j)-c(2,nres+i)
- zj=c(3,nres+j)-c(3,nres+i)
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.gt.bordlipbot)
+ &.and.(zj.lt.bordliptop)) then
+C the energy transfer exist
+ if (zj.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((positi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipj=1.0d0
+ ssgradlipj=0.0
+ endif
+ else
+ sslipj=0.0d0
+ ssgradlipj=0.0
+ endif
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
+
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
+
+C xj=c(1,nres+j)-c(1,nres+i)
+C yj=c(2,nres+j)-c(2,nres+i)
+C zj=c(3,nres+j)-c(3,nres+i)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
+ sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
+ sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
c The following are set in sc_angular
c erij(1)=xj*rij
c erij(2)=yj*rij
ljXs=sig-sig0ij
ljA=eps1*eps2rt**2*eps3rt**2
- ljB=ljA*bb(itypi,itypj)
- ljA=ljA*aa(itypi,itypj)
- ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+ ljB=ljA*bb
+ ljA=ljA*aa
+ ljxm=ljXs+(-2.0D0*aa/bb)**(1.0D0/6.0D0)
ssXs=d0cm
deltat1=1.0d0-om1
c Stop and plot energy and derivative as a function of distance
if (checkstop) then
ssm=ssC-0.25D0*ssB*ssB/ssA
- ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
+ ljm=-0.25D0*ljB*bb/aa
if (ssm.lt.ljm .and.
& dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
nicheck=1000
havebond=.false.
ljd=rij-ljXs
fac=(1.0D0/ljd)**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa
+ e2=fac*bb
eij=eps1*eps2rt*eps3rt*(e1+e2)
eps2der=eij*eps3rt
eps3der=eij*eps2rt
- eij=eij*eps2rt*eps3rt
+ eij=eij*eps2rt*eps3rt*sss
sigder=-sig/sigsq
e1=e1*eps1*eps2rt**2*eps3rt**2
ed=-expon*(e1+eij)/ljd
sigder=ed*sigder
+ ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij
eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
eom12=eij*eps1_om12+eps2der*eps2rt_om12
havebond=.true.
ssd=rij-ssXs
eij=ssA*ssd*ssd+ssB*ssd+ssC
-
+ eij=eij*sss
ed=2*akcm*ssd+akct*deltat12
+ ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij
pom1=akct*ssd
pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
eom1=-2*akth*deltat1-pom1-om2*pom2
fac1=deltasq_inv*fac*(xm-rij)
fac2=deltasq_inv*fac*(rij-ssxm)
ed=delta_inv*(Ht*hd2-ssm*hd1)
+ eij=eij*sss
+ ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij
eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
else
havebond=.false.
- ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
- d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB
+ ljm=-0.25D0*ljB*bb/aa
+ d_ljm(1)=-0.5D0*bb/aa*ljB
d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt-
+ alf12/eps3rt)
fac1=deltasq_inv*fac*(ljxm-rij)
fac2=deltasq_inv*fac*(rij-xm)
ed=delta_inv*(ljm*hd2-Ht*hd1)
+ eij=eij*sss
+ ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij
eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
checkstop=.false.
endif
c-------END TESTING CODE
+ gg_lipi(3)=ssgradlipi*eij
+ gg_lipj(3)=ssgradlipj*eij
do k=1,3
dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
enddo
do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
+ gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
& +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
& +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
+ gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
& +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
& +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
enddo
cgrad enddo
do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(k)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(k)
enddo
return
& allihpb(maxdim),alljhpb(maxdim),
& newnss,newihpb(maxdim),newjhpb(maxdim)
logical found
- integer i_newnss(max_fg_procs),displ(0:max_fg_procs)
+ integer i_newnss(max_fg_procs),displ(max_fg_procs)
integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss
allnss=0
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if ((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then
do j=1,3
d_t_work(ind+j)=d_t(j,i+nres)
enddo
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if ((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then
do j=1,3
friction(j,i+nres)=fric_work(ind+j)
enddo
do j=1,3
ff(j)=ff(j)+force(j,i)
enddo
- if (itype(i+1).ne.21) then
+ if (itype(i+1).ne.ntyp1) then
do j=1,3
stochforc(j,i)=stochforc(j,i)+force(j,i+nres+1)
ff(j)=ff(j)+force(j,i+nres+1)
stochforc(j,0)=ff(j)+force(j,nnt+nres)
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if ((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then
do j=1,3
stochforc(j,i+nres)=force(j,i+nres)
enddo
ind=ind+3
enddo
do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if ((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then
do j=1,3
stochforcvec(ind+j)=stochforc(j,i+nres)
enddo
c Load the friction coefficients corresponding to side chains
m=nct-nnt
ind=0
+C gamsc(ntyp1)=1.0d0
do i=nnt,nct
ind=ind+1
ii = ind+m
iti=itype(i)
- gamvec(ii)=gamsc(iti)
+ gamvec(ii)=gamsc(iabs(iti))
enddo
if (surfarea) call sdarea(gamvec)
c if (lprn) then
& myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
#ifdef TIMING
#ifdef MPI
+ time_scatter=time_scatter+MPI_Wtime()-time00
time_scatter_fmat=time_scatter_fmat+MPI_Wtime()-time00
#else
time_scatter=time_scatter+tcpu()-time00
cd non_conv)
cd write (iout,'(a,f10.5)')
cd & 'Initial RMS deviation from reference structure:',rms
- if (itype(nres).eq.21) then
+ if (itype(nres).eq.ntyp1) then
do j=1,3
dcj=c(j,nres-2)-c(j,nres-3)
c(j,nres)=c(j,nres-1)+dcj
c(j,2*nres)=c(j,nres)
enddo
endif
- if (itype(1).eq.21) then
+ if (itype(1).eq.ntyp1) then
do j=1,3
dcj=c(j,4)-c(j,3)
c(j,1)=c(j,2)-dcj
if (me.eq.king) call cinfo
C Read force field parameters and job setup data
call readrtns
+ call flush(iout)
C
if (me.eq.king .or. .not. out1file) then
write (iout,'(2a/)')
include 'COMMON.SETUP'
include 'COMMON.CONTROL'
include 'COMMON.IOUNITS'
-c if (me.eq.king .or. .not. out1file) then
-c write (iout,*) "Calling chainbuild"
-c call flush(iout)
-c endif
+ if (me.eq.king .or. .not. out1file)
+ & write (iout,*) "Calling chainbuild"
call chainbuild
-c if (me.eq.king .or. .not. out1file) then
-c write (iout,*) "Calling MD"
-c call flush(iout)
-c endif
call MD
return
end
double precision energy(0:n_ene)
double precision energy_long(0:n_ene),energy_short(0:n_ene)
double precision varia(maxvar)
- if (indpdb.eq.0) call chainbuild
+ if (indpdb.eq.0) call chainbuild
+ print *,'dc',c(1,1)
+ if (indpdb.ne.0) then
+ dc(1,0)=c(1,1)
+ dc(2,0)=c(2,1)
+ dc(3,0)=c(3,1)
+ endif
#ifdef MPI
time00=MPI_Wtime()
#else
time00=tcpu()
#endif
call chainbuild_cart
+ print *,'dc',dc(1,0),dc(2,0),dc(3,0)
if (split_ene) then
print *,"Processor",myrank," after chainbuild"
icall=1
etot =etota
call enerprint(energy(0))
call hairpin(.true.,nharp,iharp)
+ print *,'after hairpin'
call secondary2(.true.)
+ print *,'after secondary'
if (minim) then
crc overlap test
if (overlapsc) then
#endif
print *,'# eval/s',evals
print *,'refstr=',refstr
- call hairpin(.true.,nharp,iharp)
+ call hairpin(.false.,nharp,iharp)
+ print *,'after hairpin'
call secondary2(.true.)
+ print *,'after secondary'
call etotal(energy(0))
etot = energy(0)
call enerprint(energy(0))
print *,'icheckgrad=',icheckgrad
goto (10,20,30) icheckgrad
10 call check_ecartint
- write(iout,*) "kupadupa"
- call check_ecartint
return
20 call check_cartgrad
return
projects / unres.git / commitdiff