rescode.f
setup_var.f
srtclust.f
+ ssMD.F
timing.F
track.F
wrtclust.f
probabl.F
read_coords.F
readrtns.F
+ ssMD.F
timing.F
track.F
work_partition.F
# Set comipiler flags for different sourcefiles
#================================================
if (Fortran_COMPILER_NAME STREQUAL "ifort")
- set(FFLAGS0 "-ip -w -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" )
+ set(FFLAGS0 "-mcmodel=medium -shared-intel -ip -w -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" )
elseif (Fortran_COMPILER_NAME STREQUAL "gfortran")
set(FFLAGS0 "-std=legacy -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" )
else ()
integer nres,nres0,nsup,nstart_sup,nend_sup,nstart_seq,
- &tabperm
- double precision c,cref,dc,xloc,xrot,dc_norm,t,r,prod,rt
+ &tabperm,chain_length
+ double precision c,cref,dc,xloc,xrot,dc_norm,t,r,prod,rt,
+ & chain_rep,crefjlee
common /chain/ c(3,maxres2+2),dc(3,maxres2),xloc(3,maxres),
& xrot(3,maxres),dc_norm(3,maxres2),nres,nres0
common /rotmat/ t(3,3,maxres),r(3,3,maxres),prod(3,3,maxres),
& rt(3,3,maxres)
- common /refstruct/ cref(3,maxres2+2),nsup,nstart_sup,nstart_seq,
- & nend_sup,tabperm(maxperm,maxsym)
+ common /refstruct/ cref(3,maxres2+2,maxperm),
+ & crefjlee(3,maxres2+2),
+ & chain_rep(3,maxres2+2,maxsym), nsup,nstart_sup,
+ & nstart_seq,
+ & nend_sup, chain_length,tabperm(maxperm,maxsym)
+ 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
+
integer ncut,ngr,licz,nconf,iass,icc,mult,list_conf,
& nss_all,ihpb_all,jhpb_all,iass_tot,iscore,nprop
common /clu/ diss(maxdist),energy(0:maxconf),
- & enetb(max_ene,maxstr_proc),ecut,
+ & enetb(max_ene,maxconf),ecut,
& entfac(maxconf),totfree(0:maxconf),totfree_gr(maxgr),
& rcutoff(max_cut+1),ncut,min_var,tree,plot_tree,lgrp
common /clu1/ ngr,licz(maxgr),nconf(maxgr,maxingr),iass(maxgr),
& iass_tot(maxgr,max_cut),list_conf(maxconf)
- common /alles/ allcart(3,maxres2,maxstr_proc),rmstb(maxconf),
+ common /alles/ allcart(3,maxres2,maxconf),rmstb(maxconf),
& icc(maxconf),
- & mult(maxres),nss_all(maxstr_proc),ihpb_all(maxss,maxstr_proc),
- & jhpb_all(maxss,maxstr_proc),iscore(maxconf),nprop
+ & mult(maxres),nss_all(maxconf),ihpb_all(maxss,maxconf),
+ & jhpb_all(maxss,maxconf),iscore(maxconf),nprop
double precision betaT
- integer iscode,indpdb,outpdb,outmol2,iopt,nstart,nend,symetr
+ integer iscode,indpdb,outpdb,outmol2,iopt,nstart,nend,symetr,
+ & constr_dist,shield_mode,tor_mode,
+ & constr_homology,homol_nset,
+ & iset,ihset
+ real*8 waga_homology
+ real*8 waga_dist, waga_angle, waga_theta, waga_d, dist_cut,
+ & dist2_cut
logical refstr,pdbref,punch_dist,print_dist,caonly,lside,
- & lprint_cart,lprint_int,from_cart,efree,from_bx,from_cx
+ & lprint_cart,lprint_int,from_cart,efree,from_bx,from_cx,
+ & with_dihed_constr,with_theta_constr,out1file,
+ & print_homology_restraints,
+ & print_contact_map,print_homology_models,
+ & read2sigma,l_homo
common /cntrl/ betaT,iscode,indpdb,refstr,pdbref,outpdb,outmol2,
& punch_dist,print_dist,caonly,lside,lprint_cart,lprint_int,
- & from_cart,from_bx,from_cx,efree,iopt,nstart,nend,symetr
+ & from_cart,from_bx,from_cx, with_dihed_constr,with_theta_constr,
+ & efree,iopt,nstart,nend,symetr,
+ & tor_mode,shield_mode,
+ & constr_dist,out1file,
+ & constr_homology,homol_nset,read2sigma
+ common /homol/ waga_homology(10),
+ & waga_dist,waga_angle,waga_theta,waga_d,dist_cut,dist2_cut,
+ & iset,ihset,l_homo(max_template,maxdim),
+ & print_homology_restraints,print_homology_models
& gradcorr5,gradcorr6,gel_loc,gcorr3_turn,gcorr4_turn,gcorr6_turn,
& gel_loc_loc,gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,
& g_corr5_loc,g_corr6_loc,gradb,gradbx,gsccorc,gsccorx,gsccor_loc,
- & gscloc,gsclocx
+ & gscloc,gsclocx,gshieldx,gradafm,
+ & gshieldc, gshieldc_loc, gshieldx_ec, gshieldc_ec,
+ & gshieldc_loc_ec, gshieldx_t3,gshieldc_t3,gshieldc_loc_t3,
+ & gshieldx_t4, gshieldc_t4,gshieldc_loc_t4,gshieldx_ll,
+ & gshieldc_ll, gshieldc_loc_ll
+
+
integer nfl,icg
logical calc_grad
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),gvdwpp(3,maxres),
& gradx_scp(3,maxres),
+ & gliptranc(3,-1:maxres),
+ & gliptranx(3,-1:maxres),
+ & gshieldx(3,-1:maxres), gshieldc(3,-1:maxres),
+ & gshieldc_loc(3,-1:maxres),
+ & gshieldx_ec(3,-1:maxres), gshieldc_ec(3,-1:maxres),
+ & gshieldc_loc_ec(3,-1:maxres),
+ & gshieldx_t3(3,-1:maxres), gshieldc_t3(3,-1:maxres),
+ & gshieldc_loc_t3(3,-1:maxres),
+ & gshieldx_t4(3,-1:maxres), gshieldc_t4(3,-1:maxres),
+ & gshieldc_loc_t4(3,-1:maxres),
+ & gshieldx_ll(3,-1:maxres), gshieldc_ll(3,-1:maxres),
+ & gshieldc_loc_ll(3,-1:maxres),
& gvdwc_scp(3,maxres),ghpbx(3,maxres),ghpbc(3,maxres),
& gloc(maxvar,2),gradcorr(3,maxres),gradxorr(3,maxres),
& gradcorr5(3,maxres),gradcorr6(3,maxres),
double precision wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc,
& wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4,wturn6,
& wvdwpp,wbond,weights,scal14,scalscp,cutoff_corr,delt_corr,
- & r0_corr
+ & r0_corr,wliptran
integer ipot,n_ene_comp,rescale_mode
common /ffield/ wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc,
& wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4,wturn6,
- & wvdwpp,wbond,weights(max_ene),scalscp,
+ & wvdwpp,wbond,wliptran,weights(max_ene),scalscp,
& scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp,
& rescale_mode
common /potentials/ potname(5)
--- /dev/null
+ real*8 odl(max_template,maxdim),sigma_odl(max_template,maxdim),
+ & dih(max_template,maxres),sigma_dih(max_template,maxres),
+ & sigma_odlir(max_template,maxdim)
+c
+c Specification of new variables used in subroutine e_modeller
+c modified by FP (Nov.,2014)
+ real*8 xxtpl(max_template,maxres),yytpl(max_template,maxres),
+ & zztpl(max_template,maxres),thetatpl(max_template,maxres),
+ & sigma_theta(max_template,maxres),
+ & sigma_d(max_template,maxres)
+c
+
+ integer ires_homo(maxdim),jres_homo(maxdim)
+
+ double precision
+ & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst,
+ & dUdxconst(3,0:MAXRES),dqwol(3,0:MAXRES),dxqwol(3,0:MAXRES),
+ & dutheta(maxres),dugamma(maxres),
+ & duscdiff(3,maxres),
+ & duscdiffx(3,maxres),
+ & uconst_back
+ integer lim_odl,lim_dih,link_start_homo,link_end_homo,
+ & idihconstr_start_homo,idihconstr_end_homo
+c
+c FP (30/10/2014)
+c
+c integer ithetaconstr_start_homo,ithetaconstr_end_homo
+c
+ integer nresn,nyosh,nnos
+ common /back_constr/ uconst_back,uscdiff,
+ & dutheta,dugamma,duscdiff,duscdiffx
+ common /homrestr/ odl,dih,sigma_dih,sigma_odl,
+ & lim_odl,lim_dih,ires_homo,jres_homo,link_start_homo,
+ & link_end_homo,idihconstr_start_homo,idihconstr_end_homo,
+c
+c FP (30/10/2014,04/03/2015)
+c
+ & xxtpl,yytpl,zztpl,thetatpl,sigma_theta,sigma_d,sigma_odlir
+c
C General I/O units & files
integer inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep,irotam,
& itorp,itordp,ifourier,ielep,isidep,iscpp,icbase,istat,
- & ientin,ientout,isidep1,ibond,isccor,jrms,jplot
+ & ientin,ientout,isidep1,ibond,isccor,jrms,jplot,
+ & iliptranpar
common /iounits/ inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep,
& irotam,itorp,itordp,ifourier,ielep,isidep,iscpp,icbase,
- & istat,ientin,ientout,isidep1,ibond,isccor,jrms,jplot
+ & istat,ientin,ientout,isidep1,ibond,isccor,jrms,jplot,
+ & iliptranpar
character*256 outname,intname,pdbname,mol2name,statname,intinname,
& entname,restartname,prefix,scratchdir,sidepname,pdbfile,
& sccorname,rmsname,prefintin,prefout
& icsa_bank_reminimized,icsa_native_int,icsa_in
C Parameter files
character*256 bondname,thetname,rotname,torname,tordname,
- & fouriername,elename,sidename,scpname,patname
+ & fouriername,elename,sidename,scpname,patname,liptranname
common /parfiles/ thetname,rotname,torname,tordname,bondname,
- & fouriername,elename,sidename,scpname,patname
+ & fouriername,elename,sidename,scpname,patname,liptranname
character*3 pot
C-----------------------------------------------------------------------
C INP - main input file
integer nlob,loc_start,loc_end,ithet_start,ithet_end,
& iphi_start,iphi_end,itau_start,itau_end
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 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,
& ndouble,nntheterm
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 Virtual-bond lenghts
common /peptbond/ vbl,vblinv,vblinv2,vbl_cis,vbl0
- common /names/ restyp(ntyp+1),onelet(ntyp+1)
+ common /names/ restyp(-ntyp1:ntyp1),onelet(-ntyp1:ntyp1)
character*3 restyp
character*1 onelet
character*10 ename,wname
- integer ns,nss,nfree,iss,ihpb,jhpb,nhpb,link_start,link_end
- double precision ebr,dbr,fbr,dhpb,forcon,weidis
- common /sbridge/ ebr,dbr,fbr,ns,nss,nfree,iss(maxss)
- common /links/ dhpb(maxss),forcon(maxss),ihpb(maxss),
- & jhpb(maxss),nhpb
+ double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss
+ integer ns,nss,nfree,iss
+ common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,
+ & ns,nss,nfree,iss(maxss)
+ double precision dhpb,dhpb1,forcon,fordepth
+ integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb
+ common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim),
+ & fordepth(maxdim),
+ & ihpb(maxdim),jhpb(maxdim),nhpb
+ double precision weidis
common /restraints/ weidis
+ integer link_start,link_end
common /links_split/ link_start,link_end
+ double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss
+ logical dyn_ss,dyn_ss_mask
+ common /dyn_ssbond/ dtriss,atriss,btriss,ctriss,Ht,
+ & dyn_ssbond_ij(maxres,maxres),
+ & idssb(maxdim),jdssb(maxdim),ibecarb(maxdim)
+ common /dyn_ss_logic/
+ & dyn_ss,dyn_ss_mask(maxres)
C Parameters of the SC rotamers (local) term
double precision sc_parmin
- common/scrot/sc_parmin(maxsccoef,20)
+ common/scrot/sc_parmin(maxsccoef,ntyp)
--- /dev/null
+ double precision VSolvSphere,VSolvSphere_div,long_r_sidechain,
+ & short_r_sidechain,fac_shield,grad_shield_side,grad_shield,
+ & buff_shield,wshield,grad_shield_loc
+ integer ishield_list,shield_list,ees0plist
+ common /shield/ VSolvSphere,VSolvSphere_div,buff_shield,
+ & long_r_sidechain(ntyp),
+ & short_r_sidechain(ntyp),fac_shield(maxres),wshield,
+ & grad_shield_side(3,maxcont,-1:maxres),grad_shield(3,-1:maxres),
+ & grad_shield_loc(3,maxcont,-1:maxres),
+ & ishield_list(maxres),shield_list(maxcont,maxres),
+ & ees0plist(maxcont,maxres)
+
+
+
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),
+ 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),
& vlor2(maxlor,maxtor,maxtor),vlor3(maxlor,maxtor,maxtor),
- & itortyp(ntyp),ntortyp,nterm(maxtor,maxtor),nlor(maxtor,maxtor)
+ & itortyp(-ntyp:ntyp),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,b1tilde
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,-maxtor:maxtor),b2(2,-maxtor:maxtor),
+ & cc(2,2,-maxtor:maxtor),
+ & dd(2,2,-maxtor:maxtor),ee(2,2,-maxtor:maxtor),
+ & ctilde(2,2,-maxtor:maxtor),
+ & dtilde(2,2,-maxtor:maxtor),b1tilde(2,-maxtor:maxtor),nloctyp
double precision b
- common /fourier1/ b(13,maxtor)
+ common /fourier1/ b(13,0:maxtor)
double precision theta,phi,alph,omeg,vbld,vbld_ref,
& theta_ref,phi_ref,alph_ref,omeg_ref,
& costtab,sinttab,cost2tab,sint2tab,tauangle,omicron,
- & xxtab,yytab,zztab
+ & xxtab,yytab,zztab,
+ & thetaref,phiref,xxref,yyref,zzref
common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres),
- & vbld(2*maxres),
+ & vbld(2*maxres),thetaref(maxres),phiref(maxres),
& costtab(maxres), sinttab(maxres), cost2tab(maxres),
& sint2tab(maxres),xxtab(maxres),yytab(maxres),
- & zztab(maxres),
+ & zztab(maxres),xxref(maxres),yyref(maxres),zzref(maxres),
& ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar,
& omicron(2,maxres),tauangle(3,maxres)
C Angles from experimental structure
parameter (maxprocs=16)
C Max. number of AA residues
integer maxres,maxres2
- parameter (maxres=650)
+ parameter (maxres=800)
C Appr. max. number of interaction sites
parameter (maxres2=2*maxres)
C Max. number of variables
parameter (maxconts=maxres)
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
integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2
parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8)
parameter (maxperm=120)
C Max. number of energy components
integer max_ene
- parameter (max_ene=21)
+ parameter (max_ene=25)
C Max. number of temperatures
integer maxt
parameter (maxT=5)
C Maximum number of terms in SC bond-stretching potential
integer maxbondterm
parameter (maxbondterm=3)
+C Maximum number of templates in homology-modeling restraints
+ integer max_template
+ parameter(max_template=25)
include 'COMMON.INTERACT'
dimension xx(3)
- dsci=dsc(itype(i))
- dsci_inv=dsc_inv(itype(i))
+ dsci=dsc(iabs(itype(i)))
+ dsci_inv=dsc_inv(iabs(itype(i)))
alphi=alph(i)
omegi=omeg(i)
cosalphi=dcos(alphi)
kkk=3
c print *,'nnt=',nnt,' nct=',nct
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)
include 'COMMON.INTERACT'
include 'COMMON.SBRIDGE'
include 'COMMON.CHAIN'
+ include 'COMMON.SHIELD'
+ include 'COMMON.CONTROL'
double precision fact(6)
cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
cd print *,'nnt=',nnt,' nct=',nct
C
C Calculate electrostatic (H-bonding) energy of the main chain.
C
- 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
+ 106 continue
+C write(iout,*) "shield_mode",shield_mode,ethetacnstr
+ if (shield_mode.eq.1) then
+ call set_shield_fac
+ else if (shield_mode.eq.2) then
+ call set_shield_fac2
+ endif
+ call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
C
C Calculate excluded-volume interaction energy between peptide groups
C and side chains.
C
C Calculate the virtual-bond-angle energy.
C
- call ebend(ebe)
+ call ebend(ebe,ethetacnstr)
cd print *,'Bend energy finished.'
C
C Calculate the SC local energy.
C 21/5/07 Calculate local sicdechain correlation energy
C
call eback_sc_corr(esccor)
+
+ if (wliptran.gt.0) then
+ call Eliptransfer(eliptran)
+ endif
+
C
C 12/1/95 Multi-body terms
C
call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
c print *,ecorr,ecorr5,ecorr6,eturn6
+ else
+ ecorr=0.0d0
+ ecorr5=0.0d0
+ ecorr6=0.0d0
+ eturn6=0.0d0
endif
if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
endif
-c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
+
+c write(iout,*) "TEST_ENE",constr_homology
+ if (constr_homology.ge.1) then
+ call e_modeller(ehomology_constr)
+ else
+ ehomology_constr=0.0d0
+ endif
+c write(iout,*) "TEST_ENE",ehomology_constr
+
+
+ write (iout,*) "ft(6)",fact(6),wliptran,eliptran
#ifdef SPLITELE
+ if (shield_mode.gt.0) then
+ etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
+ & +welec*fact(1)*ees
+ & +fact(1)*wvdwpp*evdw1
+ & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
+ & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
+ & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
+ & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
+ & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
+ & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
+ & +wliptran*eliptran
+ else
etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
& +wvdwpp*evdw1
& +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
- & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
+ & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
& +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
& +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
& +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
- & +wbond*estr+wsccor*fact(1)*esccor
+ & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
+ & +wliptran*eliptran
+ endif
#else
+ if (shield_mode.gt.0) then
+ etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
+ & +welec*fact(1)*(ees+evdw1)
+ & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
+ & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
+ & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
+ & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
+ & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
+ & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
+ & +wliptran*eliptran
+ else
etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
& +welec*fact(1)*(ees+evdw1)
& +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
- & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
+ & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
& +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
& +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
& +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
- & +wbond*estr+wsccor*fact(1)*esccor
+ & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
+ & +wliptran*eliptran
+ endif
#endif
+
energia(0)=etot
energia(1)=evdw
-c call enerprint(energia(0),frac)
#ifdef SCP14
energia(2)=evdw2-evdw2_14
energia(17)=evdw2_14
energia(18)=estr
energia(19)=esccor
energia(20)=edihcnstr
+ energia(24)=ehomology_constr
energia(21)=evdw_t
+c energia(24)=ethetacnstr
+ energia(22)=eliptran
c detecting NaNQ
#ifdef ISNAN
#ifdef AIX
#ifdef SPLITELE
do i=1,nct
do j=1,3
+ if (shield_mode.eq.0) then
gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
& welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
& wbond*gradb(j,i)+
& wcorr6*fact(5)*gradcorr6(j,i)+
& wturn6*fact(5)*gcorr6_turn(j,i)+
& wsccor*fact(2)*gsccorc(j,i)
+ & +wliptran*gliptranc(j,i)
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*fact(2)*gsccorx(j,i)
+ & +wliptran*gliptranx(j,i)
+ else
+ gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
+ & +fact(1)*wscp*gvdwc_scp(j,i)+
+ & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
+ & wbond*gradb(j,i)+
+ & wstrain*ghpbc(j,i)+
+ & wcorr*fact(3)*gradcorr(j,i)+
+ & wel_loc*fact(2)*gel_loc(j,i)+
+ & wturn3*fact(2)*gcorr3_turn(j,i)+
+ & wturn4*fact(3)*gcorr4_turn(j,i)+
+ & wcorr5*fact(4)*gradcorr5(j,i)+
+ & wcorr6*fact(5)*gradcorr6(j,i)+
+ & wturn6*fact(5)*gcorr6_turn(j,i)+
+ & wsccor*fact(2)*gsccorc(j,i)
+ & +wliptran*gliptranc(j,i)
+ & +welec*gshieldc(j,i)
+ & +welec*gshieldc_loc(j,i)
+ & +wcorr*gshieldc_ec(j,i)
+ & +wcorr*gshieldc_loc_ec(j,i)
+ & +wturn3*gshieldc_t3(j,i)
+ & +wturn3*gshieldc_loc_t3(j,i)
+ & +wturn4*gshieldc_t4(j,i)
+ & +wturn4*gshieldc_loc_t4(j,i)
+ & +wel_loc*gshieldc_ll(j,i)
+ & +wel_loc*gshieldc_loc_ll(j,i)
+
+ gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
+ & +fact(1)*wscp*gradx_scp(j,i)+
+ & wbond*gradbx(j,i)+
+ & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
+ & wsccor*fact(2)*gsccorx(j,i)
+ & +wliptran*gliptranx(j,i)
+ & +welec*gshieldx(j,i)
+ & +wcorr*gshieldx_ec(j,i)
+ & +wturn3*gshieldx_t3(j,i)
+ & +wturn4*gshieldx_t4(j,i)
+ & +wel_loc*gshieldx_ll(j,i)
+
+
+ endif
enddo
#else
- do i=1,nct
+ do i=1,nct
do j=1,3
+ if (shield_mode.eq.0) then
gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
& welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
& wbond*gradb(j,i)+
& wcorr6*fact(5)*gradcorr6(j,i)+
& wturn6*fact(5)*gcorr6_turn(j,i)+
& wsccor*fact(2)*gsccorc(j,i)
+ & +wliptran*gliptranc(j,i)
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*fact(1)*gsccorx(j,i)
- enddo
+ & +wliptran*gliptranx(j,i)
+ else
+ gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
+ & fact(1)*wscp*gvdwc_scp(j,i)+
+ & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
+ & wbond*gradb(j,i)+
+ & wcorr*fact(3)*gradcorr(j,i)+
+ & wel_loc*fact(2)*gel_loc(j,i)+
+ & wturn3*fact(2)*gcorr3_turn(j,i)+
+ & wturn4*fact(3)*gcorr4_turn(j,i)+
+ & wcorr5*fact(4)*gradcorr5(j,i)+
+ & wcorr6*fact(5)*gradcorr6(j,i)+
+ & wturn6*fact(5)*gcorr6_turn(j,i)+
+ & wsccor*fact(2)*gsccorc(j,i)
+ & +wliptran*gliptranc(j,i)
+ gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
+ & fact(1)*wscp*gradx_scp(j,i)+
+ & wbond*gradbx(j,i)+
+ & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
+ & wsccor*fact(1)*gsccorx(j,i)
+ & +wliptran*gliptranx(j,i)
+ endif
+ enddo
#endif
enddo
& +wturn3*fact(2)*gel_loc_turn3(i)
& +wturn6*fact(5)*gel_loc_turn6(i)
& +wel_loc*fact(2)*gel_loc_loc(i)
- & +wsccor*fact(1)*gsccor_loc(i)
+c & +wsccor*fact(1)*gsccor_loc(i)
+c ROZNICA Z WHAMem
enddo
endif
+ if (dyn_ss) call dyn_set_nss
return
end
C------------------------------------------------------------------------
esccor=energia(19)
edihcnstr=energia(20)
estr=energia(18)
+ ehomology_constr=energia(24)
+c ethetacnstr=energia(24)
#ifdef SPLITELE
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
& wvdwpp,
& ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
& eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
& eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
- & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
+ & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss,
+ & etot
10 format (/'Virtual-chain energies:'//
& 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
& 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
& 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
& 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
& 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
+ & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
& 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
& 'ETOT= ',1pE16.6,' (total)')
#else
& ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
& eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
& eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
- & edihcnstr,ebr*nss,etot
+ & edihcnstr,ehomology_constr,ebr*nss,
+ & etot
10 format (/'Virtual-chain energies:'//
& 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
& 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
& 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
& 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
& 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
+ & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
& 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
& 'ETOT= ',1pE16.6,' (total)')
#endif
integer icant
external icant
cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
+c ROZNICA DODANE Z WHAM
+c do i=1,210
+c do j=1,2
+c eneps_temp(j,i)=0.0d0
+c enddo
+c enddo
+cROZNICA
+
evdw=0.0D0
evdw_t=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)
+ e1=fac*fac*aa
+ e2=fac*bb
evdwij=e1+e2
ij=icant(itypi,itypj)
+c ROZNICA z WHAM
+c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
+c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
+c
+
cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- if (bb(itypi,itypj).gt.0.0d0) then
+ if (bb.gt.0.0d0) then
evdw=evdw+evdwij
else
evdw_t=evdw_t+evdwij
evdw=0.0D0
evdw_t=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)
+ e1=fac*fac*aa
+ e2=fac*bb
evdwij=e_augm+e1+e2
ij=icant(itypi,itypj)
cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- if (bb(itypi,itypj).gt.0.0d0) then
+ if (bb.gt.0.0d0) then
evdw=evdw+evdwij
else
evdw_t=evdw_t+evdwij
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
dscj_inv=vbld_inv(j+nres)
chi1=chi(itypi,itypj)
chi2=chi(itypj,itypi)
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
ij=icant(itypi,itypj)
aux=eps1*eps2rt**2*eps3rt**2
- if (bb(itypi,itypj).gt.0.0d0) then
+ if (bb.gt.0.0d0) then
evdw=evdw+evdwij
else
evdw_t=evdw_t+evdwij
endif
if (calc_grad) then
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.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
+ include 'COMMON.SBRIDGE'
logical lprn
common /srutu/icall
integer icant
external icant
+ integer xshift,yshift,zshift
+ logical energy_dec /.false./
c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
evdw_t=0.0d0
c if (icall.gt.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
+ 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)
C
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
+ IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
+
+c write(iout,*) "PRZED ZWYKLE", evdwij
+ call dyn_ssbond_ene(i,j,evdwij)
+c write(iout,*) "PO ZWYKLE", evdwij
+
+ evdw=evdw+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
+ & 'evdw',i,j,evdwij,' ss'
+C triple bond artifac removal
+ do k=j+1,iend(i,iint)
+C search over all next residues
+ if (dyn_ss_mask(k)) then
+C check if they are cysteins
+C write(iout,*) 'k=',k
+
+c write(iout,*) "PRZED TRI", evdwij
+ evdwij_przed_tri=evdwij
+ call triple_ssbond_ene(i,j,k,evdwij)
+c if(evdwij_przed_tri.ne.evdwij) then
+c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
+c endif
+
+c write(iout,*) "PO TRI", evdwij
+C call the energy function that removes the artifical triple disulfide
+C bond the soubroutine is located in ssMD.F
+ evdw=evdw+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
+ & 'evdw',i,j,evdwij,'tss'
+ endif!dyn_ss_mask(k)
+ enddo! k
+ ELSE
ind=ind+1
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
dscj_inv=vbld_inv(j+nres)
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
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.gt.bordlipbot)
+ &.and.(zj.lt.bordliptop)) then
+C the energy transfer exist
+ if (zj.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((zj-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zj.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipj=1.0d0
+ ssgradlipj=0.0
+ endif
+ else
+ sslipj=0.0d0
+ ssgradlipj=0.0
+ endif
+ 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 write(iout,*) "czy jest 0", bb-bb_lip(itypi,itypj),
+C & 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 write (iout,*) i,j,xj,yj,zj
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))
+ if (sss.le.0.0d0) cycle
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
- if (bb(itypi,itypj).gt.0) then
- evdw=evdw+evdwij
+ if (bb.gt.0) then
+ evdw=evdw+evdwij*sss
else
- evdw_t=evdw_t+evdwij
+ evdw_t=evdw_t+evdwij*sss
endif
ij=icant(itypi,itypj)
aux=eps1*eps2rt**2*eps3rt**2
c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
c & aux*e2/eps(itypi,itypj)
c if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c & restyp(itypi),i,restyp(itypj),j,
-c & epsi,sigm,chi1,chi2,chip1,chip2,
-c & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
-c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
-c & evdwij
-c write (iout,*) "pratial sum", evdw,evdw_t
+ sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+ epsi=bb**2/aa
+C#define DEBUG
+#ifdef DEBUG
+C write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+C & restyp(itypi),i,restyp(itypj),j,
+C & epsi,sigm,chi1,chi2,chip1,chip2,
+C & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
+C & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
+C & evdwij
+ write (iout,*) "pratial sum", evdw,evdw_t,e1,e2,fac,aa
+#endif
+C#undef DEBUG
c endif
if (calc_grad) then
C Calculate gradient components.
fac=-expon*(e1+evdwij)*rij_shift
sigder=fac*sigder
fac=rij*fac
+ fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
+ 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 Calculate the radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
C Calculate angular part of the gradient.
call sc_grad
endif
+ ENDIF ! dyn_ss
enddo ! j
enddo ! iint
enddo ! i
c if (icall.gt.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)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
dsci_inv=vbld_inv(i+nres)
+C returning the ith atom to box
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
+ if ((zi.gt.bordlipbot)
+ &.and.(zi.lt.bordliptop)) then
+C the energy transfer exist
+ if (zi.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((zi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipi=1.0d0
+ ssgradlipi=0.0
+ endif
+ else
+ sslipi=0.0d0
+ ssgradlipi=0.0
+ endif
C
C Calculate SC interaction energy.
C
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
dscj_inv=vbld_inv(j+nres)
sig0ij=sigma(itypi,itypj)
r0ij=r0(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
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+C returning jth atom to box
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.gt.bordlipbot)
+ &.and.(zj.lt.bordliptop)) then
+C the energy transfer exist
+ if (zj.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((zj-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zj.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipj=1.0d0
+ ssgradlipj=0.0
+ endif
+ else
+ sslipj=0.0d0
+ ssgradlipj=0.0
+ endif
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
+C checking the distance
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+C finding the closest
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
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
fac_augm=rrij**expon
e_augm=augm(itypi,itypj)*fac_augm
evdwij=evdwij*eps2rt*eps3rt
- if (bb(itypi,itypj).gt.0.0d0) then
+ if (bb.gt.0.0d0) then
evdw=evdw+evdwij+e_augm
else
evdw_t=evdw_t+evdwij+e_augm
gg(k)=gg(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_lipi(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
C
do k=i,j-1
do l=1,3
- gvdwc(l,k)=gvdwc(l,k)+gg(l)
+ gvdwc(l,k)=gvdwc(l,k)+gg(l)+gg_lipi(l)
enddo
enddo
+ do l=1,3
+ gvdwc(l,j)=gvdwc(l,j)+gg_lipj(l)
+ enddo
return
end
c------------------------------------------------------------------------------
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
+ include 'COMMON.SHIELD'
+
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),
gcorr_loc(i)=0.0d0
enddo
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
+ & .or. ((i+2).gt.nres)
+ & .or. ((i-1).le.0)
+ & .or. itype(i+2).eq.ntyp1
+ & .or. itype(i-1).eq.ntyp1
+ &) cycle
+C endif
if (itel(i).eq.0) goto 1215
dxi=dc(1,i)
dyi=dc(2,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 (j.le.1) cycle
+ if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
+ & .or.((j+2).gt.nres)
+ & .or.((j-1).le.0)
+ & .or.itype(j+2).eq.ntyp1
+ & .or.itype(j-1).eq.ntyp1
+ &) cycle
+C endif
if (itel(j).eq.0) goto 1216
ind=ind+1
iteli=itel(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)
+ 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
+ sss=sscale(sqrt(rij))
+ sssgrad=sscagrad(sqrt(rij))
rrmij=1.0D0/rij
rij=dsqrt(rij)
rmij=1.0D0/rij
c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
C 12/26/95 - for the evaluation of multi-body H-bonding interactions
ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
+ if (shield_mode.gt.0) then
+C fac_shield(i)=0.4
+C fac_shield(j)=0.6
+C#define DEBUG
+#ifdef DEBUG
+ write(iout,*) "ees_compon",i,j,el1,el2,
+ & fac_shield(i),fac_shield(j)
+#endif
+C#undef DEBUG
+ el1=el1*fac_shield(i)**2*fac_shield(j)**2
+ el2=el2*fac_shield(i)**2*fac_shield(j)**2
+ eesij=(el1+el2)
+ ees=ees+eesij
+ else
+ fac_shield(i)=1.0
+ fac_shield(j)=1.0
+ eesij=(el1+el2)
ees=ees+eesij
- evdw1=evdw1+evdwij
+ endif
+C ees=ees+eesij
+ 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,
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
ggg(1)=facel*xj
ggg(2)=facel*yj
ggg(3)=facel*zj
+
+ if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
+ & (shield_mode.gt.0)) then
+C print *,i,j
+ do ilist=1,ishield_list(i)
+ iresshield=shield_list(ilist,i)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
+ & *2.0
+ gshieldx(k,iresshield)=gshieldx(k,iresshield)+
+ & rlocshield
+ & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
+ gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
+C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
+C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
+C if (iresshield.gt.i) then
+C do ishi=i+1,iresshield-1
+C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
+C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
+C
+C enddo
+C else
+C do ishi=iresshield,i
+C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
+C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
+C
+C enddo
+C endif
+C enddo
+C enddo
+ enddo
+ enddo
+ do ilist=1,ishield_list(j)
+ iresshield=shield_list(ilist,j)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
+ & *2.0
+ gshieldx(k,iresshield)=gshieldx(k,iresshield)+
+ & rlocshield
+ & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
+ gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
+ enddo
+ enddo
+
+ do k=1,3
+ gshieldc(k,i)=gshieldc(k,i)+
+ & grad_shield(k,i)*eesij/fac_shield(i)*2.0
+ gshieldc(k,j)=gshieldc(k,j)+
+ & grad_shield(k,j)*eesij/fac_shield(j)*2.0
+ gshieldc(k,i-1)=gshieldc(k,i-1)+
+ & grad_shield(k,i)*eesij/fac_shield(i)*2.0
+ gshieldc(k,j-1)=gshieldc(k,j-1)+
+ & grad_shield(k,j)*eesij/fac_shield(j)*2.0
+
+ enddo
+ endif
+
do k=1,3
ghalf=0.5D0*ggg(k)
gelc(k,i)=gelc(k,i)+ghalf
gelc(l,k)=gelc(l,k)+ggg(l)
enddo
enddo
- 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
+ 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
do k=1,3
ghalf=0.5D0*ggg(k)
gvdwpp(k,i)=gvdwpp(k,i)+ghalf
enddo
enddo
#else
- facvdw=ev1+evdwij
+ facvdw=(ev1+evdwij)*sss
facel=el1+eesij
fac1=fac
fac=-3*rrmij*(facvdw+facvdw+facel)
cd & (dcosg(k),k=1,3)
do k=1,3
ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
+ & *fac_shield(i)**2*fac_shield(j)**2
enddo
do k=1,3
ghalf=0.5D0*ggg(k)
gelc(k,i)=gelc(k,i)+ghalf
& +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
& + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
+ & *fac_shield(i)**2*fac_shield(j)**2
+
gelc(k,j)=gelc(k,j)+ghalf
& +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
& + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
+ & *fac_shield(i)**2*fac_shield(j)**2
enddo
do k=i+1,j-1
do l=1,3
& +a33*muij(4)
cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
+ if (shield_mode.eq.0) then
+ fac_shield(i)=1.0
+ fac_shield(j)=1.0
+C else
+C fac_shield(i)=0.4
+C fac_shield(j)=0.6
+ endif
+ eel_loc_ij=eel_loc_ij
+ & *fac_shield(i)*fac_shield(j)
eel_loc=eel_loc+eel_loc_ij
C Partial derivatives in virtual-bond dihedral angles gamma
if (calc_grad) then
+ if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
+ & (shield_mode.gt.0)) then
+C print *,i,j
+
+ do ilist=1,ishield_list(i)
+ iresshield=shield_list(ilist,i)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
+ & /fac_shield(i)
+C & *2.0
+ gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
+ & rlocshield
+ & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
+ gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
+ & +rlocshield
+ enddo
+ enddo
+ do ilist=1,ishield_list(j)
+ iresshield=shield_list(ilist,j)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
+ & /fac_shield(j)
+C & *2.0
+ gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
+ & rlocshield
+ & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
+ gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
+ & +rlocshield
+
+ enddo
+ enddo
+ do k=1,3
+ gshieldc_ll(k,i)=gshieldc_ll(k,i)+
+ & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
+ gshieldc_ll(k,j)=gshieldc_ll(k,j)+
+ & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
+ gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
+ & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
+ gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
+ & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
+ enddo
+ endif
if (i.gt.1)
& gel_loc_loc(i-1)=gel_loc_loc(i-1)+
& a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
& +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
+ & *fac_shield(i)*fac_shield(j)
gel_loc_loc(j-1)=gel_loc_loc(j-1)+
& a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
& +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
+ & *fac_shield(i)*fac_shield(j)
+
cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
cd write(iout,*) 'agg ',agg
cd write(iout,*) 'aggi ',aggi
do l=1,3
ggg(l)=agg(l,1)*muij(1)+
& agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
+ & *fac_shield(i)*fac_shield(j)
+
enddo
do k=i+2,j2
do l=1,3
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)
+ & *fac_shield(i)*fac_shield(j)
+
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)
+ & *fac_shield(i)*fac_shield(j)
+
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)
+ & *fac_shield(i)*fac_shield(j)
+
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)
+ & *fac_shield(i)*fac_shield(j)
+
enddo
endif
ENDIF
fac3=dsqrt(-ael6i)*r3ij
ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
+ if (shield_mode.eq.0) then
+ fac_shield(i)=1.0d0
+ fac_shield(j)=1.0d0
+ else
+ ees0plist(num_conti,i)=j
+C fac_shield(i)=0.4d0
+C fac_shield(j)=0.6d0
+ endif
c ees0mij=0.0D0
ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
+ & *fac_shield(i)*fac_shield(j)
+
ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
+ & *fac_shield(i)*fac_shield(j)
+
C Diagnostics. Comment out or remove after debugging!
c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
gacontp_hb1(k,num_conti,i)=ghalfp
& +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
& + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
+ & *fac_shield(i)*fac_shield(j)
+
gacontp_hb2(k,num_conti,i)=ghalfp
& +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
& + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
+ & *fac_shield(i)*fac_shield(j)
+
gacontp_hb3(k,num_conti,i)=gggp(k)
+ & *fac_shield(i)*fac_shield(j)
+
gacontm_hb1(k,num_conti,i)=ghalfm
& +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
& + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
+ & *fac_shield(i)*fac_shield(j)
+
gacontm_hb2(k,num_conti,i)=ghalfm
& +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
& + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
+ & *fac_shield(i)*fac_shield(j)
+
gacontm_hb3(k,num_conti,i)=gggm(k)
+ & *fac_shield(i)*fac_shield(j)
+
enddo
endif
C Diagnostics. Comment out or remove after debugging!
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
+ include 'COMMON.SHIELD'
+ include 'COMMON.CONTROL'
+
dimension ggg(3)
double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
& e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
& aggj(3,4),aggj1(3,4),a_temp(2,2)
common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
if (j.eq.i+2) then
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+C changes suggested by Ana to avoid out of bounds
+C & .or.((i+5).gt.nres)
+C & .or.((i-1).le.0)
+C end of changes suggested by Ana
+ & .or. itype(i+2).eq.ntyp1
+ & .or. itype(i+3).eq.ntyp1
+C & .or. itype(i+5).eq.ntyp1
+C & .or. itype(i).eq.ntyp1
+C & .or. itype(i-1).eq.ntyp1
+ & ) goto 179
+
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Third-order contributions
call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
call transpose2(auxmat(1,1),auxmat1(1,1))
call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
+ if (shield_mode.eq.0) then
+ fac_shield(i)=1.0
+ fac_shield(j)=1.0
+C else
+C fac_shield(i)=0.4
+C fac_shield(j)=0.6
+ endif
eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
+ & *fac_shield(i)*fac_shield(j)
+ eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
+ & *fac_shield(i)*fac_shield(j)
+
cd write (2,*) 'i,',i,' j',j,'eello_turn3',
cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
cd & ' eello_turn3_num',4*eello_turn3_num
if (calc_grad) then
+C Derivatives in shield mode
+ if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
+ & (shield_mode.gt.0)) then
+C print *,i,j
+
+ do ilist=1,ishield_list(i)
+ iresshield=shield_list(ilist,i)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
+C & *2.0
+ gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
+ & rlocshield
+ & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
+ gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
+ & +rlocshield
+ enddo
+ enddo
+ do ilist=1,ishield_list(j)
+ iresshield=shield_list(ilist,j)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
+C & *2.0
+ gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
+ & rlocshield
+ & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
+ gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
+ & +rlocshield
+
+ enddo
+ enddo
+
+ do k=1,3
+ gshieldc_t3(k,i)=gshieldc_t3(k,i)+
+ & grad_shield(k,i)*eello_t3/fac_shield(i)
+ gshieldc_t3(k,j)=gshieldc_t3(k,j)+
+ & grad_shield(k,j)*eello_t3/fac_shield(j)
+ gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
+ & grad_shield(k,i)*eello_t3/fac_shield(i)
+ gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
+ & grad_shield(k,j)*eello_t3/fac_shield(j)
+ enddo
+ endif
+
C Derivatives in gamma(i)
call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
call transpose2(auxmat2(1,1),pizda(1,1))
call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
+ & *fac_shield(i)*fac_shield(j)
+
C Derivatives in gamma(i+1)
call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
call transpose2(auxmat2(1,1),pizda(1,1))
call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
& +0.5d0*(pizda(1,1)+pizda(2,2))
+ & *fac_shield(i)*fac_shield(j)
+
C Cartesian derivatives
do l=1,3
a_temp(1,1)=aggi(l,1)
call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
gcorr3_turn(l,i)=gcorr3_turn(l,i)
& +0.5d0*(pizda(1,1)+pizda(2,2))
+ & *fac_shield(i)*fac_shield(j)
+
a_temp(1,1)=aggi1(l,1)
a_temp(1,2)=aggi1(l,2)
a_temp(2,1)=aggi1(l,3)
call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
& +0.5d0*(pizda(1,1)+pizda(2,2))
+ & *fac_shield(i)*fac_shield(j)
+
a_temp(1,1)=aggj(l,1)
a_temp(1,2)=aggj(l,2)
a_temp(2,1)=aggj(l,3)
call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
gcorr3_turn(l,j)=gcorr3_turn(l,j)
& +0.5d0*(pizda(1,1)+pizda(2,2))
+ & *fac_shield(i)*fac_shield(j)
+
a_temp(1,1)=aggj1(l,1)
a_temp(1,2)=aggj1(l,2)
a_temp(2,1)=aggj1(l,3)
call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
& +0.5d0*(pizda(1,1)+pizda(2,2))
+ & *fac_shield(i)*fac_shield(j)
+
enddo
endif
- else if (j.eq.i+3 .and. itype(i+2).ne.21) then
+ 179 continue
+ else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+C changes suggested by Ana to avoid out of bounds
+C & .or.((i+5).gt.nres)
+C & .or.((i-1).le.0)
+C end of changes suggested by Ana
+ & .or. itype(i+3).eq.ntyp1
+ & .or. itype(i+4).eq.ntyp1
+C & .or. itype(i+5).eq.ntyp1
+ & .or. itype(i).eq.ntyp1
+C & .or. itype(i-1).eq.ntyp1
+ & ) goto 178
+
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Fourth-order contributions
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))
+ if (shield_mode.eq.0) then
+ fac_shield(i)=1.0
+ fac_shield(j)=1.0
+C else
+C fac_shield(i)=0.4
+C fac_shield(j)=0.6
+ endif
eello_turn4=eello_turn4-(s1+s2+s3)
+ & *fac_shield(i)*fac_shield(j)
+ eello_t4=-(s1+s2+s3)
+ & *fac_shield(i)*fac_shield(j)
+
cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
cd & ' eello_turn4_num',8*eello_turn4_num
C Derivatives in gamma(i)
if (calc_grad) then
+ if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
+ & (shield_mode.gt.0)) then
+C print *,i,j
+
+ do ilist=1,ishield_list(i)
+ iresshield=shield_list(ilist,i)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
+C & *2.0
+ gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
+ & rlocshield
+ & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
+ gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
+ & +rlocshield
+ enddo
+ enddo
+ do ilist=1,ishield_list(j)
+ iresshield=shield_list(ilist,j)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
+C & *2.0
+ gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
+ & rlocshield
+ & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
+ gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
+ & +rlocshield
+
+ enddo
+ enddo
+
+ do k=1,3
+ gshieldc_t4(k,i)=gshieldc_t4(k,i)+
+ & grad_shield(k,i)*eello_t4/fac_shield(i)
+ gshieldc_t4(k,j)=gshieldc_t4(k,j)+
+ & grad_shield(k,j)*eello_t4/fac_shield(j)
+ gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
+ & grad_shield(k,i)*eello_t4/fac_shield(i)
+ gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
+ & grad_shield(k,j)*eello_t4/fac_shield(j)
+ enddo
+ endif
+
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))
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)
+ & *fac_shield(i)*fac_shield(j)
+
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))
call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
+ & *fac_shield(i)*fac_shield(j)
+
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))
call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
+ & *fac_shield(i)*fac_shield(j)
+
C Cartesian derivatives
C Derivatives of this turn contributions in DC(i+2)
if (j.lt.nres-1) then
s3=0.5d0*(pizda(1,1)+pizda(2,2))
ggg(l)=-(s1+s2+s3)
gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
+ & *fac_shield(i)*fac_shield(j)
+
enddo
endif
C Remaining derivatives of this turn contribution
call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
+ & *fac_shield(i)*fac_shield(j)
+
a_temp(1,1)=aggi1(l,1)
a_temp(1,2)=aggi1(l,2)
a_temp(2,1)=aggi1(l,3)
call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
+ & *fac_shield(i)*fac_shield(j)
+
a_temp(1,1)=aggj(l,1)
a_temp(1,2)=aggj(l,2)
a_temp(2,1)=aggj(l,3)
call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
+ & *fac_shield(i)*fac_shield(j)
+
a_temp(1,1)=aggj1(l,1)
a_temp(1,2)=aggj1(l,2)
a_temp(2,1)=aggj1(l,3)
call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
+ & *fac_shield(i)*fac_shield(j)
+
enddo
endif
+ 178 continue
endif
return
end
c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
c & ' scal14',scal14
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)
c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
xi=0.5D0*(c(1,i)+c(1,i+1))
yi=0.5D0*(c(2,i)+c(2,i+1))
zi=0.5D0*(c(3,i)+c(3,i+1))
+C Returning the ith atom to box
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
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)
+C returning the jth atom to box
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+C Finding the closest jth atom
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
+
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+C sss is scaling function for smoothing the cutoff gradient otherwise
+C the gradient would not be continuouse
+ sss=sscale(1.0d0/(dsqrt(rrij)))
+ 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
c write (iout,*) i,j,evdwij
- evdw2=evdw2+evdwij
+ evdw2=evdw2+evdwij*sss
if (calc_grad) then
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
include 'COMMON.DERIV'
include 'COMMON.VAR'
include 'COMMON.INTERACT'
+ include 'COMMON.CONTROL'
dimension ggg(3)
ehpb=0.0D0
cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
endif
C 24/11/03 AL: SS bridges handled separately because of introducing a specific
C distance and angle dependent SS bond potential.
- if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
+C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
+C & iabs(itype(jjj)).eq.1) then
+C call ssbond_ene(iii,jjj,eij)
+C ehpb=ehpb+2*eij
+C else
+ if (.not.dyn_ss .and. i.le.nss) then
+ if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
+ & iabs(itype(jjj)).eq.1) then
call ssbond_ene(iii,jjj,eij)
ehpb=ehpb+2*eij
- else
+ endif !ii.gt.neres
+ else if (ii.gt.nres .and. jj.gt.nres) then
+c Restraints from contact prediction
+ dd=dist(ii,jj)
+ if (constr_dist.eq.11) then
+C ehpb=ehpb+fordepth(i)**4.0d0
+C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
+ ehpb=ehpb+fordepth(i)**4.0d0
+ & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
+ fac=fordepth(i)**4.0d0
+ & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
+C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
+C & ehpb,fordepth(i),dd
+C print *,"TUTU"
+C write(iout,*) ehpb,"atu?"
+C ehpb,"tu?"
+C fac=fordepth(i)**4.0d0
+C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
+ else !constr_dist.eq.11
+ if (dhpb1(i).gt.0.0d0) then
+ ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
+c write (iout,*) "beta nmr",
+c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ else !dhpb(i).gt.0.00
+
C Calculate the distance between the two points and its difference from the
C target distance.
dd=dist(ii,jj)
C Evaluate gradient.
C
fac=waga*rdis/dd
+ endif !dhpb(i).gt.0
+ endif
cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
cd & ' waga=',waga,' fac=',fac
do j=1,3
ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
enddo
endif
+ else !ii.gt.nres
+C write(iout,*) "before"
+ dd=dist(ii,jj)
+C write(iout,*) "after",dd
+ if (constr_dist.eq.11) then
+ ehpb=ehpb+fordepth(i)**4.0d0
+ & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
+ fac=fordepth(i)**4.0d0
+ & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
+C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
+C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
+C print *,ehpb,"tu?"
+C write(iout,*) ehpb,"btu?",
+C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
+C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
+C & ehpb,fordepth(i),dd
+ else
+ if (dhpb1(i).gt.0.0d0) then
+ ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
+c write (iout,*) "alph nmr",
+c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ else
+ rdis=dd-dhpb(i)
+C Get the force constant corresponding to this distance.
+ waga=forcon(i)
+C Calculate the contribution to energy.
+ ehpb=ehpb+waga*rdis*rdis
+c write (iout,*) "alpha reg",dd,waga*rdis*rdis
+C
+C Evaluate gradient.
+C
+ fac=waga*rdis/dd
+ endif
+ endif
+ do j=1,3
+ ggg(j)=fac*(c(j,jj)-c(j,ii))
+ enddo
+cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
+C If this is a SC-SC distance, we need to calculate the contributions to the
+C Cartesian gradient in the SC vectors (ghpbx).
+ if (iii.lt.ii) then
+ do j=1,3
+ ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
+ ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
+ enddo
+ endif
do j=iii,jjj-1
do k=1,3
ghpbc(k,j)=ghpbc(k,j)+ggg(k)
enddo
endif
enddo
- ehpb=0.5D0*ehpb
+ if (constr_dist.ne.11) ehpb=0.5D0*ehpb
return
end
C--------------------------------------------------------------------------
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)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
dsci_inv=dsc_inv(itypi)
- itypj=itype(j)
+ itypj=iabs(itype(j))
dscj_inv=dsc_inv(itypj)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
do k=1,3
gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
enddo
- do k=1,3
- ghpbx(k,i)=ghpbx(k,i)-gg(k)
- & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
- ghpbx(k,j)=ghpbx(k,j)+gg(k)
- & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
+ do k=1,3
+ ghpbx(k,i)=ghpbx(k,i)-gg(k)
+ & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
+ ghpbx(k,j)=ghpbx(k,j)+gg(k)
+ & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
+ enddo
+C
+C Calculate the components of the gradient in DC and X
+C
+ do k=i,j-1
+ do l=1,3
+ ghpbc(l,k)=ghpbc(l,k)+gg(l)
+ enddo
+ enddo
+ return
+ end
+C--------------------------------------------------------------------------
+
+
+c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
+ subroutine e_modeller(ehomology_constr)
+ implicit real*8 (a-h,o-z)
+
+ include 'DIMENSIONS'
+
+ integer nnn, i, j, k, ki, irec, l
+ integer katy, odleglosci, test7
+ real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
+ real*8 distance(max_template),distancek(max_template),
+ & min_odl,godl(max_template),dih_diff(max_template)
+
+c
+c FP - 30/10/2014 Temporary specifications for homology restraints
+c
+ double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
+ & sgtheta
+ double precision, dimension (maxres) :: guscdiff,usc_diff
+ double precision, dimension (max_template) ::
+ & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
+ & theta_diff
+
+ include 'COMMON.SBRIDGE'
+ include 'COMMON.CHAIN'
+ include 'COMMON.GEO'
+ include 'COMMON.DERIV'
+ include 'COMMON.LOCAL'
+ include 'COMMON.INTERACT'
+ include 'COMMON.VAR'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.CONTROL'
+ include 'COMMON.HOMRESTR'
+c
+ include 'COMMON.SETUP'
+ include 'COMMON.NAMES'
+
+ do i=1,max_template
+ distancek(i)=9999999.9
+ enddo
+
+ odleg=0.0d0
+
+c Pseudo-energy and gradient from homology restraints (MODELLER-like
+c function)
+C AL 5/2/14 - Introduce list of restraints
+c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
+#ifdef DEBUG
+ write(iout,*) "------- dist restrs start -------"
+ write (iout,*) "link_start_homo",link_start_homo,
+ & " link_end_homo",link_end_homo
+#endif
+ do ii = link_start_homo,link_end_homo
+ i = ires_homo(ii)
+ j = jres_homo(ii)
+ dij=dist(i,j)
+c write (iout,*) "dij(",i,j,") =",dij
+ do k=1,constr_homology
+ if(.not.l_homo(k,ii)) cycle
+ distance(k)=odl(k,ii)-dij
+c write (iout,*) "distance(",k,") =",distance(k)
+c
+c For Gaussian-type Urestr
+c
+ distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
+c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
+c write (iout,*) "distancek(",k,") =",distancek(k)
+c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
+c
+c For Lorentzian-type Urestr
+c
+ if (waga_dist.lt.0.0d0) then
+ sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
+ distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
+ & (distance(k)**2+sigma_odlir(k,ii)**2))
+ endif
+ enddo
+
+c min_odl=minval(distancek)
+ do kk=1,constr_homology
+ if(l_homo(kk,ii)) then
+ min_odl=distancek(kk)
+ exit
+ endif
+ enddo
+ do kk=1,constr_homology
+ if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
+ & min_odl=distancek(kk)
+ enddo
+c write (iout,* )"min_odl",min_odl
+#ifdef DEBUG
+ write (iout,*) "ij dij",i,j,dij
+ write (iout,*) "distance",(distance(k),k=1,constr_homology)
+ write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
+ write (iout,* )"min_odl",min_odl
+#endif
+ odleg2=0.0d0
+ do k=1,constr_homology
+c Nie wiem po co to liczycie jeszcze raz!
+c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
+c & (2*(sigma_odl(i,j,k))**2))
+ if(.not.l_homo(k,ii)) cycle
+ if (waga_dist.ge.0.0d0) then
+c
+c For Gaussian-type Urestr
+c
+ godl(k)=dexp(-distancek(k)+min_odl)
+ odleg2=odleg2+godl(k)
+c
+c For Lorentzian-type Urestr
+c
+ else
+ odleg2=odleg2+distancek(k)
+ endif
+
+ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
+ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
+ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
+ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
+
+ enddo
+c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
+c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
+#ifdef DEBUG
+ write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
+ write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
+#endif
+ if (waga_dist.ge.0.0d0) then
+c
+c For Gaussian-type Urestr
+c
+ odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
+c
+c For Lorentzian-type Urestr
+c
+ else
+ odleg=odleg+odleg2/constr_homology
+ endif
+c
+#ifdef GRAD
+c write (iout,*) "odleg",odleg ! sum of -ln-s
+c Gradient
+c
+c For Gaussian-type Urestr
+c
+ if (waga_dist.ge.0.0d0) sum_godl=odleg2
+ sum_sgodl=0.0d0
+ do k=1,constr_homology
+c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
+c & *waga_dist)+min_odl
+c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
+c
+ if(.not.l_homo(k,ii)) cycle
+ if (waga_dist.ge.0.0d0) then
+c For Gaussian-type Urestr
+c
+ sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
+c
+c For Lorentzian-type Urestr
+c
+ else
+ sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
+ & sigma_odlir(k,ii)**2)**2)
+ endif
+ sum_sgodl=sum_sgodl+sgodl
+
+c sgodl2=sgodl2+sgodl
+c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
+c write(iout,*) "constr_homology=",constr_homology
+c write(iout,*) i, j, k, "TEST K"
+ enddo
+ if (waga_dist.ge.0.0d0) then
+c
+c For Gaussian-type Urestr
+c
+ grad_odl3=waga_homology(iset)*waga_dist
+ & *sum_sgodl/(sum_godl*dij)
+c
+c For Lorentzian-type Urestr
+c
+ else
+c Original grad expr modified by analogy w Gaussian-type Urestr grad
+c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
+ grad_odl3=-waga_homology(iset)*waga_dist*
+ & sum_sgodl/(constr_homology*dij)
+ endif
+c
+c grad_odl3=sum_sgodl/(sum_godl*dij)
+
+
+c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
+c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
+c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
+
+ccc write(iout,*) godl, sgodl, grad_odl3
+
+c grad_odl=grad_odl+grad_odl3
+
+ do jik=1,3
+ ggodl=grad_odl3*(c(jik,i)-c(jik,j))
+ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
+ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
+ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
+ ghpbc(jik,i)=ghpbc(jik,i)+ggodl
+ ghpbc(jik,j)=ghpbc(jik,j)-ggodl
+ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
+ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
+c if (i.eq.25.and.j.eq.27) then
+c write(iout,*) "jik",jik,"i",i,"j",j
+c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
+c write(iout,*) "grad_odl3",grad_odl3
+c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
+c write(iout,*) "ggodl",ggodl
+c write(iout,*) "ghpbc(",jik,i,")",
+c & ghpbc(jik,i),"ghpbc(",jik,j,")",
+c & ghpbc(jik,j)
+c endif
+ enddo
+#endif
+ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
+ccc & dLOG(odleg2),"-odleg=", -odleg
+
+ enddo ! ii-loop for dist
+#ifdef DEBUG
+ write(iout,*) "------- dist restrs end -------"
+c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
+c & waga_d.eq.1.0d0) call sum_gradient
+#endif
+c Pseudo-energy and gradient from dihedral-angle restraints from
+c homology templates
+c write (iout,*) "End of distance loop"
+c call flush(iout)
+ kat=0.0d0
+c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
+#ifdef DEBUG
+ write(iout,*) "------- dih restrs start -------"
+ do i=idihconstr_start_homo,idihconstr_end_homo
+ write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
+ enddo
+#endif
+ do i=idihconstr_start_homo,idihconstr_end_homo
+ kat2=0.0d0
+c betai=beta(i,i+1,i+2,i+3)
+ betai = phi(i+3)
+c write (iout,*) "betai =",betai
+ do k=1,constr_homology
+ dih_diff(k)=pinorm(dih(k,i)-betai)
+c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
+c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
+c & -(6.28318-dih_diff(i,k))
+c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
+c & 6.28318+dih_diff(i,k)
+
+ kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
+c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
+ gdih(k)=dexp(kat3)
+ kat2=kat2+gdih(k)
+c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
+c write(*,*)""
+ enddo
+c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
+c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
+#ifdef DEBUG
+ write (iout,*) "i",i," betai",betai," kat2",kat2
+ write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
+#endif
+ if (kat2.le.1.0d-14) cycle
+ kat=kat-dLOG(kat2/constr_homology)
+c write (iout,*) "kat",kat ! sum of -ln-s
+
+ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
+ccc & dLOG(kat2), "-kat=", -kat
+
+#ifdef GRAD
+c ----------------------------------------------------------------------
+c Gradient
+c ----------------------------------------------------------------------
+
+ sum_gdih=kat2
+ sum_sgdih=0.0d0
+ do k=1,constr_homology
+ sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
+c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
+ sum_sgdih=sum_sgdih+sgdih
+ enddo
+c grad_dih3=sum_sgdih/sum_gdih
+ grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
+
+c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
+ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
+ccc & gloc(nphi+i-3,icg)
+ gloc(i,icg)=gloc(i,icg)+grad_dih3
+c if (i.eq.25) then
+c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
+c endif
+ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
+ccc & gloc(nphi+i-3,icg)
+#endif
+ enddo ! i-loop for dih
+#ifdef DEBUG
+ write(iout,*) "------- dih restrs end -------"
+#endif
+
+c Pseudo-energy and gradient for theta angle restraints from
+c homology templates
+c FP 01/15 - inserted from econstr_local_test.F, loop structure
+c adapted
+
+c
+c For constr_homology reference structures (FP)
+c
+c Uconst_back_tot=0.0d0
+ Eval=0.0d0
+ Erot=0.0d0
+c Econstr_back legacy
+#ifdef GRAD
+ do i=1,nres
+c do i=ithet_start,ithet_end
+ dutheta(i)=0.0d0
+c enddo
+c do i=loc_start,loc_end
+ do j=1,3
+ duscdiff(j,i)=0.0d0
+ duscdiffx(j,i)=0.0d0
+ enddo
+ enddo
+#endif
+c
+c do iref=1,nref
+c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
+c write (iout,*) "waga_theta",waga_theta
+ if (waga_theta.gt.0.0d0) then
+#ifdef DEBUG
+ write (iout,*) "usampl",usampl
+ write(iout,*) "------- theta restrs start -------"
+c do i=ithet_start,ithet_end
+c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
+c enddo
+#endif
+c write (iout,*) "maxres",maxres,"nres",nres
+
+ do i=ithet_start,ithet_end
+c
+c do i=1,nfrag_back
+c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
+c
+c Deviation of theta angles wrt constr_homology ref structures
+c
+ utheta_i=0.0d0 ! argument of Gaussian for single k
+ gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
+c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
+c over residues in a fragment
+c write (iout,*) "theta(",i,")=",theta(i)
+ do k=1,constr_homology
+c
+c dtheta_i=theta(j)-thetaref(j,iref)
+c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
+ theta_diff(k)=thetatpl(k,i)-theta(i)
+c
+ utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
+c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
+ gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
+ gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
+c Gradient for single Gaussian restraint in subr Econstr_back
+c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
+c
+ enddo
+c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
+c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
+
+c
+#ifdef GRAD
+c Gradient for multiple Gaussian restraint
+ sum_gtheta=gutheta_i
+ sum_sgtheta=0.0d0
+ do k=1,constr_homology
+c New generalized expr for multiple Gaussian from Econstr_back
+ sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
+c
+c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
+ sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
+ enddo
+c
+c Final value of gradient using same var as in Econstr_back
+ dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
+ & *waga_homology(iset)
+c dutheta(i)=sum_sgtheta/sum_gtheta
+c
+c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
+#endif
+ Eval=Eval-dLOG(gutheta_i/constr_homology)
+c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
+c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
+c Uconst_back=Uconst_back+utheta(i)
+ enddo ! (i-loop for theta)
+#ifdef DEBUG
+ write(iout,*) "------- theta restrs end -------"
+#endif
+ endif
+c
+c Deviation of local SC geometry
+c
+c Separation of two i-loops (instructed by AL - 11/3/2014)
+c
+c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
+c write (iout,*) "waga_d",waga_d
+
+#ifdef DEBUG
+ write(iout,*) "------- SC restrs start -------"
+ write (iout,*) "Initial duscdiff,duscdiffx"
+ do i=loc_start,loc_end
+ write (iout,*) i,(duscdiff(jik,i),jik=1,3),
+ & (duscdiffx(jik,i),jik=1,3)
enddo
-C
-C Calculate the components of the gradient in DC and X
-C
- do k=i,j-1
- do l=1,3
- ghpbc(l,k)=ghpbc(l,k)+gg(l)
+#endif
+ do i=loc_start,loc_end
+ usc_diff_i=0.0d0 ! argument of Gaussian for single k
+ guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
+c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
+c write(iout,*) "xxtab, yytab, zztab"
+c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
+ do k=1,constr_homology
+c
+ dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
+c Original sign inverted for calc of gradients (s. Econstr_back)
+ dyy=-yytpl(k,i)+yytab(i) ! ibid y
+ dzz=-zztpl(k,i)+zztab(i) ! ibid z
+c write(iout,*) "dxx, dyy, dzz"
+c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
+c
+ usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
+c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
+c uscdiffk(k)=usc_diff(i)
+ guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
+ guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
+c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
+c & xxref(j),yyref(j),zzref(j)
+ enddo
+c
+c Gradient
+c
+c Generalized expression for multiple Gaussian acc to that for a single
+c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
+c
+c Original implementation
+c sum_guscdiff=guscdiff(i)
+c
+c sum_sguscdiff=0.0d0
+c do k=1,constr_homology
+c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
+c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
+c sum_sguscdiff=sum_sguscdiff+sguscdiff
+c enddo
+c
+c Implementation of new expressions for gradient (Jan. 2015)
+c
+c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
+#ifdef GRAD
+ do k=1,constr_homology
+c
+c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
+c before. Now the drivatives should be correct
+c
+ dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
+c Original sign inverted for calc of gradients (s. Econstr_back)
+ dyy=-yytpl(k,i)+yytab(i) ! ibid y
+ dzz=-zztpl(k,i)+zztab(i) ! ibid z
+c
+c New implementation
+c
+ sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
+ & sigma_d(k,i) ! for the grad wrt r'
+c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
+c
+c
+c New implementation
+ sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
+ do jik=1,3
+ duscdiff(jik,i-1)=duscdiff(jik,i-1)+
+ & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
+ & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
+ duscdiff(jik,i)=duscdiff(jik,i)+
+ & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
+ & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
+ duscdiffx(jik,i)=duscdiffx(jik,i)+
+ & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
+ & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
+c
+#ifdef DEBUG
+ write(iout,*) "jik",jik,"i",i
+ write(iout,*) "dxx, dyy, dzz"
+ write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
+ write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
+c write(iout,*) "sum_sguscdiff",sum_sguscdiff
+cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
+c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
+c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
+c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
+c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
+c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
+c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
+c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
+c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
+c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
+c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
+c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
+c endif
+#endif
+ enddo
+ enddo
+#endif
+c
+c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
+c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
+c
+c write (iout,*) i," uscdiff",uscdiff(i)
+c
+c Put together deviations from local geometry
+
+c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
+c & wfrag_back(3,i,iset)*uscdiff(i)
+ Erot=Erot-dLOG(guscdiff(i)/constr_homology)
+c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
+c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
+c Uconst_back=Uconst_back+usc_diff(i)
+c
+c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
+c
+c New implment: multiplied by sum_sguscdiff
+c
+
+ enddo ! (i-loop for dscdiff)
+
+c endif
+
+#ifdef DEBUG
+ write(iout,*) "------- SC restrs end -------"
+ write (iout,*) "------ After SC loop in e_modeller ------"
+ do i=loc_start,loc_end
+ write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
+ write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
enddo
+ if (waga_theta.eq.1.0d0) then
+ write (iout,*) "in e_modeller after SC restr end: dutheta"
+ do i=ithet_start,ithet_end
+ write (iout,*) i,dutheta(i)
+ enddo
+ endif
+ if (waga_d.eq.1.0d0) then
+ write (iout,*) "e_modeller after SC loop: duscdiff/x"
+ do i=1,nres
+ write (iout,*) i,(duscdiff(j,i),j=1,3)
+ write (iout,*) i,(duscdiffx(j,i),j=1,3)
enddo
+ endif
+#endif
+
+c Total energy from homology restraints
+#ifdef DEBUG
+ write (iout,*) "odleg",odleg," kat",kat
+ write (iout,*) "odleg",odleg," kat",kat
+ write (iout,*) "Eval",Eval," Erot",Erot
+ write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
+ write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
+ write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
+ write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
+#endif
+c
+c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
+c
+c ehomology_constr=odleg+kat
+c
+c For Lorentzian-type Urestr
+c
+
+ if (waga_dist.ge.0.0d0) then
+c
+c For Gaussian-type Urestr
+c
+ ehomology_constr=(waga_dist*odleg+waga_angle*kat+
+ & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
+c write (iout,*) "ehomology_constr=",ehomology_constr
+ else
+c
+c For Lorentzian-type Urestr
+c
+ ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
+ & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
+c write (iout,*) "ehomology_constr=",ehomology_constr
+ endif
+#ifdef DEBUG
+ write (iout,*) "iset",iset," waga_homology",waga_homology(iset)
+ write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
+ & " Eval",waga_theta,Eval," Erot",waga_d,Erot
+ write (iout,*) "ehomology_constr",ehomology_constr
+#endif
return
+
+ 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
+ 747 format(a12,i4,i4,i4,f8.3,f8.3)
+ 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
+ 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
+ 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
+ & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
end
C--------------------------------------------------------------------------
+
+C--------------------------------------------------------------------------
subroutine ebond(estr)
c
c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
logical energy_dec /.false./
double precision u(3),ud(3)
estr=0.0d0
+ estr1=0.0d0
do i=nnt+1,nct
- 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,vbld(i),distchainmax,
+C & gnmr1(vbld(i),-1.0d0,distchainmax)
+C else
+ if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
+ diff = vbld(i)-vbldpDUM
+ else
diff = vbld(i)-vbldp0
c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
+ endif
estr=estr+diff*diff
do j=1,3
gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
enddo
- endif
-
+C endif
+C write (iout,'(a7,i5,4f7.3)')
+C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
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=nnt,nct
- 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)
end
#ifdef CRYST_THETA
C--------------------------------------------------------------------------
- subroutine ebend(etheta)
+ subroutine ebend(etheta,ethetacnstr)
C
C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
C angles gamma and its derivatives in consecutive thetas and gammas.
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
include 'COMMON.FFIELD'
+ include 'COMMON.TORCNSTR'
common /calcthet/ term1,term2,termm,diffak,ratak,
& ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
& delthe0,sig0inv,sigtc,sigsqtc,delthec,it
double precision y(2),z(2)
delta=0.02d0*pi
- time11=dexp(-2*time)
- time12=1.0d0
+c time11=dexp(-2*time)
+c time12=1.0d0
etheta=0.0D0
c write (iout,*) "nres",nres
c write (*,'(a,i2)') 'EBEND ICG=',icg
c write (iout,*) ithet_start,ithet_end
do i=ithet_start,ithet_end
- if (itype(i-1).eq.21) cycle
+ if (i.le.2) 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.eq.3) then
+ y(1)=0.0D0
+ y(2)=0.0D0
+ else
+ if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
#ifdef OSF
phii=phi(i)
- icrc=0
- call proc_proc(phii,icrc)
+c icrc=0
+c call proc_proc(phii,icrc)
if (icrc.eq.1) phii=150.0
#else
phii=phi(i)
y(1)=0.0D0
y(2)=0.0D0
endif
- if (i.lt.nres .and. itype(i).ne.21) then
+ endif
+ if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
#ifdef OSF
phii1=phi(i+1)
- icrc=0
- call proc_proc(phii1,icrc)
+c icrc=0
+c call proc_proc(phii1,icrc)
if (icrc.eq.1) phii1=150.0
phii1=pinorm(phii1)
z(1)=cos(phii1)
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)
+ 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)
enddo
c write (iout,*) "thet_pred_mean",thet_pred_mean
thet_pred_mean=thet_pred_mean*ss+a0thet(it)
c write (iout,*) "thet_pred_mean",thet_pred_mean
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)
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)
- 1215 continue
+c 1215 continue
enddo
C Ufff.... We've done all this!!!
+C now constrains
+ ethetacnstr=0.0d0
+C print *,ithetaconstr_start,ithetaconstr_end,"TU"
+ do i=1,ntheta_constr
+ itheta=itheta_constr(i)
+ thetiii=theta(itheta)
+ difi=pinorm(thetiii-theta_constr0(i))
+ if (difi.gt.theta_drange(i)) then
+ difi=difi-theta_drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
+ & +for_thet_constr(i)*difi**3
+ else if (difi.lt.-drange(i)) then
+ difi=difi+drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
+ & +for_thet_constr(i)*difi**3
+ else
+ difi=0.0
+ endif
+C if (energy_dec) then
+C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
+C & i,itheta,rad2deg*thetiii,
+C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
+C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
+C & gloc(itheta+nphi-2,icg)
+C endif
+ enddo
return
end
C---------------------------------------------------------------------------
end
#else
C--------------------------------------------------------------------------
- subroutine ebend(etheta)
+ subroutine ebend(etheta,ethetacnstr)
C
C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
C angles gamma and its derivatives in consecutive thetas and gammas.
include 'COMMON.NAMES'
include 'COMMON.FFIELD'
include 'COMMON.CONTROL'
+ include 'COMMON.TORCNSTR'
double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
& cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
& sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
etheta=0.0D0
c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
do i=ithet_start,ithet_end
- if (itype(i-1).eq.21) cycle
+ if (i.eq.2) 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)))
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)
c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
c call flush(iout)
- 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)
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
+c gloc(nphi+i-2,icg)=wang*dethetai
+ gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
+ enddo
+C now constrains
+ ethetacnstr=0.0d0
+C print *,ithetaconstr_start,ithetaconstr_end,"TU"
+ do i=1,ntheta_constr
+ itheta=itheta_constr(i)
+ thetiii=theta(itheta)
+ difi=pinorm(thetiii-theta_constr0(i))
+ if (difi.gt.theta_drange(i)) then
+ difi=difi-theta_drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
+ & +for_thet_constr(i)*difi**3
+ else if (difi.lt.-drange(i)) then
+ difi=difi+drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
+ & +for_thet_constr(i)*difi**3
+ else
+ difi=0.0
+ endif
+C if (energy_dec) then
+C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
+C & i,itheta,rad2deg*thetiii,
+C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
+C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
+C & gloc(itheta+nphi-2,icg)
+C endif
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 iii=-1,1
do j=1,nlobit
- expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
+ expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
cd print *,'j=',j,' expfac=',expfac
escloc_i=escloc_i+expfac
do k=1,3
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))
+c zz1 = -dsin(alph(2))*dsin(omeg(2))
+ zz1 = -dsign(1.0d0,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
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))
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) cycle
+ if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
+ & .or. itype(i).eq.ntyp1) cycle
itori=itortyp(itype(i-2))
itori1=itortyp(itype(i-1))
phii=phi(i)
difi=phii-phi0(i)
if (difi.gt.drange(i)) then
difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
else if (difi.lt.-drange(i)) then
difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
endif
! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
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) cycle
+ if (i.le.2) 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
if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
+ 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 (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,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
1215 continue
edihi=0.0d0
if (difi.gt.drange(i)) then
difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
- edihi=0.25d0*ftors*difi**4
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
+ edihi=0.25d0*ftors(i)*difi**4
else if (difi.lt.-drange(i)) then
difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
- edihi=0.25d0*ftors*difi**4
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
+ edihi=0.25d0*ftors(i)*difi**4
else
difi=0.0d0
endif
c lprn=.true.
etors_d=0.0D0
do i=iphi_start,iphi_end-1
- if (itype(i-2).eq.21 .or. itype(i-1).eq.21
- & .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (i.le.3) 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
if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
& goto 1215
itori=itortyp(itype(i-2))
phii1=phi(i+1)
gloci1=0.0D0
gloci2=0.0D0
+ iblock=1
+ if (iabs(itype(i+1)).eq.20) iblock=2
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)
+ 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)
c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
esccor=0.0D0
do i=itau_start,itau_end
- if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1) cycle
+ if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
esccor_ii=0.0D0
isccori=isccortyp(itype(i-2))
isccori1=isccortyp(itype(i-1))
integer dimen1,dimen2,atom,indx
double precision buffer(dimen1,dimen2)
double precision zapas
- common /contacts_hb/ zapas(3,20,maxres,7),
- & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
- & num_cont_hb(maxres),jcont_hb(20,maxres)
+ common /contacts_hb/ zapas(3,ntyp,maxres,7),
+ & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
+ & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
num_kont=buffer(1,indx+26)
num_kont_old=num_cont_hb(atom)
num_cont_hb(atom)=num_kont+num_kont_old
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.SHIELD'
+
double precision gx(3),gx1(3)
logical lprn
lprn=.false.
& ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
& coeffm*ees0mij*gacontm_hb3(ll,kk,k))
enddo
- enddo
+ enddo
+ if (shield_mode.gt.0) then
+ j=ees0plist(jj,i)
+ l=ees0plist(kk,k)
+C print *,i,j,fac_shield(i),fac_shield(j),
+C &fac_shield(k),fac_shield(l)
+ if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
+ & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
+ do ilist=1,ishield_list(i)
+ iresshield=shield_list(ilist,i)
+ do m=1,3
+ rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
+C & *2.0
+ gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
+ & rlocshield
+ & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
+ gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
+ &+rlocshield
+ enddo
+ enddo
+ do ilist=1,ishield_list(j)
+ iresshield=shield_list(ilist,j)
+ do m=1,3
+ rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
+C & *2.0
+ gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
+ & rlocshield
+ & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
+ gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
+ & +rlocshield
+ enddo
+ enddo
+ do ilist=1,ishield_list(k)
+ iresshield=shield_list(ilist,k)
+ do m=1,3
+ rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
+C & *2.0
+ gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
+ & rlocshield
+ & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
+ gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
+ & +rlocshield
+ enddo
+ enddo
+ do ilist=1,ishield_list(l)
+ iresshield=shield_list(ilist,l)
+ do m=1,3
+ rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
+C & *2.0
+ gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
+ & rlocshield
+ & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
+ gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
+ & +rlocshield
+ enddo
+ enddo
+C print *,gshieldx(m,iresshield)
+ do m=1,3
+ gshieldc_ec(m,i)=gshieldc_ec(m,i)+
+ & grad_shield(m,i)*ehbcorr/fac_shield(i)
+ gshieldc_ec(m,j)=gshieldc_ec(m,j)+
+ & grad_shield(m,j)*ehbcorr/fac_shield(j)
+ gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
+ & grad_shield(m,i)*ehbcorr/fac_shield(i)
+ gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
+ & grad_shield(m,j)*ehbcorr/fac_shield(j)
+
+ gshieldc_ec(m,k)=gshieldc_ec(m,k)+
+ & grad_shield(m,k)*ehbcorr/fac_shield(k)
+ gshieldc_ec(m,l)=gshieldc_ec(m,l)+
+ & grad_shield(m,l)*ehbcorr/fac_shield(l)
+ gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
+ & grad_shield(m,k)*ehbcorr/fac_shield(k)
+ gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
+ & grad_shield(m,l)*ehbcorr/fac_shield(l)
+
+ enddo
+ endif
+ endif
endif
ehbcorr=ekont*ees
return
& auxmat(2,2)
iti1 = itortyp(itype(i+1))
if (j.lt.nres-1) then
- itj1 = itortyp(itype(j+1))
+ if (itype(j).le.ntyp) then
+ itj1 = itortyp(itype(j+1))
+ else
+ itj1=ntortyp+1
+ endif
else
itj1=ntortyp+1
endif
enddo
if (l.eq.j+1) then
C parallel orientation of the two CA-CA-CA frames.
- if (i.gt.1) then
+c if (i.gt.1) then
+ if (i.gt.1 .and. itype(i).le.ntyp) then
iti=itortyp(itype(i))
else
iti=ntortyp+1
endif
itk1=itortyp(itype(k+1))
itj=itortyp(itype(j))
- if (l.lt.nres-1) then
+c if (l.lt.nres-1) then
+ if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
itl1=itortyp(itype(l+1))
else
itl1=ntortyp+1
C End vectors
else
C Antiparallel orientation of the two CA-CA-CA frames.
- if (i.gt.1) then
+c if (i.gt.1) then
+ if (i.gt.1 .and. itype(i).le.ntyp) then
iti=itortyp(itype(i))
else
iti=ntortyp+1
itk1=itortyp(itype(k+1))
itl=itortyp(itype(l))
itj=itortyp(itype(j))
- if (j.lt.nres-1) then
+c if (j.lt.nres-1) then
+ if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
itj1=itortyp(itype(j+1))
else
itj1=ntortyp+1
C 4/7/01 AL Component s1 was removed, because it pertains to the respective
C energy moment and not to the cluster cumulant.
iti=itortyp(itype(i))
- if (j.lt.nres-1) then
+c if (j.lt.nres-1) then
+ if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
itj1=itortyp(itype(j+1))
else
itj1=ntortyp+1
endif
itk=itortyp(itype(k))
itk1=itortyp(itype(k+1))
- if (l.lt.nres-1) then
+c if (l.lt.nres-1) then
+ if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
itl1=itortyp(itype(l+1))
else
itl1=ntortyp+1
cd write (2,*) 'eello_graph4: wturn6',wturn6
iti=itortyp(itype(i))
itj=itortyp(itype(j))
- if (j.lt.nres-1) then
+c if (j.lt.nres-1) then
+ if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
itj1=itortyp(itype(j+1))
else
itj1=ntortyp+1
endif
itk=itortyp(itype(k))
- if (k.lt.nres-1) then
+c if (k.lt.nres-1) then
+ if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
itk1=itortyp(itype(k+1))
else
itk1=ntortyp+1
scalar=sc
return
end
+C-----------------------------------------------------------------------
+ double precision function sscale(r)
+ double precision r,gamm
+ include "COMMON.SPLITELE"
+ if(r.lt.r_cut-rlamb) then
+ sscale=1.0d0
+ else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
+ gamm=(r-(r_cut-rlamb))/rlamb
+ sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
+ else
+ sscale=0d0
+ endif
+ return
+ end
+C-----------------------------------------------------------------------
+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-----------------------------------------------------------------------
+C first for shielding is setting of function of side-chains
+ subroutine set_shield_fac2
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.CHAIN'
+ include 'COMMON.DERIV'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.SHIELD'
+ include 'COMMON.INTERACT'
+C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
+ double precision div77_81/0.974996043d0/,
+ &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
+
+C the vector between center of side_chain and peptide group
+ double precision pep_side(3),long,side_calf(3),
+ &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
+ &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
+C the line belowe needs to be changed for FGPROC>1
+ do i=1,nres-1
+ if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
+ ishield_list(i)=0
+Cif there two consequtive dummy atoms there is no peptide group between them
+C the line below has to be changed for FGPROC>1
+ VolumeTotal=0.0
+ do k=1,nres
+ if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
+ dist_pep_side=0.0
+ dist_side_calf=0.0
+ do j=1,3
+C first lets set vector conecting the ithe side-chain with kth side-chain
+ pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
+C pep_side(j)=2.0d0
+C and vector conecting the side-chain with its proper calfa
+ side_calf(j)=c(j,k+nres)-c(j,k)
+C side_calf(j)=2.0d0
+ pept_group(j)=c(j,i)-c(j,i+1)
+C lets have their lenght
+ dist_pep_side=pep_side(j)**2+dist_pep_side
+ dist_side_calf=dist_side_calf+side_calf(j)**2
+ dist_pept_group=dist_pept_group+pept_group(j)**2
+ enddo
+ dist_pep_side=dsqrt(dist_pep_side)
+ dist_pept_group=dsqrt(dist_pept_group)
+ dist_side_calf=dsqrt(dist_side_calf)
+ do j=1,3
+ pep_side_norm(j)=pep_side(j)/dist_pep_side
+ side_calf_norm(j)=dist_side_calf
+ enddo
+C now sscale fraction
+ sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
+C print *,buff_shield,"buff"
+C now sscale
+ if (sh_frac_dist.le.0.0) cycle
+C If we reach here it means that this side chain reaches the shielding sphere
+C Lets add him to the list for gradient
+ ishield_list(i)=ishield_list(i)+1
+C ishield_list is a list of non 0 side-chain that contribute to factor gradient
+C this list is essential otherwise problem would be O3
+ shield_list(ishield_list(i),i)=k
+C Lets have the sscale value
+ if (sh_frac_dist.gt.1.0) then
+ scale_fac_dist=1.0d0
+ do j=1,3
+ sh_frac_dist_grad(j)=0.0d0
+ enddo
+ else
+ scale_fac_dist=-sh_frac_dist*sh_frac_dist
+ & *(2.0d0*sh_frac_dist-3.0d0)
+ fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
+ & /dist_pep_side/buff_shield*0.5d0
+C remember for the final gradient multiply sh_frac_dist_grad(j)
+C for side_chain by factor -2 !
+ do j=1,3
+ sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
+C sh_frac_dist_grad(j)=0.0d0
+C scale_fac_dist=1.0d0
+C print *,"jestem",scale_fac_dist,fac_help_scale,
+C & sh_frac_dist_grad(j)
+ enddo
+ endif
+C this is what is now we have the distance scaling now volume...
+ short=short_r_sidechain(itype(k))
+ long=long_r_sidechain(itype(k))
+ costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
+ sinthet=short/dist_pep_side*costhet
+C now costhet_grad
+C costhet=0.6d0
+C sinthet=0.8
+ costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
+C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
+C & -short/dist_pep_side**2/costhet)
+C costhet_fac=0.0d0
+ do j=1,3
+ costhet_grad(j)=costhet_fac*pep_side(j)
+ enddo
+C remember for the final gradient multiply costhet_grad(j)
+C for side_chain by factor -2 !
+C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
+C pep_side0pept_group is vector multiplication
+ pep_side0pept_group=0.0d0
+ do j=1,3
+ pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
+ enddo
+ cosalfa=(pep_side0pept_group/
+ & (dist_pep_side*dist_side_calf))
+ fac_alfa_sin=1.0d0-cosalfa**2
+ fac_alfa_sin=dsqrt(fac_alfa_sin)
+ rkprim=fac_alfa_sin*(long-short)+short
+C rkprim=short
+
+C now costhet_grad
+ cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
+C cosphi=0.6
+ cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
+ sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
+ & dist_pep_side**2)
+C sinphi=0.8
+ do j=1,3
+ cosphi_grad_long(j)=cosphi_fac*pep_side(j)
+ &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
+ &*(long-short)/fac_alfa_sin*cosalfa/
+ &((dist_pep_side*dist_side_calf))*
+ &((side_calf(j))-cosalfa*
+ &((pep_side(j)/dist_pep_side)*dist_side_calf))
+C cosphi_grad_long(j)=0.0d0
+ cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
+ &*(long-short)/fac_alfa_sin*cosalfa
+ &/((dist_pep_side*dist_side_calf))*
+ &(pep_side(j)-
+ &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
+C cosphi_grad_loc(j)=0.0d0
+ enddo
+C print *,sinphi,sinthet
+ VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
+ & /VSolvSphere_div
+C & *wshield
+C now the gradient...
+ do j=1,3
+ grad_shield(j,i)=grad_shield(j,i)
+C gradient po skalowaniu
+ & +(sh_frac_dist_grad(j)*VofOverlap
+C gradient po costhet
+ & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
+ &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
+ & sinphi/sinthet*costhet*costhet_grad(j)
+ & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
+ & )*wshield
+C grad_shield_side is Cbeta sidechain gradient
+ grad_shield_side(j,ishield_list(i),i)=
+ & (sh_frac_dist_grad(j)*-2.0d0
+ & *VofOverlap
+ & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
+ &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
+ & sinphi/sinthet*costhet*costhet_grad(j)
+ & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
+ & )*wshield
+
+ grad_shield_loc(j,ishield_list(i),i)=
+ & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
+ &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
+ & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
+ & ))
+ & *wshield
+ enddo
+ VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
+ enddo
+ fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
+C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
+ enddo
+ return
+ end
+C first for shielding is setting of function of side-chains
+ subroutine set_shield_fac
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.CHAIN'
+ include 'COMMON.DERIV'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.SHIELD'
+ include 'COMMON.INTERACT'
+C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
+ double precision div77_81/0.974996043d0/,
+ &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
+
+C the vector between center of side_chain and peptide group
+ double precision pep_side(3),long,side_calf(3),
+ &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
+ &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
+C the line belowe needs to be changed for FGPROC>1
+ do i=1,nres-1
+ if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
+ ishield_list(i)=0
+Cif there two consequtive dummy atoms there is no peptide group between them
+C the line below has to be changed for FGPROC>1
+ VolumeTotal=0.0
+ do k=1,nres
+ if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
+ dist_pep_side=0.0
+ dist_side_calf=0.0
+ do j=1,3
+C first lets set vector conecting the ithe side-chain with kth side-chain
+ pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
+C pep_side(j)=2.0d0
+C and vector conecting the side-chain with its proper calfa
+ side_calf(j)=c(j,k+nres)-c(j,k)
+C side_calf(j)=2.0d0
+ pept_group(j)=c(j,i)-c(j,i+1)
+C lets have their lenght
+ dist_pep_side=pep_side(j)**2+dist_pep_side
+ dist_side_calf=dist_side_calf+side_calf(j)**2
+ dist_pept_group=dist_pept_group+pept_group(j)**2
+ enddo
+ dist_pep_side=dsqrt(dist_pep_side)
+ dist_pept_group=dsqrt(dist_pept_group)
+ dist_side_calf=dsqrt(dist_side_calf)
+ do j=1,3
+ pep_side_norm(j)=pep_side(j)/dist_pep_side
+ side_calf_norm(j)=dist_side_calf
+ enddo
+C now sscale fraction
+ sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
+C print *,buff_shield,"buff"
+C now sscale
+ if (sh_frac_dist.le.0.0) cycle
+C If we reach here it means that this side chain reaches the shielding sphere
+C Lets add him to the list for gradient
+ ishield_list(i)=ishield_list(i)+1
+C ishield_list is a list of non 0 side-chain that contribute to factor gradient
+C this list is essential otherwise problem would be O3
+ shield_list(ishield_list(i),i)=k
+C Lets have the sscale value
+ if (sh_frac_dist.gt.1.0) then
+ scale_fac_dist=1.0d0
+ do j=1,3
+ sh_frac_dist_grad(j)=0.0d0
+ enddo
+ else
+ scale_fac_dist=-sh_frac_dist*sh_frac_dist
+ & *(2.0*sh_frac_dist-3.0d0)
+ fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
+ & /dist_pep_side/buff_shield*0.5
+C remember for the final gradient multiply sh_frac_dist_grad(j)
+C for side_chain by factor -2 !
+ do j=1,3
+ sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
+C print *,"jestem",scale_fac_dist,fac_help_scale,
+C & sh_frac_dist_grad(j)
+ enddo
+ endif
+C if ((i.eq.3).and.(k.eq.2)) then
+C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
+C & ,"TU"
+C endif
+
+C this is what is now we have the distance scaling now volume...
+ short=short_r_sidechain(itype(k))
+ long=long_r_sidechain(itype(k))
+ costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
+C now costhet_grad
+C costhet=0.0d0
+ costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
+C costhet_fac=0.0d0
+ do j=1,3
+ costhet_grad(j)=costhet_fac*pep_side(j)
+ enddo
+C remember for the final gradient multiply costhet_grad(j)
+C for side_chain by factor -2 !
+C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
+C pep_side0pept_group is vector multiplication
+ pep_side0pept_group=0.0
+ do j=1,3
+ pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
+ enddo
+ cosalfa=(pep_side0pept_group/
+ & (dist_pep_side*dist_side_calf))
+ fac_alfa_sin=1.0-cosalfa**2
+ fac_alfa_sin=dsqrt(fac_alfa_sin)
+ rkprim=fac_alfa_sin*(long-short)+short
+C now costhet_grad
+ cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
+ cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
+
+ do j=1,3
+ cosphi_grad_long(j)=cosphi_fac*pep_side(j)
+ &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
+ &*(long-short)/fac_alfa_sin*cosalfa/
+ &((dist_pep_side*dist_side_calf))*
+ &((side_calf(j))-cosalfa*
+ &((pep_side(j)/dist_pep_side)*dist_side_calf))
+
+ cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
+ &*(long-short)/fac_alfa_sin*cosalfa
+ &/((dist_pep_side*dist_side_calf))*
+ &(pep_side(j)-
+ &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
+ enddo
+
+ VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
+ & /VSolvSphere_div
+ & *wshield
+C now the gradient...
+C grad_shield is gradient of Calfa for peptide groups
+C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
+C & costhet,cosphi
+C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
+C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
+ do j=1,3
+ grad_shield(j,i)=grad_shield(j,i)
+C gradient po skalowaniu
+ & +(sh_frac_dist_grad(j)
+C gradient po costhet
+ &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
+ &-scale_fac_dist*(cosphi_grad_long(j))
+ &/(1.0-cosphi) )*div77_81
+ &*VofOverlap
+C grad_shield_side is Cbeta sidechain gradient
+ grad_shield_side(j,ishield_list(i),i)=
+ & (sh_frac_dist_grad(j)*-2.0d0
+ & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
+ & +scale_fac_dist*(cosphi_grad_long(j))
+ & *2.0d0/(1.0-cosphi))
+ & *div77_81*VofOverlap
+
+ grad_shield_loc(j,ishield_list(i),i)=
+ & scale_fac_dist*cosphi_grad_loc(j)
+ & *2.0d0/(1.0-cosphi)
+ & *div77_81*VofOverlap
+ enddo
+ VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
+ enddo
+ fac_shield(i)=VolumeTotal*div77_81+div4_81
+C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
+ enddo
+ return
+ end
+C--------------------------------------------------------------------------
+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-----------------------------------------------------------------------
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+ 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.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
+ write(iout,*) "I am in?"
+ do i=1,nres
+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
+ 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=1,nres
+ 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-------------------------------------------------------------------------------------
ires=0
do i=nnt,nct
iti=itype(i)
- if (iti.eq.21) then
+ if (iti.eq.ntyp1) then
ichain=ichain+1
ires=0
write (ipdb,'(a)') 'TER'
enddo
write (ipdb,'(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 (ipdb,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 (ipdb,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 (ipdb,30) ica(i),ica(i)+1
endif
enddo
return
end
c---------------------------------------------------------------------------------
+c---------------------------------------------------------------------------------
+ double precision function rlornmr1(y,ymin,ymax,sigma)
+ implicit none
+ double precision y,ymin,ymax,sigma
+ double precision wykl /4.0d0/
+ if (y.lt.ymin) then
+ rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
+ else if (y.gt.ymax) then
+ rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
+ else
+ rlornmr1=0.0d0
+ endif
+ return
+ end
+c------------------------------------------------------------------------------
+ double precision function rlornmr1prim(y,ymin,ymax,sigma)
+ implicit none
+ double precision y,ymin,ymax,sigma
+ double precision wykl /4.0d0/
+ if (y.lt.ymin) then
+ rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/
+ & ((ymin-y)**wykl+sigma**wykl)**2
+ else if (y.gt.ymax) then
+ rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/
+ & ((y-ymax)**wykl+sigma**wykl)**2
+ else
+ rlornmr1prim=0.0d0
+ endif
+ return
+ end
+
& 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
- double precision aa,bb,augm,aad,bad,app,bpp,ael6,ael3
+ double precision aa_aq,bb_aq,augm,aad,bad,app,bpp,ael6,ael3,
+ & aa_lip,bb_lip
integer nnt,nct,nint_gr,istart,iend,itype,itel,itypro,ielstart,
& ielend,nscp_gr,iscpstart,iscpend,iatsc_s,iatsc_e,iatel_s,
& iatel_e,iatscp_s,iatscp_e,ispp,iscp,expon,expon2
- common /interact/aa(ntyp,ntyp),bb(ntyp,ntyp),augm(ntyp,ntyp),
+ common /interact/aa_aq(ntyp,ntyp),bb_aq(ntyp,ntyp),
+ & augm(ntyp,ntyp),aa_lip(ntyp,ntyp),bb_lip(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,
& iscpstart(maxres,maxint_gr),iscpend(maxres,maxint_gr),
& iatsc_s,iatsc_e,iatel_s,iatel_e,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,chip0,alp,signa0,
+ double precision eps,epslip,sigma,sigmaii,rs0,chi,chip,chip0,
+ & alp,signa0,
& sigii,sigma0,rr0,r0,r0e,r0d,rpp,epp,elpp6,elpp3,eps_scp,rscp,
& eps_orig
- common /body/eps(ntyp,ntyp),sigma(ntyp,ntyp),sigmaii(ntyp,ntyp),
+ common /body/eps(ntyp,ntyp),epslip(ntyp,ntyp),
+ & sigma(ntyp,ntyp),sigmaii(ntyp,ntyp),
& rs0(ntyp,ntyp),chi(ntyp,ntyp),chip(ntyp),chip0(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),eps_orig(ntyp,ntyp)
+ & eps_scp(ntyp,2),rscp(ntyp,2),eps_orig(ntyp,ntyp)
c 12/5/03 modified 09/18/03 Bond stretching parameters.
double precision vbldp0,vbldsc0,akp,aksc,abond0,distchainmax
+ &,vbldpDUM
integer nbondterm
common /stretch/ vbldp0,vbldsc0(maxbondterm,ntyp),akp,
& aksc(maxbondterm,ntyp),abond0(maxbondterm,ntyp),
& distchainmax,nbondterm(ntyp)
+ &,vbldpDUM
+C 01/29/15 Lipidic parameters
+ double precision pepliptran,liptranene
+ common /lipid/ pepliptran,liptranene(ntyp)
+
integer nlob,loc_start,loc_end,ithet_start,ithet_end,
& iphi_start,iphi_end
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),
+ & bthet(2,-ntyp:ntyp),
+ & polthet(0:3,-ntyp:ntyp),gthet(3,-ntyp:ntyp),theta0(-ntyp:ntyp),
+ & sig0(-ntyp:ntyp),
+ & sigc0(-ntyp:ntyp)
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)
- common /theta_abinitio/aa0thet,aathet,bbthet,ccthet,ddthet,eethet,
+ & ithetyp(-ntyp:ntyp1),nntheterm
+C Parameters of ab initio-derived potential of virtual-bond-angle bending
+ integer nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,ndouble,
+ & 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,
& ndouble,nntheterm
+++ /dev/null
- character*3 restyp
- character*1 onelet
- common /names/ restyp(ntyp+1),onelet(ntyp+1)
- character*10 ename,wname
- integer nprint_ene,print_order
- common /namterm/ ename(max_ene),wname(max_ene),nprint_ene,
- & print_order(max_ene)
C Parameters of the SCCOR term
double precision v1sccor,v2sccor
integer nterm_sccor
- common/torsion/v1sccor(maxterm_sccor,20,20),
- & v2sccor(maxterm_sccor,20,20),
+ common/torsion/v1sccor(maxterm_sccor,ntyp,ntyp),
+ & v2sccor(maxterm_sccor,ntyp,ntyp),
& nterm_sccor
C Parameters of the SC rotamers (local) term
double precision sc_parmin
- common/scrot/sc_parmin(maxsccoef,20)
+ common/scrot/sc_parmin(maxsccoef,ntyp)
--- /dev/null
+ integer king,idint,idreal,idchar,is_done
+ parameter (king=0,idint=1105,idreal=1729,idchar=1597,is_done=1)
+ integer me,cg_rank,fg_rank,fg_rank1,nodes,Nprocs,nfgtasks,kolor,
+ & koniec(0:maxprocs-1),WhatsUp,ifinish(maxprocs-1),CG_COMM,FG_COMM,
+ & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp(0:maxprocs-1),
+ & kolor1,key1,nfgtasks1,MyRank,
+ & max_gs_size
+ logical yourjob, finished, cgdone
+ common/setup/me,MyRank,cg_rank,fg_rank,fg_rank1,nodes,Nprocs,
+ & nfgtasks,nfgtasks1,
+ & max_gs_size,kolor,koniec,WhatsUp,ifinish,CG_COMM,FG_COMM,
+ & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp
+ integer MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2,
+ & MPI_THET,MPI_GAM,
+ & MPI_ROTAT1(0:1),MPI_ROTAT2(0:1),MPI_ROTAT_OLD(0:1),
+ & MPI_PRECOMP11(0:1),MPI_PRECOMP12(0:1),MPI_PRECOMP22(0:1),
+ & MPI_PRECOMP23(0:1)
+ common /types/ MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2,
+ & MPI_THET,MPI_GAM,
+ & MPI_ROTAT1,MPI_ROTAT2,MPI_ROTAT_OLD,MPI_PRECOMP11,MPI_PRECOMP12,
+ & MPI_PRECOMP22,MPI_PRECOMP23
--- /dev/null
+ double precision r_cut,rlamb
+ common /splitele/ r_cut,rlamb
- integer ndih_constr,idih_constr(maxdih_constr)
+ integer ndih_constr,idih_constr(maxdih_constr),ntheta_constr,
+ & itheta_constr(maxdih_constr)
integer ndih_nconstr,idih_nconstr(maxdih_constr)
- double precision phi0(maxdih_constr),drange(maxdih_constr),ftors
- common /torcnstr/ phi0,drange,ftors,ndih_constr,idih_constr,
- & ndih_nconstr,idih_nconstr
+ integer idihconstr_start,idihconstr_end,ithetaconstr_start,
+ & ithetaconstr_end
+ double precision phi0(maxdih_constr),drange(maxdih_constr),
+ & ftors(maxdih_constr),theta_constr0(maxdih_constr),
+ & theta_drange(maxdih_constr),for_thet_constr(maxdih_constr)
+ common /torcnstr/ phi0,drange,ftors,theta_constr0,theta_drange,
+ & for_thet_constr,
+ & ndih_constr,idih_constr,
+ & ndih_nconstr,idih_nconstr,idihconstr_start,idihconstr_end,
+ & ntheta_constr,itheta_constr,ithetaconstr_start,
+ & ithetaconstr_end
& epp_low(2,2),epp_up(2,2),rpp_low(2,2),rpp_up(2,2),
& elpp6_low(2,2),elpp6_up(2,2),elpp3_low(2,2),elpp3_up(2,2),
& b_low(13,3),b_up(13,3),x_up(max_paropt),x_low(max_paropt),
- & epscp_low(0:20,2),epscp_up(0:20,2),rscp_low(0:20,2),
- & rscp_up(0:20,2),epss_low(ntyp),epss_up(ntyp),epsp_low(nntyp),
+ & epscp_low(0:ntyp,2),epscp_up(0:ntyp,2),rscp_low(0:ntyp,2),
+ & rscp_up(0:ntyp,2),epss_low(ntyp),epss_up(ntyp),epsp_low(nntyp),
& epsp_up(nntyp),
& xm(max_paropt,0:maxprot),xm1(max_paropt,0:maxprot),
& xm2(max_paropt,0:maxprot),
& imask(max_ene),nsingle_sc,npair_sc,ityp_ssc(ntyp),
& ityp_psc(2,nntyp),mask_elec(2,2,4),
& mask_fourier(13,3),
- & mask_scp(0:20,2,2),mod_other_params,mod_fourier(0:3),
+ & mask_scp(0:ntyp,2,2),mod_other_params,mod_fourier(0:3),
& mod_elec,mod_scp,mod_side,indz(maxbatch+1,maxprot),iw(max_ene)
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 potname /'LJ','LJK','BP','GB','GBV'/
end
ibond=28
isccor=29
jrms=30
+ iliptran=60
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
polthet(j,i)=0.0D0
enddo
nlob(ntyp1)=0
dsc(ntyp1)=0.0D0
- do i=1,maxtor
+ do i=-maxtor,maxtor
itortyp(i)=0
- do j=1,maxtor
- do k=1,maxterm
- v1(k,j,i)=0.0D0
- v2(k,j,i)=0.0D0
- enddo
- enddo
+ 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
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 ",
& "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
& "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB","EVDWPP",
- & "ESTR","ESCCOR","EVDW2_14","","EVDW_T"/
+ & "EVDW2_14","ESTR","ESCCOR","EDIHC","EVDW_T","ELIPTRAN",
+ & "EAFM","ETHETC"/
data wname /
& "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
& "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
- & "WHPB","WVDWPP","WBOND","WSCCOR","WSCP14","","WSC"/
- data nprint_ene /21/
+ & "WHPB","WVDWPP","WSCP14","WBOND","WSCCOR","WDIHC","WSC",
+ & "WLIPTRAN","WAFM","WTHETC"/
+ data nprint_ene /22/
data print_order /1,2,3,18,11,12,13,14,4,5,6,7,8,9,10,19,
- & 16,15,17,20,21/
+ & 16,15,17,20,21,24,22,23/
end
c---------------------------------------------------------------------------
subroutine init_int_table
cd & (ihpb(i),jhpb(i),i=1,nss)
do i=nnt,nct-1
scheck=.false.
+ if (dyn_ss) goto 10
do ii=1,nss
if (ihpb(ii).eq.i+nres) then
scheck=.true.
nint_gr(i)=1
istart(i,1)=i+1
iend(i,1)=nct
- ind_scint=int_scint+nct-i
+ ind_scint=ind_scint+nct-i
#endif
endif
#ifdef MPL
cd & ' link_end',link_end
return
end
+c------------------------------------------------------------------------------
+ subroutine homology_partition
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+#ifdef MPI
+ include 'mpif.h'
+#endif
+ include 'COMMON.SBRIDGE'
+ include 'COMMON.IOUNITS'
+c include 'COMMON.SETUP'
+ include 'COMMON.CONTROL'
+ include 'COMMON.CHAIN'
+ include 'COMMON.INTERACT'
+ include 'COMMON.HOMRESTR'
+ write(iout,*)"homology_partition: lim_odl=",lim_odl,
+ & " lim_dih",lim_dih
+#ifdef MPL
+ call int_bounds(lim_odl,link_start_homo,link_end_homo)
+ call int_bounds(lim_dih-nnt+1,idihconstr_start_homo,
+ & idihconstr_end_homo)
+ idihconstr_start_homo=idihconstr_start_homo+nnt-1
+ idihconstr_end_homo=idihconstr_end_homo+nnt-1
+ if (me.eq.king .or. .not. out1file)
+ & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
+ & ' absolute rank',MyRank,
+ & ' lim_odl',lim_odl,' link_start=',link_start_homo,
+ & ' link_end',link_end_homo,' lim_dih',lim_dih,
+ & ' idihconstr_start_homo',idihconstr_start_homo,
+ & ' idihconstr_end_homo',idihconstr_end_homo
+#else
+ link_start_homo=1
+ link_end_homo=lim_odl
+ idihconstr_start_homo=nnt
+ idihconstr_end_homo=lim_dih
+ write (iout,*)
+ & ' lim_odl',lim_odl,' link_start=',link_start_homo,
+ & ' link_end',link_end_homo,' lim_dih',lim_dih,
+ & ' idihconstr_start_homo',idihconstr_start_homo,
+ & ' idihconstr_end_homo',idihconstr_end_homo
+#endif
+ return
+ end
INTEGER IA(maxconf),IB(maxconf)
INTEGER ICLASS(maxconf,maxconf-1),HVALS(maxconf-1)
INTEGER IORDER(maxconf-1),HEIGHT(maxconf-1)
- integer nn,ndis
- real*4 DISNN
+ integer nn,ndis,scount_buf
+ real*4 DISNN, diss_buf(maxdist)
DIMENSION NN(maxconf),DISNN(maxconf)
LOGICAL FLAG(maxconf)
integer i,j,k,l,m,n,len,lev,idum,ii,ind,ioffset,jj,icut,ncon,
- & it,ncon_work,ind1
+ & it,ncon_work,ind1,kkk, ijk
double precision t1,t2,tcpu,difconf
double precision varia(maxvar)
ndis=ncon_work*(ncon_work-1)/2
call work_partition(.true.,ndis)
#endif
-
+ write(iout,*) "AFTET wort_part",NCON_work
DO I=1,NCON_work
ICC(I)=I
ENDDO
C CALCULATE DISTANCES
C
call daread_ccoords(1,ncon_work)
+ write (iout,*) "AM I HERE"
+ call flush(iout)
ind1=0
DO I=1,NCON_work-1
if (mod(i,100).eq.0) print *,'Calculating RMS i=',i
c(l,k)=allcart(l,k,i)
enddo
enddo
+ kkk=1
do k=1,nres
do l=1,3
- cref(l,k)=c(l,k)
+ cref(l,k,kkk)=c(l,k)
enddo
enddo
DO J=I+1,NCON_work
t1=tcpu()
PRINT '(a)','End of distance computation'
+ scount_buf=scount(me)
+
+ do ijk=1, ndis
+ diss_buf(ijk)=diss(ijk)
+ enddo
+
+
#ifdef MPI
- call MPI_Gatherv(diss(1),scount(me),MPI_REAL,diss(1),
+ WRITE (iout,*) "Wchodze do call MPI_Gatherv"
+ call MPI_Gatherv(diss_buf(1),scount_buf,MPI_REAL,diss(1),
& scount(0),idispl(0),MPI_REAL,Master,MPI_COMM_WORLD, IERROR)
if (me.eq.master) then
#endif
C
close(icbase,status="delete")
#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,IERROR)
+ call MPI_Finalize(IERROR)
#endif
stop '********** Program terminated normally.'
20 write (iout,*) "Error reading coordinates"
#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,IERROR)
+ call MPI_Finalize(IERROR)
#endif
stop
30 write (iout,*) "Error reading reference structure"
#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,IERROR)
+ call MPI_Finalize(IERROR)
#endif
stop
end
ibezperm=(run-1)*chalen+i
do j=1,3
xx(j,ii)=allcart(j,iaperm,jcon)
- yy(j,ii)=cref(j,ibezperm)
+ yy(j,ii)=cref(j,ibezperm,kkk)
enddo
enddo
enddo
ii=ii+1
do j=1,3
xx(j,ii)=allcart(j,iaperm+nres,jcon)
- yy(j,ii)=cref(j,ibezperm+nres)
+ yy(j,ii)=cref(j,ibezperm+nres,kkk)
enddo
enddo
c endif
enddo
enddo
enddo
- call fitsq(rms,c(1,nstart),cref(1,nstart),nend-nstart+1,przes,
+ call fitsq(rms,c(1,nstart),cref(1,nstart,kkk),nend-nstart+1,
+ & przes,
& obrot,non_conv)
endif
if (rms.lt.0.0) then
include 'COMMON.SCCOR'
include 'COMMON.SCROT'
character*1 t1,t2,t3
- character*1 onelett(4) /"G","A","P","D"/
+ character*1 onelett(-2:2) /"p","a","G","A","P"/
logical lprint
dimension blower(3,3,maxlob)
double precision ip,mp
vblinv=1.0D0/vbl
vblinv2=vblinv*vblinv
#ifdef CRYST_BOND
- read (ibond,*) vbldp0,akp
- do i=1,ntyp
+ read (ibond,*) vbldp0,vbldpdum,akp
+ do i=1,ntyp
nbondterm(i)=1
read (ibond,*) vbldsc0(1,i),aksc(1,i)
dsc(i) = vbldsc0(1,i)
endif
enddo
#else
- read (ibond,*) ijunk,vbldp0,akp,rjunk
+ read (ibond,*) ijunk,vbldp0,vbldpdum,akp,rjunk
do i=1,ntyp
read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i),
& j=1,nbondterm(i))
enddo
enddo
endif
+ 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,*) a0thet(i),(athet(j,i),j=1,2),(bthet(j,i),j=1,2)
+ read (ithep,*) a0thet(i),(athet(j,i,1,1),j=1,2),
+ & (bthet(j,i,1,1),j=1,2)
read (ithep,*) (polthet(j,i),j=0,3)
read (ithep,*) (gthet(j,i),j=1,3)
read (ithep,*) 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
c write (iout,'(a)')
& ' 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,*) (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)') res1,res2,res3
- read (ithep,*) aa0thet(i,j,k)
- read (ithep,*)(aathet(l,i,j,k),l=1,ntheterm)
+ enddo
+ do iblock=1,2
+ do i=0,nthetyp
+ do j=-nthetyp,nthetyp
+ do k=-nthetyp,nthetyp
+ read (ithep,'(6a)') res1
+ read (ithep,*) aa0thet(i,j,k,iblock)
+ read (ithep,*)(aathet(l,i,j,k,iblock),l=1,ntheterm)
read (ithep,*)
- & ((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,*)
- & (((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
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 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
bsc(1,i)=0.0D0
read(irotam,*)(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,*) bsc(j,i)
read (irotam,*) (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
read (itorp,*) ntortyp
read (itorp,*) (itortyp(i),i=1,ntyp)
write (iout,*) 'ntortyp',ntortyp
- do i=1,ntortyp
- do j=1,ntortyp
- read (itorp,*) nterm(i,j),nlor(i,j)
+ do iblock=1,2
+ do i=-ntyp,-1
+ itortyp(i)=-itortyp(-i)
+ enddo
+c write (iout,*) 'ntortyp',ntortyp
+ do i=0,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ read (itorp,*) 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,*) 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,*) 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
enddo
- do k=1,nlor(i,j)
- read (itorp,*) kk,vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j)
+ do k=1,nlor(i,j,iblock)
+ read (itorp,*) kk,vlor1(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 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)
+ 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
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)') t1,t2,t3
if (t1.ne.onelett(i) .or. t2.ne.onelett(j)
& .or. t3.ne.onelett(k)) then
& i,j,k,t1,t2,t3
stop "Error in double torsional parameter file"
endif
- read (itordp,*) ntermd_1(i,j,k),ntermd_2(i,j,k)
- read (itordp,*) (v1c(1,l,i,j,k),l=1,ntermd_1(i,j,k))
- read (itordp,*) (v1s(1,l,i,j,k),l=1,ntermd_1(i,j,k))
- read (itordp,*) (v1c(2,l,i,j,k),l=1,ntermd_1(i,j,k))
- read (itordp,*) (v1s(2,l,i,j,k),l=1,ntermd_1(i,j,k))
- read (itordp,*) ((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,*) 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,*) (v1c(1,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+ read (itordp,*) (v1s(1,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+ read (itordp,*) (v1c(2,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+ read (itordp,*) (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,*) ((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,*) '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
C interaction energy of the Gly, Ala, and Pro prototypes.
C
read (ifourier,*) nloctyp
- do i=1,nloctyp
+ do i=0,nloctyp-1
read (ifourier,*)
read (ifourier,*) (b(ii,i),ii=1,13)
if (lprint) then
endif
B1(1,i) = b(3,i)
B1(2,i) = b(5,i)
+ B1(1,-i) = b(3,i)
+ B1(2,-i) = -b(5,i)
B1tilde(1,i) = b(3,i)
B1tilde(2,i) =-b(5,i)
+ B1tilde(1,-i) =-b(3,i)
+ B1tilde(2,-i) =b(5,i)
B2(1,i) = b(2,i)
B2(2,i) = b(4,i)
+ B2(1,-i) =b(2,i)
+ B2(2,-i) =-b(4,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)
+ 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)
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)
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)
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)
EE(1,1,i)= b(10,i)+b(11,i)
EE(2,2,i)=-b(10,i)+b(11,i)
EE(2,1,i)= b(12,i)-b(13,i)
EE(1,2,i)= b(12,i)+b(13,i)
+ EE(1,1,-i)= b(10,i)+b(11,i)
+ EE(2,2,-i)=-b(10,i)+b(11,i)
+ EE(2,1,-i)=-b(12,i)+b(13,i)
+ EE(1,2,-i)=-b(12,i)-b(13,i)
enddo
if (lprint) then
do i=1,nloctyp
endif
goto 50
C---------------------- GB or BP potential -----------------------------
- 30 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp),
- & (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip0(i),i=1,ntyp),
- & (alp(i),i=1,ntyp)
+ 30 do i=1,ntyp
+ read (isidep,*)(eps(i,j),j=i,ntyp)
+ enddo
+ read (isidep,*)(sigma0(i),i=1,ntyp)
+ read (isidep,*)(sigii(i),i=1,ntyp)
+ read (isidep,*)(chip0(i),i=1,ntyp)
+ read (isidep,*)(alp(i),i=1,ntyp)
C For the GB potential convert sigma'**2 into chi'
+ do i=1,ntyp
+ read (isidep,*)(epslip(i,j),j=i,ntyp)
+C write(iout,*) "WARNING!!",i,ntyp
+ write(iout,*) "epslip", i, (epslip(i,j),j=i,ntyp)
+C do j=1,ntyp
+C epslip(i,j)=epslip(i,j)+0.05d0
+C enddo
+ enddo
if (ipot.eq.4) then
do i=1,ntyp
chip(i)=(chip0(i)-1.0D0)/(chip0(i)+1.0D0)
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
do i=1,ntyp
do j=i,ntyp
epsij=eps(i,j)
+ epsijlip=epslip(i,j)
if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then
rrij=sigma(i,j)
else
r0(j,i)=rrij
rrij=rrij**expon
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)
- if (ipot.gt.2) then
+ sigeps=dsign(1.0D0,epsij)
+ epsij=dabs(epsij)
+ 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)
+ 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
sigii1=sigii(i)
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 constants of the disulfide bridge
C
- ebr=-5.50D0
+C ebr=-5.50D0
c
c Old arbitrary potential - commented out.
c
c energy surface of diethyl disulfide.
c A. Liwo and U. Kozlowska, 11/24/03
c
- D0CM = 3.78d0
- AKCM = 15.1d0
- AKTH = 11.0d0
- AKCT = 12.0d0
- V1SS =-1.08d0
- V2SS = 7.61d0
- V3SS = 13.7d0
+C D0CM = 3.78d0
+C AKCM = 15.1d0
+C AKTH = 11.0d0
+C AKCT = 12.0d0
+C V1SS =-1.08d0
+C V2SS = 7.61d0
+C V3SS = 13.7d0
- write (iout,'(/a)') "Disulfide bridge parameters:"
- write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr
- write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm
- write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct
- write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss,
- & ' v3ss:',v3ss
+C write (iout,'(/a)') "Disulfide bridge parameters:"
+C write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr
+C write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm
+C write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct
+C write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss,
+C & ' v3ss:',v3ss
return
end
character*80 bxname
character*2 licz1
character*5 ctemper
- integer ilen
+ integer ilen,ijk
external ilen
- real*4 Fdimless(maxconf)
- double precision energia(0:max_ene)
+ real*4 Fdimless(maxconf), Fdimless_buf(maxconf)
+ double precision energia(0:max_ene), totfree_buf(0:maxconf),
+ & entfac_buf(maxconf)
do i=1,ncon
list_conf(i)=i
enddo
write (iout,*) me," indstart",indstart(me)," indend",indend(me)
call daread_ccoords(indstart(me),indend(me))
#endif
-c write (iout,*) "ncon",ncon
+C write (iout,*) "ncon",ncon
+C call flush(iout)
temper=1.0d0/(beta_h(ib)*1.987D-3)
c write (iout,*) "ib",ib," beta_h",beta_h(ib)," temper",temper
c quot=1.0d0/(T0*beta_h(ib)*1.987D-3)
c kfacl=kfacl*kfac
c fT(l)=kfacl/(kfacl-1.0d0+quotl)
c enddo
+C#define DEBUG
if (rescale_mode.eq.1) then
quot=1.0d0/(T0*beta_h(ib)*1.987D-3)
quotl=1.0d0
fT(l)=1.12692801104297249644d0/
& dlog(dexp(quotl)+dexp(-quotl))
enddo
-c write (iout,*) 1.0d0/(beta_h(ib)*1.987D-3),ft
-c call flush(iout)
+ write (iout,*) 1.0d0/(beta_h(ib)*1.987D-3),ft
+ call flush(iout)
#if defined(FUNCTH)
ft(6)=(320.0d0+80.0d0*dtanh((betaT-320.0d0)/80.0d0))/
& 320.0d0
do i=1,ncon
ii=i
#endif
-c write (iout,*) "i",i," ii",ii
-c call flush(iout)
+C write (iout,*) "i",i," ii",ii,"ib",ib,scount(me)
+ call flush(iout)
if (ib.eq.1) then
do j=1,nres
do k=1,3
c(k,j)=allcart(k,j,i)
c(k,j+nres)=allcart(k,j+nres,i)
+C write(iout,*) "coord",i,j,k,allcart(k,j,i),c(k,j),
+C & c(k,j+nres),allcart(k,j+nres,i)
enddo
enddo
+C write(iout,*) "out of j loop"
+C call flush(iout)
do k=1,3
c(k,nres+1)=c(k,1)
c(k,nres+nres)=c(k,nres)
enddo
+C write(iout,*) "after nres+nres",nss_all(i)
+C call flush(iout)
nss=nss_all(i)
do j=1,nss
ihpb(j)=ihpb_all(j,i)
jhpb(j)=jhpb_all(j,i)
enddo
call int_from_cart1(.false.)
+C write(iout,*) "before etotal"
+C call flush(iout)
call etotal(energia(0),fT)
totfree(i)=energia(0)
+ totfree_buf(i)=totfree(i)
c write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
c write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
-c call enerprint(energia(0),fT)
+ call enerprint(energia(0),fT)
c call pdbout(totfree(i),16,i)
+#define DEBUG
#ifdef DEBUG
- write (iout,*) i," energia",(energia(j),j=0,19)
+ write (iout,*) i," energia",(energia(j),j=0,max_ene)
write (iout,*) "etot", etot
write (iout,*) "ft(6)", ft(6)
#endif
+#undef DEBUG
do k=1,max_ene
enetb(k,i)=energia(k)
enddo
write (iout,*) "evdw2", wscp, evdw2
write (iout,*) "welec", ft(1),welec,ees
write (iout,*) "evdw1", wvdwpp,evdw1
- write (iout,*) "ebe" ebe,wang
+ write (iout,*) "ebe", ebe,wang
#endif
Fdimless(i)=beta_h(ib)*etot+entfac(ii)
+ Fdimless_buf(i)=Fdimless(i)
totfree(i)=etot
+ totfree_buf(i)=totfree(i)
#ifdef DEBUG
write (iout,*) "fdim calc", i,ii,ib,
& 1.0d0/(1.987d-3*beta_h(ib)),totfree(i),
& entfac(ii),Fdimless(i)
#endif
enddo ! i
+
+ do ijk=1,maxconf
+ entfac_buf(ijk)=entfac(ijk)
+ Fdimless_buf(ijk)=Fdimless(ijk)
+ enddo
+ do ijk=0,maxconf
+ totfree_buf(ijk)=totfree(ijk)
+ enddo
+
+
+c scount_buf=scount(me)
+c scount_buf2=scount(0)
+
+c entfac_buf(indstart(me)+1)=entfac(indstart(me)+1)
+
#ifdef MPI
- call MPI_Gatherv(Fdimless(1),scount(me),
+ WRITE (iout,*) "Wchodze do call MPI_Gatherv1 (Propabl)"
+ call MPI_Gatherv(Fdimless_buf(1),scount(me),
& MPI_REAL,Fdimless(1),
& scount(0),idispl(0),MPI_REAL,Master,
& MPI_COMM_WORLD, IERROR)
- call MPI_Gatherv(totfree(1),scount(me),
+ WRITE (iout,*) "Wchodze do call MPI_Gatherv2 (Propabl)"
+ call MPI_Gatherv(totfree_buf(1),scount(me),
& MPI_DOUBLE_PRECISION,totfree(1),
& scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master,
& MPI_COMM_WORLD, IERROR)
- call MPI_Gatherv(entfac(indstart(me)+1),scount(me),
+ WRITE (iout,*) "Wchodze do call MPI_Gatherv3 (Propabl)"
+ call MPI_Gatherv(entfac_buf(indstart(me)+1),scount(me),
& MPI_DOUBLE_PRECISION,entfac(1),
& scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master,
& MPI_COMM_WORLD, IERROR)
+ WRITE (iout,*) "Wychodze z call MPI_Gatherv (Propabl)"
if (me.eq.Master) then
+ WRITE (iout,*) "me.eq.Master"
#endif
#ifdef DEBUG
write (iout,*) "The FDIMLESS array before sorting"
c write (iout,*) i,fdimless(i)
enddo
#endif
+ WRITE (iout,*) "Wchodze do call mysort1"
call mysort1(ncon,Fdimless,list_conf)
-#ifdef DEBUG
+ WRITE (iout,*) "Wychodze z call mysort1"
+C#ifdef DEBUG
write (iout,*) "The FDIMLESS array after sorting"
do i=1,ncon
write (iout,*) i,list_conf(i),fdimless(i)
enddo
-#endif
+c#endif
+ WRITE (iout,*) "Wchodze do petli i=1,ncon totfree(i)=fdimless(i)"
do i=1,ncon
totfree(i)=fdimless(i)
enddo
write (iout,*) "ncon", ncon,maxstr_proc
do i=1,min0(ncon,maxstr_proc)-1
sumprob=sumprob+exp(-fdimless(i)+fdimless(1))/qfree
-#ifdef DEBUG
+C#ifdef DEBUG
+ write (iout,*) "tu szukaj ponizej 7"
write (iout,*) i,ib,beta_h(ib),
& 1.0d0/(1.987d-3*beta_h(ib)),list_conf(i),
& totfree(list_conf(i)),
& -entfac(list_conf(i)),fdimless(i),sumprob
-#endif
+C#endif
if (sumprob.gt.prob_limit) goto 122
c if (sumprob.gt.1.00d0) goto 122
nlist=nlist+1
#endif
endif
-#define DEBUG
+C#define DEBUG
#ifdef DEBUG
write (iout,*) "Opening file ",intinname(:ilen(intinname))
write (iout,*) "lenrec",lenrec_in
call flush(iout)
#endif
-#undef DEBUG
+C#undef DEBUG
c write (iout,*) "maxconf",maxconf
i=0
do while (.true.)
call xdrfint_(ixdrf, nss, iret)
if (iret.eq.0) goto 101
do j=1,nss
+ if (dyn_ss) then
+ call xdrfint(ixdrf, idssb(j), iret)
+ call xdrfint(ixdrf, jdssb(j), iret)
+ idssb(j)=idssb(j)-nres
+ jdssb(j)=jdssb(j)-nres
+ else
call xdrfint_(ixdrf, ihpb(j), iret)
if (iret.eq.0) goto 101
call xdrfint_(ixdrf, jhpb(j), iret)
if (iret.eq.0) goto 101
+ endif
enddo
call xdrffloat_(ixdrf,reini,iret)
if (iret.eq.0) goto 101
call flush(iout)
if (iret.eq.0) goto 101
do k=1,nss
+ if (dyn_ss) then
+ call xdrfint(ixdrf, idssb(k), iret)
+ call xdrfint(ixdrf, jdssb(k), iret)
+ else
call xdrfint(ixdrf, ihpb(k), iret)
if (iret.eq.0) goto 101
call xdrfint(ixdrf, jhpb(k), iret)
if (iret.eq.0) goto 101
+ endif
enddo
call xdrffloat(ixdrf,reini,iret)
if (iret.eq.0) goto 101
enddo
enddo
endif
+C#define DEBUG
#ifdef DEBUG
write (iout,'(5hREAD ,i5,3f15.4,i10)')
& jj+1,energy(jj+1),entfac(jj+1),
write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
call flush(iout)
#endif
+C#undef DEBUG
call add_new_cconf(jjj,jj,jj_old,icount,Next)
enddo
101 continue
chalen=int((nct-nnt+2)/symetr)
call int_from_cart1(.false.)
do j=nnt+1,nct
- if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) then
+ if ((vbld(j).lt.2.0d0 .or. vbld(j).gt.6.0d0)
+ & .and.(itype(j).ne.ntyp1)) then
if (j.gt.2) then
if (itel(j).ne.0 .and. itel(j-1).ne.0) then
write (iout,*) "Conformation",jjj,jj+1
enddo
do j=nnt,nct
itj=itype(j)
- if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(itj)).gt.2.0d0) then
+ if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(iabs(itj))).gt.5.0d0
+ & .and. itype(j).ne.ntyp1) then
write (iout,*) "Conformation",jjj,jj+1
write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j)
write (iout,*) "The Cartesian geometry is:"
integer i,j,ij,ii,iii
integer len
character*16 form,acc
- character*32 nam
+ character*80 nam
c
c Read conformations off a DA scratchfile.
c
+C#define DEBUG
#ifdef DEBUG
write (iout,*) "DAREAD_COORDS"
write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
write (iout,*) "Reading binary file, record",iii," ii",ii
call flush(iout)
#endif
+ if (dyn_ss) then
+ read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
+ & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
+c & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss),
+ & entfac(ii),rmstb(ii)
+ else
read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
& ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
& nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss),
& entfac(ii),rmstb(ii)
+ endif
#ifdef DEBUG
write (iout,*) ii,iii,ij,entfac(ii)
write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
& jhpb_all(i,ij),i=1,nss)
call flush(iout)
#endif
+C#undef DEBUG
enddo
+ write (iout,*) "just before leave"
+ call flush(iout)
return
end
c------------------------------------------------------------------------------
write (iout,*) "Writing binary file, record",iii," ii",ii
call flush(iout)
#endif
+ if (dyn_ss) then
+ write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
+ & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
+c & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij))
+ & entfac(ii),rmstb(ii)
+ else
write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
& ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
& nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)),
& entfac(ii),rmstb(ii)
+ endif
#ifdef DEBUG
write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),i=nnt+nres,
character*80 card
dimension sccor(3,20)
integer rescode
- call permut(symetr)
+c call permut(symetr)
ibeg=1
+ write(iout,*) 'pdbread'
do
read (ipdbin,'(a80)',end=10) card
if (card(:3).eq.'END') then
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
+ itype(ires_old)=ntyp1
ibeg=2
c write (iout,*) "Chain ended",ires,ishift,ires_old
call sccenter(ires,iii,sccor)
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
nres=ires
do i=2,nres-1
c write (iout,*) i,itype(i)
- if (itype(i).eq.21) then
+ if (itype(i).eq.ntyp1) then
+ if (itype(i+1).eq.ntyp1) 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 do j=1,3
+C 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
+C dc(j,i)=c(j,i)
+C enddo
+ do j=1,3
+ dcj=(c(j,i-2)-c(j,i-3))/2.0
+ c(j,i)=c(j,i-1)+dcj
+ c(j,nres+i)=c(j,i)
+ enddo
+C endif !unres_pdb
+ else !itype(i+1).eq.ntyp1
+ do j=1,3
+ dcj=(c(j,i+3)-c(j,i+2))/2.0
+ c(j,i)=c(j,i+1)-dcj
+ c(j,nres+i)=c(j,i)
+ enddo
+C endif !unres_pdb
+ endif !itype(i+1).eq.ntyp1
+ endif !itype.eq.ntyp1
enddo
C Calculate the CM of the last side chain.
call sccenter(ires,iii,sccor)
nstart_sup=1
if (itype(nres).ne.10) then
nres=nres+1
- itype(nres)=21
+ itype(nres)=ntyp1
do j=1,3
- dcj=c(j,nres-2)-c(j,nres-3)
+ dcj=(c(j,nres-2)-c(j,nres-3))/2.0
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
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
& ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3),
& (c(j,nres+ires),j=1,3)
enddo
+ call int_from_cart1(.false.)
call int_from_cart(.true.,.false.)
+ call sc_loc_geom(.true.)
+ write (iout,*) "After int_from_cart"
+ call flush(iout)
do i=1,nres-1
do j=1,3
dc(j,i)=c(j,i+1)-c(j,i)
c write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3),
c & vbld_inv(i+nres)
enddo
+ do i=1,nres
+ thetaref(i)=theta(i)
+ phiref(i)=phi(i)
+c
+ phi_ref(i)=phi(i)
+ theta_ref(i)=theta(i)
+ alph_ref(i)=alph(i)
+ omeg_ref(i)=omeg(i)
+ enddo
+
c call chainbuild
C Copy the coordinates to reference coordinates
- do i=1,2*nres
+c do i=1,2*nres
+c do j=1,3
+c cref(j,i)=c(j,i)
+c enddo
+c enddo
+
+ kkk=1
+ lll=0
+ cou=1
+ do i=1,nres
+ lll=lll+1
+cc write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
+ if (i.gt.1) 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)
+ lll=1
+ endif
+ endif
do j=1,3
- cref(j,i)=c(j,i)
+ cref(j,i,cou)=c(j,i)
+ cref(j,i+nres,cou)=c(j,i+nres)
+ if (i.le.nres) then
+ chain_rep(j,lll,kkk)=c(j,i)
+ chain_rep(j,lll+nres,kkk)=c(j,i+nres)
+ endif
+ enddo
+ enddo
+ do j=1,3
+ chain_rep(j,chain_length,symetr)=chain_rep(j,chain_length,1)
+ chain_rep(j,chain_length+nres,symetr)
+ &=chain_rep(j,chain_length+nres,1)
+ enddo
+
+ if (symetr.gt.1) then
+ call permut(symetr)
+ nperm=1
+ do i=1,symetr
+ nperm=nperm*i
+ enddo
+c do i=1,nperm
+c write(iout,*) "tabperm", (tabperm(i,kkk),kkk=1,4)
+c enddo
+ do i=1,nperm
+ cou=0
+ do kkk=1,symetr
+ icha=tabperm(i,kkk)
+c write (iout,*) i,icha
+ do lll=1,chain_length
+ cou=cou+1
+ if (cou.le.nres) then
+ do j=1,3
+ kupa=mod(lll,chain_length)
+ iprzes=(kkk-1)*chain_length+lll
+ if (kupa.eq.0) kupa=chain_length
+c write (iout,*) "kupa", kupa
+ cref(j,iprzes,i)=chain_rep(j,kupa,icha)
+ cref(j,iprzes+nres,i)=chain_rep(j,kupa+nres,icha)
+ enddo
+ endif
+ enddo
enddo
+ enddo
+ endif
+
+C-koniec robienia kopidm
+ nperm=0
+ do kkk=1,nperm
+ write (iout,*) "nowa struktura", nperm
+ do i=1,nres
+ write (iout,110) restyp(itype(i)),i,cref(1,i,kkk),
+ &cref(2,i,kkk),
+ &cref(3,i,kkk),cref(1,nres+i,kkk),
+ &cref(2,nres+i,kkk),cref(3,nres+i,kkk)
enddo
+ 100 format (//' alpha-carbon coordinates ',
+ & ' centroid coordinates'/
+ 1 ' ', 6X,'X',11X,'Y',11X,'Z',
+ & 10X,'X',11X,'Y',11X,'Z')
+ 110 format (a,'(',i3,')',6f12.5)
+ enddo
+
ishift_pdb=ishift
return
do i=nnt+1,nct
iti=itype(i)
c write (iout,*) i,dist(i,i-1)
- if (dist(i,i-1).lt.2.0D0 .or. dist(i,i-1).gt.5.0D0) then
+ if ((dist(i,i-1).lt.2.0D0 .or. dist(i,i-1).gt.5.0D0)
+ &.and.(iti.ne.ntyp1).and.(itype(i-1).ne.ntyp1)) then
write (iout,'(a,i4)') 'Bad Cartesians for residue',i
stop
endif
endif
return
end
+
+c-------------------------------------------------------------------------------
+ subroutine sc_loc_geom(lprn)
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.LOCAL'
+ include 'COMMON.VAR'
+ include 'COMMON.CHAIN'
+ include 'COMMON.INTERACT'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.GEO'
+ include 'COMMON.NAMES'
+ include 'COMMON.CONTROL'
+ include 'COMMON.SETUP'
+ double precision x_prime(3),y_prime(3),z_prime(3)
+ logical lprn
+ do i=1,nres-1
+ do j=1,3
+ dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i))
+ enddo
+ enddo
+ do i=2,nres-1
+ 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
+ else
+ do j=1,3
+ dc_norm(j,i+nres)=0.0d0
+ enddo
+ endif
+ enddo
+ do i=2,nres-1
+ costtab(i+1) =dcos(theta(i+1))
+ sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
+ cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
+ sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
+ cosfac2=0.5d0/(1.0d0+costtab(i+1))
+ cosfac=dsqrt(cosfac2)
+ sinfac2=0.5d0/(1.0d0-costtab(i+1))
+ sinfac=dsqrt(sinfac2)
+ it=itype(i)
+ if (it.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
+c
+ do j=1,3
+ x_prime(j) = 0.00
+ y_prime(j) = 0.00
+ z_prime(j) = 0.00
+ enddo
+ do j = 1,3
+ x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
+ y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
+ enddo
+ call vecpr(x_prime,y_prime,z_prime)
+c
+C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
+C to local coordinate system. Store in xx, yy, zz.
+c
+ xx=0.0d0
+ yy=0.0d0
+ zz=0.0d0
+ do j = 1,3
+ xx = xx + x_prime(j)*dc_norm(j,i+nres)
+ yy = yy + y_prime(j)*dc_norm(j,i+nres)
+ zz = zz + z_prime(j)*dc_norm(j,i+nres)
+ enddo
+
+ xxref(i)=xx
+ yyref(i)=yy
+ zzref(i)=zz
+ else
+ xxref(i)=0.0d0
+ yyref(i)=0.0d0
+ zzref(i)=0.0d0
+ endif
+ enddo
+ if (lprn) then
+ do i=2,nres
+ iti=itype(i)
+ if(me.eq.king.or..not.out1file)
+ & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i),
+ & yyref(i),zzref(i)
+ enddo
+ endif
+ return
+ end
c---------------------------------------------------------------------------
subroutine sccenter(ires,nscat,sccor)
implicit real*8 (a-h,o-z)
include 'COMMON.FFIELD'
include 'COMMON.FREE'
include 'COMMON.INTERACT'
+ include "COMMON.SPLITELE"
+ include 'COMMON.SHIELD'
character*320 controlcard,ucase
#ifdef MPL
include 'COMMON.INFO'
#endif
- integer i
-
+ integer i,i1,i2,it1,it2
+ double precision pi
read (INP,'(a80)') titel
call card_concat(controlcard)
call readi(controlcard,'RESCALE',rescale_mode,2)
call reada(controlcard,'DISTCHAINMAX',distchainmax,50.0d0)
write (iout,*) "DISTCHAINMAX",distchainmax
+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
+C Shielding mode
+ call readi(controlcard,'SHIELD',shield_mode,0)
+ write (iout,*) "SHIELD MODE",shield_mode
+ if (shield_mode.gt.0) then
+ pi=3.141592d0
+C VSolvSphere the volume of solving sphere
+C print *,pi,"pi"
+C rpp(1,1) is the energy r0 for peptide group contact and will be used for it
+C there will be no distinction between proline peptide group and normal peptide
+C group in case of shielding parameters
+ VSolvSphere=4.0/3.0*pi*rpp(1,1)**3
+ VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(rpp(1,1)/2.0)**3
+ write (iout,*) VSolvSphere,VSolvSphere_div
+C long axis of side chain
+ do i=1,ntyp
+ long_r_sidechain(i)=vbldsc0(1,i)
+ short_r_sidechain(i)=sigma0(i)
+ enddo
+ buff_shield=1.0d0
+ endif
call readi(controlcard,'PDBOUT',outpdb,0)
call readi(controlcard,'MOL2OUT',outmol2,0)
refstr=(index(controlcard,'REFSTR').gt.0)
pdbref=(index(controlcard,'PDBREF').gt.0)
iscode=index(controlcard,'ONE_LETTER')
tree=(index(controlcard,'MAKE_TREE').gt.0)
+ with_dihed_constr = index(controlcard,"WITH_DIHED_CONSTR").gt.0
+ call readi(controlcard,'CONSTR_DIST',constr_dist,0)
+ write (iout,*) "with_dihed_constr ",with_dihed_constr,
+ & " CONSTR_DIST",constr_dist
+ with_theta_constr = index(controlcard,"WITH_THETA_CONSTR").gt.0
+ write (iout,*) "with_theta_constr ",with_theta_constr
+ call flush(iout)
min_var=(index(controlcard,'MINVAR').gt.0)
plot_tree=(index(controlcard,'PLOT_TREE').gt.0)
punch_dist=(index(controlcard,'PUNCH_DIST').gt.0)
write (iout,*) 'beta_h',(beta_h(i),i=1,nT)
lprint_cart=index(controlcard,"PRINT_CART") .gt.0
lprint_int=index(controlcard,"PRINT_INT") .gt.0
+ call readi(controlcard,'CONSTR_HOMOL',constr_homology,0)
+ write (iout,*) "with_homology_constr ",with_dihed_constr,
+ & " CONSTR_HOMOLOGY",constr_homology
+ print_homology_restraints=
+ & index(controlcard,"PRINT_HOMOLOGY_RESTRAINTS").gt.0
+ print_contact_map=index(controlcard,"PRINT_CONTACT_MAP").gt.0
+ print_homology_models=
+ & index(controlcard,"PRINT_HOMOLOGY_MODELS").gt.0
if (min_var) iopt=1
return
end
include 'COMMON.CONTROL'
include 'COMMON.CONTACTS'
include 'COMMON.TIME1'
+ include 'COMMON.TORCNSTR'
+ include 'COMMON.SHIELD'
#ifdef MPL
include 'COMMON.INFO'
#endif
double precision x(maxvar)
integer itype_pdb(maxres)
logical seq_comp
- integer i,j
+ integer i,j,kkk,i1,i2,it1,it2
C
C Body
C
C Read weights of the subsequent energy terms.
call card_concat(weightcard)
- call reada(weightcard,'WSC',wsc,1.0d0)
+ write(iout,*) weightcard
+C call reada(weightcard,'WSC',wsc,1.0d0)
+ write(iout,*) wsc
call reada(weightcard,'WLONG',wsc,wsc)
call reada(weightcard,'WSCP',wscp,1.0d0)
call reada(weightcard,'WELEC',welec,1.0D0)
call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0)
call reada(weightcard,'DELT_CORR',delt_corr,0.5d0)
if (index(weightcard,'SOFT').gt.0) ipot=6
+ call reada(weightcard,"D0CM",d0cm,3.78d0)
+ call reada(weightcard,"AKCM",akcm,15.1d0)
+ call reada(weightcard,"AKTH",akth,11.0d0)
+ call reada(weightcard,"AKCT",akct,12.0d0)
+ call reada(weightcard,"V1SS",v1ss,-1.08d0)
+ call reada(weightcard,"V2SS",v2ss,7.61d0)
+ call reada(weightcard,"V3SS",v3ss,13.7d0)
+ call reada(weightcard,"EBR",ebr,-5.50D0)
+ call reada(weightcard,'WSHIELD',wshield,1.0d0)
+ write(iout,*) 'WSHIELD',wshield
+ call reada(weightcard,'WLT',wliptran,0.0D0)
+ call reada(weightcard,"ATRISS",atriss,0.301D0)
+ call reada(weightcard,"BTRISS",btriss,0.021D0)
+ call reada(weightcard,"CTRISS",ctriss,1.001D0)
+ call reada(weightcard,"DTRISS",dtriss,1.001D0)
+ write (iout,*) "ATRISS=", atriss
+ write (iout,*) "BTRISS=", btriss
+ write (iout,*) "CTRISS=", ctriss
+ write (iout,*) "DTRISS=", dtriss
+ dyn_ss=(index(weightcard,'DYN_SS').gt.0)
+ do i=1,maxres
+ dyn_ss_mask(i)=.false.
+ enddo
+ do i=1,maxres-1
+ do j=i+1,maxres
+ dyn_ssbond_ij(i,j)=1.0d300
+ enddo
+ enddo
+ call reada(weightcard,"HT",Ht,0.0D0)
+ if (dyn_ss) then
+ ss_depth=ebr/wsc-0.25*eps(1,1)
+ Ht=Ht/wsc-0.25*eps(1,1)
+ akcm=akcm*wstrain/wsc
+ akth=akth*wstrain/wsc
+ akct=akct*wstrain/wsc
+ v1ss=v1ss*wstrain/wsc
+ v2ss=v2ss*wstrain/wsc
+ v3ss=v3ss*wstrain/wsc
+ else
+ ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain
+ endif
+ write (iout,'(/a)') "Disulfide bridge parameters:"
+ write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr
+ write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm
+ write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct
+ write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss,
+ & ' v3ss:',v3ss
+
C 12/1/95 Added weight for the multi-body term WCORR
call reada(weightcard,'WCORRH',wcorr,1.0D0)
if (wcorr4.gt.0.0d0) wcorr=wcorr4
do i=1,nres
itype(i)=rescode(i,sequence(i),iscode)
enddo
- if (itype(2).eq.10.and.itype(1).eq.ntyp1) then
- write (iout,*)
- & "Glycine is the first full residue, initial dummy deleted"
- do i=1,nres
- itype(i)=itype(i+1)
- enddo
- nres=nres-1
- endif
- if (itype(nres-1).eq.10.and.itype(nres).eq.ntyp1) then
- write (iout,*)
- & "Glycine is the last full residue, terminal dummy deleted"
- nres=nres-1
- endif
print *,nres
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
print *,'Call Read_Bridge.'
call read_bridge
+C this fragment reads diheadral constrains
+ if (with_dihed_constr) then
+
+ read (inp,*) ndih_constr
+ if (ndih_constr.gt.0) then
+C read (inp,*) ftors
+C write (iout,*) 'FTORS',ftors
+C ftors is the force constant for torsional quartic constrains
+ read (inp,*) (idih_constr(i),phi0(i),drange(i),ftors(i),
+ & i=1,ndih_constr)
+ write (iout,*)
+ & 'There are',ndih_constr,' constraints on phi angles.'
+ do i=1,ndih_constr
+ write (iout,'(i5,3f8.3)') idih_constr(i),phi0(i),drange(i),
+ & ftors(i)
+ enddo
+ do i=1,ndih_constr
+ phi0(i)=deg2rad*phi0(i)
+ drange(i)=deg2rad*drange(i)
+ enddo
+ endif ! endif ndif_constr.gt.0
+ endif ! with_dihed_constr
+ if (with_theta_constr) then
+C with_theta_constr is keyword allowing for occurance of theta constrains
+ read (inp,*) ntheta_constr
+C ntheta_constr is the number of theta constrains
+ if (ntheta_constr.gt.0) then
+C read (inp,*) ftors
+ read (inp,*) (itheta_constr(i),theta_constr0(i),
+ & theta_drange(i),for_thet_constr(i),
+ & i=1,ntheta_constr)
+C the above code reads from 1 to ntheta_constr
+C itheta_constr(i) residue i for which is theta_constr
+C theta_constr0 the global minimum value
+C theta_drange is range for which there is no energy penalty
+C for_thet_constr is the force constant for quartic energy penalty
+C E=k*x**4
+C if(me.eq.king.or..not.out1file)then
+ write (iout,*)
+ & 'There are',ntheta_constr,' constraints on phi angles.'
+ do i=1,ntheta_constr
+ write (iout,'(i5,3f8.3)') itheta_constr(i),theta_constr0(i),
+ & theta_drange(i),
+ & for_thet_constr(i)
+ enddo
+C endif
+ do i=1,ntheta_constr
+ theta_constr0(i)=deg2rad*theta_constr0(i)
+ theta_drange(i)=deg2rad*theta_drange(i)
+ enddo
+C if(me.eq.king.or..not.out1file)
+C & write (iout,*) 'FTORS',ftors
+C do i=1,ntheta_constr
+C ii = itheta_constr(i)
+C thetabound(1,ii) = phi0(i)-drange(i)
+C thetabound(2,ii) = phi0(i)+drange(i)
+C enddo
+ endif ! ntheta_constr.gt.0
+ endif! with_theta_constr
+
nnt=1
nct=nres
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 (nstart.lt.nnt) nstart=nnt
if (nend.gt.nct .or. nend.eq.0) nend=nct
write (iout,*) "nstart",nstart," nend",nend
nres0=nres
+ if (constr_homology.gt.0) then
+ call read_constr_homology(print_homology_restraints)
+ endif
+
c if (pdbref) then
c read(inp,'(a)') pdbfile
c write (iout,'(2a)') 'PDB data will be read from file ',pdbfile
nstart_sup=nnt
nstart_seq=nnt
nsup=nct-nnt+1
+ kkk=1
do i=1,2*nres
do j=1,3
- cref(j,i)=c(j,i)
+ cref(j,i,kkk)=c(j,i)
enddo
enddo
endif
call contact(.true.,ncont_ref,icont_ref)
endif
+ if (ns.gt.0) then
+C write (iout,'(/a,i3,a)')
+C & 'The chain contains',ns,' disulfide-bridging cysteines.'
+ write (iout,'(20i4)') (iss(i),i=1,ns)
+ if (dyn_ss) then
+ write(iout,*)"Running with dynamic disulfide-bond formation"
+ else
+ write (iout,'(/a/)') 'Pre-formed links are:'
+ do i=1,nss
+ i1=ihpb(i)-nres
+ i2=jhpb(i)-nres
+ it1=itype(i1)
+ it2=itype(i2)
+ write (iout,'(2a,i3,3a,i3,a,3f10.3)')
+ & restyp(it1),'(',i1,') -- ',restyp(it2),'(',i2,')',dhpb(i),
+ & ebr,forcon(i)
+ enddo
+ write (iout,'(a)')
+ endif
+ endif
+ if (ns.gt.0.and.dyn_ss) then
+ do i=nss+1,nhpb
+ ihpb(i-nss)=ihpb(i)
+ jhpb(i-nss)=jhpb(i)
+ forcon(i-nss)=forcon(i)
+ dhpb(i-nss)=dhpb(i)
+ enddo
+ nhpb=nhpb-nss
+ nss=0
+ call hpb_partition
+ do i=1,ns
+ dyn_ss_mask(iss(i))=.true.
+ enddo
+ endif
+c Read distance restraints
+ if (constr_dist.gt.0) then
+ call read_dist_constr
+ call hpb_partition
+ endif
return
end
c-----------------------------------------------------------------------------
do i=1,ns
if (itype(iss(i)).ne.1) then
write (iout,'(2a,i3,a)')
- & 'Do you REALLY think that the residue ',restyp(iss(i)),i,
+ & 'Do you REALLY think that the residue ',
+ & restyp(itype(iss(i))),i,
& ' can form a disulfide bridge?!!!'
write (*,'(2a,i3,a)')
- & 'Do you REALLY think that the residue ',restyp(iss(i)),i,
+ & 'Do you REALLY think that the residue ',
+ & restyp(itype(iss(i))),i,
& ' can form a disulfide bridge?!!!'
#ifdef MPL
call mp_stopall(error_msg)
enddo
write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.'
20 continue
- dhpb(i)=dbr
- forcon(i)=fbr
+C dhpb(i)=dbr
+C forcon(i)=fbr
enddo
do i=1,nss
ihpb(i)=ihpb(i)+nres
read (rekord(iread:),*) wartosc
return
end
+C----------------------------------------------------------------------
+ subroutine multreadi(rekord,lancuch,tablica,dim,default)
+ implicit none
+ integer dim,i
+ integer tablica(dim),default
+ character*(*) rekord,lancuch
+ character*80 aux
+ integer ilen,iread
+ external ilen
+ do i=1,dim
+ tablica(i)=default
+ enddo
+ iread=index(rekord,lancuch(:ilen(lancuch))//"=")
+ if (iread.eq.0) return
+ iread=iread+ilen(lancuch)+1
+ read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
+ 10 return
+ end
+
c----------------------------------------------------------------------------
subroutine card_concat(card)
include 'DIMENSIONS'
open (isidep1,file=sidepname,status="old")
call getenv('SCCORPAR',sccorname)
open (isccor,file=sccorname,status="old")
+ call getenv('LIPTRANPAR',liptranname)
+ open (iliptranpar,file=liptranname,status='old')
#ifndef OLDSCP
C
C 8/9/01 In the newest version SCp interaction constants are read from a file
#endif
return
end
+ subroutine read_dist_constr
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+#ifdef MPI
+ include 'mpif.h'
+#endif
+ include 'COMMON.CONTROL'
+ include 'COMMON.CHAIN'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.SBRIDGE'
+ integer ifrag_(2,100),ipair_(2,100)
+ double precision wfrag_(100),wpair_(100)
+ character*500 controlcard
+ logical lprn /.true./
+ write (iout,*) "Calling read_dist_constr"
+C write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup
+C call flush(iout)
+ write(iout,*) "TU sie wywalam?"
+ call card_concat(controlcard)
+ write (iout,*) controlcard
+ call flush(iout)
+ call readi(controlcard,"NFRAG",nfrag_,0)
+ call readi(controlcard,"NPAIR",npair_,0)
+ call readi(controlcard,"NDIST",ndist_,0)
+ call reada(controlcard,'DIST_CUT',dist_cut,5.0d0)
+ call multreadi(controlcard,"IFRAG",ifrag_(1,1),2*nfrag_,0)
+ call multreadi(controlcard,"IPAIR",ipair_(1,1),2*npair_,0)
+ call multreada(controlcard,"WFRAG",wfrag_(1),nfrag_,0.0d0)
+ call multreada(controlcard,"WPAIR",wpair_(1),npair_,0.0d0)
+ write (iout,*) "NFRAG",nfrag_," NPAIR",npair_," NDIST",ndist_
+ write (iout,*) "IFRAG"
+ do i=1,nfrag_
+ write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
+ enddo
+ write (iout,*) "IPAIR"
+ do i=1,npair_
+ write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i)
+ enddo
+ call flush(iout)
+ do i=1,nfrag_
+ if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup
+ if (ifrag_(2,i).gt.nstart_sup+nsup-1)
+ & ifrag_(2,i)=nstart_sup+nsup-1
+c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
+ call flush(iout)
+ if (wfrag_(i).gt.0.0d0) then
+ do j=ifrag_(1,i),ifrag_(2,i)-1
+ do k=j+1,ifrag_(2,i)
+ write (iout,*) "j",j," k",k
+ ddjk=dist(j,k)
+ if (constr_dist.eq.1) then
+ nhpb=nhpb+1
+ ihpb(nhpb)=j
+ jhpb(nhpb)=k
+ dhpb(nhpb)=ddjk
+ forcon(nhpb)=wfrag_(i)
+ else if (constr_dist.eq.2) then
+ if (ddjk.le.dist_cut) then
+ nhpb=nhpb+1
+ ihpb(nhpb)=j
+ jhpb(nhpb)=k
+ dhpb(nhpb)=ddjk
+ forcon(nhpb)=wfrag_(i)
+ endif
+ else
+ nhpb=nhpb+1
+ ihpb(nhpb)=j
+ jhpb(nhpb)=k
+ dhpb(nhpb)=ddjk
+ forcon(nhpb)=wfrag_(i)*dexp(-0.5d0*(ddjk/dist_cut)**2)
+ endif
+ if (lprn)
+ & write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ",
+ & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
+ enddo
+ enddo
+ endif
+ enddo
+ do i=1,npair_
+ if (wpair_(i).gt.0.0d0) then
+ ii = ipair_(1,i)
+ jj = ipair_(2,i)
+ if (ii.gt.jj) then
+ itemp=ii
+ ii=jj
+ jj=itemp
+ endif
+ do j=ifrag_(1,ii),ifrag_(2,ii)
+ do k=ifrag_(1,jj),ifrag_(2,jj)
+ nhpb=nhpb+1
+ ihpb(nhpb)=j
+ jhpb(nhpb)=k
+ forcon(nhpb)=wpair_(i)
+ dhpb(nhpb)=dist(j,k)
+ write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
+ & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
+ enddo
+ enddo
+ endif
+ enddo
+ do i=1,ndist_
+ if (constr_dist.eq.11) then
+ read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i),
+ & ibecarb(i),forcon(nhpb+1),fordepth(nhpb+1)
+ fordepth(nhpb+1)=fordepth(nhpb+1)/forcon(nhpb+1)
+C write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
+C & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
+ else
+ read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1)
+ endif
+ if (forcon(nhpb+1).gt.0.0d0) then
+ nhpb=nhpb+1
+ if (ibecarb(i).gt.0) then
+ ihpb(i)=ihpb(i)+nres
+ jhpb(i)=jhpb(i)+nres
+ endif
+ if (dhpb(nhpb).eq.0.0d0)
+ & dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
+C dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
+ write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
+ & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
+ endif
+C endif
+ enddo
+ call hpb_partition
+#ifdef AIX
+ call flush_(iout)
+#else
+ call flush(iout)
+#endif
+ return
+ end
+
+c====-------------------------------------------------------------------
+ subroutine read_constr_homology(lprn)
+
+ include 'DIMENSIONS'
+#ifdef MPI
+ include 'mpif.h'
+#endif
+ include 'COMMON.SETUP'
+ include 'COMMON.CONTROL'
+ include 'COMMON.CHAIN'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.GEO'
+ include 'COMMON.INTERACT'
+ include 'COMMON.HOMRESTR'
+c
+c For new homol impl
+c
+ include 'COMMON.VAR'
+c include 'include_unres/COMMON.VAR'
+c
+
+c double precision odl_temp,sigma_odl_temp,waga_theta,waga_d,
+c & dist_cut
+c common /przechowalnia/ odl_temp(maxres,maxres,max_template),
+c & sigma_odl_temp(maxres,maxres,max_template)
+ character*2 kic2
+ character*24 model_ki_dist, model_ki_angle
+ character*500 controlcard
+ integer ki, i, j, k, l, ii_in_use(maxdim),i_tmp,idomain_tmp
+ integer idomain(max_template,maxres)
+ integer ilen
+ external ilen
+ logical lprn
+ logical unres_pdb
+c
+c FP - Nov. 2014 Temporary specifications for new vars
+c
+ double precision rescore_tmp,x12,y12,z12,rescore2_tmp
+ double precision, dimension (max_template,maxres) :: rescore
+ double precision, dimension (max_template,maxres) :: rescore2
+ character*24 tpl_k_rescore
+c -----------------------------------------------------------------
+c Reading multiple PDB ref structures and calculation of retraints
+c not using pre-computed ones stored in files model_ki_{dist,angle}
+c FP (Nov., 2014)
+c -----------------------------------------------------------------
+c
+c
+c Alternative: reading from input
+#ifdef DEBUG
+ write (iout,*) "BEGIN READ HOMOLOGY INFO"
+#ifdef AIX
+ call flush_(iout)
+#else
+ call flush(iout)
+#endif
+#endif
+ call card_concat(controlcard)
+ call reada(controlcard,"HOMOL_DIST",waga_dist,1.0d0)
+ call reada(controlcard,"HOMOL_ANGLE",waga_angle,1.0d0)
+ call reada(controlcard,"HOMOL_THETA",waga_theta,1.0d0) ! new
+ call reada(controlcard,"HOMOL_SCD",waga_d,1.0d0) ! new
+ call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) ! for diff ways of calc sigma
+ call reada(controlcard,'DIST2_CUT',dist2_cut,9999.0d0)
+ call readi(controlcard,"HOMOL_NSET",homol_nset,1)
+ read2sigma=(index(controlcard,'READ2SIGMA').gt.0)
+ if (homol_nset.gt.1)then
+ call readi(controlcard,"ISET",iset,1)
+ call card_concat(controlcard)
+ read(controlcard,*) (waga_homology(i),i=1,homol_nset)
+ else
+ iset=1
+ waga_homology(1)=1.0
+ endif
+c
+#ifdef DEBUG
+ write(iout,*) "read_constr_homology iset",iset
+ write(iout,*) "waga_homology(",iset,")",waga_homology(iset)
+#ifdef AIX
+ call flush_(iout)
+#else
+ call flush(iout)
+#endif
+#endif
+cd write (iout,*) "nnt",nnt," nct",nct
+cd call flush(iout)
+
+
+ lim_odl=0
+ lim_dih=0
+c
+c New
+c
+ lim_theta=0
+ lim_xx=0
+c
+c Reading HM global scores (prob not required)
+c
+ do i = nnt,nct
+ do k=1,constr_homology
+ idomain(k,i)=0
+ enddo
+ enddo
+c open (4,file="HMscore")
+c do k=1,constr_homology
+c read (4,*,end=521) hmscore_tmp
+c hmscore(k)=hmscore_tmp ! Another transformation can be used
+c write(*,*) "Model", k, ":", hmscore(k)
+c enddo
+c521 continue
+
+ ii=0
+ do i = nnt,nct-2
+ do j=i+2,nct
+ ii=ii+1
+ ii_in_use(ii)=0
+ enddo
+ enddo
+c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
+
+ write (iout,*) "CONSTR_HOMOLOGY",constr_homology
+ do k=1,constr_homology
+
+ read(inp,'(a)') pdbfile
+c write (iout,*) "k ",k," pdbfile ",pdbfile
+c Next stament causes error upon compilation (?)
+c if(me.eq.king.or. .not. out1file)
+c write (iout,'(2a)') 'PDB data will be read from file ',
+c & pdbfile(:ilen(pdbfile))
+ write (iout,'(a,5x,a)') 'HOMOL: Opening PDB file',
+ & pdbfile(:ilen(pdbfile))
+ open(ipdbin,file=pdbfile,status='old',err=33)
+ goto 34
+ 33 write (iout,'(a,5x,a)') 'Error opening PDB file',
+ & pdbfile(:ilen(pdbfile))
+ stop
+ 34 continue
+c print *,'Begin reading pdb data'
+c
+c Files containing res sim or local scores (former containing sigmas)
+c
+
+ write(kic2,'(bz,i2.2)') k
+
+ tpl_k_rescore="template"//kic2//".sco"
+
+ unres_pdb=.false.
+ call readpdb
+ do i=1,2*nres
+ do j=1,3
+ crefjlee(j,i)=c(j,i)
+ enddo
+ enddo
+#ifdef DEBUG
+ do i=1,nres
+ write (iout,'(i5,3f8.3,5x,3f8.3)') i,(crefjlee(j,i),j=1,3),
+ & (crefjlee(j,i+nres),j=1,3)
+ enddo
+ write (iout,*) "READ HOMOLOGY INFO"
+ write (iout,*) "read_constr_homology x: after reading pdb file"
+ write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
+ write (iout,*) "waga_dist",waga_dist
+ write (iout,*) "waga_angle",waga_angle
+ write (iout,*) "waga_theta",waga_theta
+ write (iout,*) "waga_d",waga_d
+ write (iout,*) "dist_cut",dist_cut
+#endif
+#ifdef AIX
+ call flush_(iout)
+#else
+ call flush(iout)
+#endif
+
+c
+c Distance restraints
+c
+c ... --> odl(k,ii)
+C Copy the coordinates from reference coordinates (?)
+ do i=1,2*nres
+ do j=1,3
+c c(j,i)=cref(j,i)
+c write (iout,*) "c(",j,i,") =",c(j,i)
+ enddo
+ enddo
+c
+c From read_dist_constr (commented out 25/11/2014 <-> res sim)
+c
+c write(iout,*) "tpl_k_rescore - ",tpl_k_rescore
+ open (ientin,file=tpl_k_rescore,status='old')
+ if (nnt.gt.1) rescore(k,1)=0.0d0
+ do irec=nnt,maxdim ! loop for reading res sim
+ if (read2sigma) then
+ read (ientin,*,end=1401) i_tmp,rescore2_tmp,rescore_tmp,
+ & idomain_tmp
+ i_tmp=i_tmp+nnt-1
+ idomain(k,i_tmp)=idomain_tmp
+ rescore(k,i_tmp)=rescore_tmp
+ rescore2(k,i_tmp)=rescore2_tmp
+ else
+ idomain(k,irec)=1
+ read (ientin,*,end=1401) rescore_tmp
+
+c rescore(k,irec)=rescore_tmp+1.0d0 ! to avoid 0 values
+ rescore(k,irec)=0.5d0*(rescore_tmp+0.5d0) ! alt transf to reduce scores
+c write(iout,*) "rescore(",k,irec,") =",rescore(k,irec)
+ endif
+ enddo
+ 1401 continue
+ close (ientin)
+ if (waga_dist.ne.0.0d0) then
+ ii=0
+ do i = nnt,nct-2
+ do j=i+2,nct
+
+ x12=c(1,i)-c(1,j)
+ y12=c(2,i)-c(2,j)
+ z12=c(3,i)-c(3,j)
+ distal=dsqrt(x12*x12+y12*y12+z12*z12)
+c write (iout,*) k,i,j,distal,dist2_cut
+
+ if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0
+ & .and. distal.le.dist2_cut ) then
+
+ ii=ii+1
+ ii_in_use(ii)=1
+ l_homo(k,ii)=.true.
+
+c write (iout,*) "k",k
+c write (iout,*) "i",i," j",j," constr_homology",
+c & constr_homology
+ ires_homo(ii)=i
+ jres_homo(ii)=j
+ odl(k,ii)=distal
+ if (read2sigma) then
+ sigma_odl(k,ii)=0
+ do ik=i,j
+ sigma_odl(k,ii)=sigma_odl(k,ii)+rescore2(k,ik)
+ enddo
+ sigma_odl(k,ii)=sigma_odl(k,ii)/(j-i+1)
+ if (odl(k,ii).gt.dist_cut) sigma_odl(k,ii) =
+ & sigma_odl(k,ii)*dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0)
+ else
+ if (odl(k,ii).le.dist_cut) then
+ sigma_odl(k,ii)=rescore(k,i)+rescore(k,j)
+ else
+#ifdef OLDSIGMA
+ sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))*
+ & dexp(0.5d0*(odl(k,ii)/dist_cut)**2)
+#else
+ sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))*
+ & dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0)
+#endif
+ endif
+ endif
+ sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii))
+ else
+ ii=ii+1
+ l_homo(k,ii)=.false.
+ endif
+ enddo
+ enddo
+ lim_odl=ii
+ endif
+c
+c Theta, dihedral and SC retraints
+c
+ if (waga_angle.gt.0.0d0) then
+c open (ientin,file=tpl_k_sigma_dih,status='old')
+c do irec=1,maxres-3 ! loop for reading sigma_dih
+c read (ientin,*,end=1402) i,j,ki,l,sigma_dih(k,i+nnt-1) ! j,ki,l what for?
+c if (i+nnt-1.gt.lim_dih) lim_dih=i+nnt-1 ! right?
+c sigma_dih(k,i+nnt-1)=sigma_dih(k,i+nnt-1)* ! not inverse because of use of res. similarity
+c & sigma_dih(k,i+nnt-1)
+c enddo
+c1402 continue
+c close (ientin)
+ do i = nnt+3,nct
+ if (idomain(k,i).eq.0) then
+ sigma_dih(k,i)=0.0
+ cycle
+ endif
+ dih(k,i)=phiref(i) ! right?
+c read (ientin,*) sigma_dih(k,i) ! original variant
+c write (iout,*) "dih(",k,i,") =",dih(k,i)
+c write(iout,*) "rescore(",k,i,") =",rescore(k,i),
+c & "rescore(",k,i-1,") =",rescore(k,i-1),
+c & "rescore(",k,i-2,") =",rescore(k,i-2),
+c & "rescore(",k,i-3,") =",rescore(k,i-3)
+
+ sigma_dih(k,i)=(rescore(k,i)+rescore(k,i-1)+
+ & rescore(k,i-2)+rescore(k,i-3))/4.0
+c if (read2sigma) sigma_dih(k,i)=sigma_dih(k,i)/4.0
+c write (iout,*) "Raw sigmas for dihedral angle restraints"
+c write (iout,'(i5,10(2f8.2,4x))') i,sigma_dih(k,i)
+c sigma_dih(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)*
+c rescore(k,i-2)*rescore(k,i-3) ! right expression ?
+c Instead of res sim other local measure of b/b str reliability possible
+ sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i))
+c sigma_dih(k,i)=sigma_dih(k,i)*sigma_dih(k,i)
+ enddo
+ lim_dih=nct-nnt-2
+ endif
+
+ if (waga_theta.gt.0.0d0) then
+c open (ientin,file=tpl_k_sigma_theta,status='old')
+c do irec=1,maxres-2 ! loop for reading sigma_theta, right bounds?
+c read (ientin,*,end=1403) i,j,ki,sigma_theta(k,i+nnt-1) ! j,ki what for?
+c sigma_theta(k,i+nnt-1)=sigma_theta(k,i+nnt-1)* ! not inverse because of use of res. similarity
+c & sigma_theta(k,i+nnt-1)
+c enddo
+c1403 continue
+c close (ientin)
+
+ do i = nnt+2,nct ! right? without parallel.
+c do i = i=1,nres ! alternative for bounds acc to readpdb?
+c do i=ithet_start,ithet_end ! with FG parallel.
+ if (idomain(k,i).eq.0) then
+ sigma_theta(k,i)=0.0
+ cycle
+ endif
+ thetatpl(k,i)=thetaref(i)
+c write (iout,*) "thetatpl(",k,i,") =",thetatpl(k,i)
+c write(iout,*) "rescore(",k,i,") =",rescore(k,i),
+c & "rescore(",k,i-1,") =",rescore(k,i-1),
+c & "rescore(",k,i-2,") =",rescore(k,i-2)
+c read (ientin,*) sigma_theta(k,i) ! 1st variant
+ sigma_theta(k,i)=(rescore(k,i)+rescore(k,i-1)+
+ & rescore(k,i-2))/3.0
+c if (read2sigma) sigma_theta(k,i)=sigma_theta(k,i)/3.0
+ sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i))
+
+c sigma_theta(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)*
+c rescore(k,i-2) ! right expression ?
+c sigma_theta(k,i)=sigma_theta(k,i)*sigma_theta(k,i)
+ enddo
+ endif
+ lim_theta=nct-nnt-1
+
+ if (waga_d.gt.0.0d0) then
+c open (ientin,file=tpl_k_sigma_d,status='old')
+c do irec=1,maxres-1 ! loop for reading sigma_theta, right bounds?
+c read (ientin,*,end=1404) i,j,sigma_d(k,i+nnt-1) ! j,ki what for?
+c sigma_d(k,i+nnt-1)=sigma_d(k,i+nnt-1)* ! not inverse because of use of res. similarity
+c & sigma_d(k,i+nnt-1)
+c enddo
+c1404 continue
+
+ do i = nnt,nct ! right? without parallel.
+c do i=2,nres-1 ! alternative for bounds acc to readpdb?
+c do i=loc_start,loc_end ! with FG parallel.
+ if (itype(i).eq.10) cycle
+ if (idomain(k,i).eq.0 ) then
+ sigma_d(k,i)=0.0
+ cycle
+ endif
+ xxtpl(k,i)=xxref(i)
+ yytpl(k,i)=yyref(i)
+ zztpl(k,i)=zzref(i)
+c write (iout,*) "xxtpl(",k,i,") =",xxtpl(k,i)
+c write (iout,*) "yytpl(",k,i,") =",yytpl(k,i)
+c write (iout,*) "zztpl(",k,i,") =",zztpl(k,i)
+c write(iout,*) "rescore(",k,i,") =",rescore(k,i)
+ sigma_d(k,i)=rescore(k,i) ! right expression ?
+ sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i))
+
+c sigma_d(k,i)=hmscore(k)*rescore(k,i) ! right expression ?
+c sigma_d(k,i)=sigma_d(k,i)*sigma_d(k,i)
+c read (ientin,*) sigma_d(k,i) ! 1st variant
+ if (i-nnt+1.gt.lim_xx) lim_xx=i-nnt+1 ! right?
+ enddo
+ lim_xx=nct-nnt+1
+ endif
+ enddo
+c
+c remove distance restraints not used in any model from the list
+c shift data in all arrays
+c
+ if (waga_dist.ne.0.0d0) then
+ ii=0
+ do i=nnt,nct-2
+ do j=i+2,nct
+ ii=ii+1
+ if (ii_in_use(ii).eq.0) then
+ do ki=ii,lim_odl-1
+ ires_homo(ki)=ires_homo(ki+1)
+ jres_homo(ki)=jres_homo(ki+1)
+ ii_in_use(ki)=ii_in_use(ki+1)
+ do k=1,constr_homology
+ odl(k,ki)=odl(k,ki+1)
+ sigma_odl(k,ki)=sigma_odl(k,ki+1)
+ l_homo(k,ki)=l_homo(k,ki+1)
+ enddo
+ enddo
+ ii=ii-1
+ lim_odl=lim_odl-1
+ endif
+ enddo
+ enddo
+ endif
+ if (constr_homology.gt.0) call homology_partition
+ if (constr_homology.gt.0) call init_int_table
+cd write (iout,*) "homology_partition: lim_theta= ",lim_theta,
+cd & "lim_xx=",lim_xx
+c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
+c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
+c
+c Print restraints
+c
+ if (.not.lprn) return
+cd write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
+ if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
+ write (iout,*) "Distance restraints from templates"
+ do ii=1,lim_odl
+ write(iout,'(3i5,100(2f8.2,1x,l1,4x))')
+ & ii,ires_homo(ii),jres_homo(ii),
+ & (odl(ki,ii),1.0d0/dsqrt(sigma_odl(ki,ii)),l_homo(ki,ii),
+ & ki=1,constr_homology)
+ enddo
+ write (iout,*) "Dihedral angle restraints from templates"
+ do i=nnt+3,lim_dih
+ write (iout,'(i5,100(2f8.2,4x))') i,(rad2deg*dih(ki,i),
+ & rad2deg/dsqrt(sigma_dih(ki,i)),ki=1,constr_homology)
+ enddo
+ write (iout,*) "Virtual-bond angle restraints from templates"
+ do i=nnt+2,lim_theta
+ write (iout,'(i5,100(2f8.2,4x))') i,(rad2deg*thetatpl(ki,i),
+ & rad2deg/dsqrt(sigma_theta(ki,i)),ki=1,constr_homology)
+ enddo
+ write (iout,*) "SC restraints from templates"
+ do i=nnt,lim_xx
+ write(iout,'(i5,100(4f8.2,4x))') i,
+ & (xxtpl(ki,i),yytpl(ki,i),zztpl(ki,i),
+ & 1.0d0/dsqrt(sigma_d(ki,i)),ki=1,constr_homology)
+ enddo
+ endif
+c -----------------------------------------------------------------
+ return
+ end
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
--- /dev/null
+c----------------------------------------------------------------------------
+ subroutine check_energies
+c implicit none
+
+c Includes
+ include 'DIMENSIONS'
+ include 'COMMON.CHAIN'
+ include 'COMMON.VAR'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.SBRIDGE'
+ include 'COMMON.LOCAL'
+ include 'COMMON.GEO'
+
+c External functions
+ double precision ran_number
+ external ran_number
+
+c Local variables
+ integer i,j,k,l,lmax,p,pmax
+ double precision rmin,rmax
+ double precision eij
+
+ double precision d
+ double precision wi,rij,tj,pj
+
+
+c return
+
+ i=5
+ j=14
+
+ d=dsc(1)
+ rmin=2.0D0
+ rmax=12.0D0
+
+ lmax=10000
+ pmax=1
+
+ do k=1,3
+ c(k,i)=0.0D0
+ c(k,j)=0.0D0
+ c(k,nres+i)=0.0D0
+ c(k,nres+j)=0.0D0
+ enddo
+
+ do l=1,lmax
+
+ct wi=ran_number(0.0D0,pi)
+c wi=ran_number(0.0D0,pi/6.0D0)
+c wi=0.0D0
+ct tj=ran_number(0.0D0,pi)
+ct pj=ran_number(0.0D0,pi)
+c pj=ran_number(0.0D0,pi/6.0D0)
+c pj=0.0D0
+
+ do p=1,pmax
+ct rij=ran_number(rmin,rmax)
+
+ c(1,j)=d*sin(pj)*cos(tj)
+ c(2,j)=d*sin(pj)*sin(tj)
+ c(3,j)=d*cos(pj)
+
+ c(3,nres+i)=-rij
+
+ c(1,i)=d*sin(wi)
+ c(3,i)=-rij-d*cos(wi)
+
+ do k=1,3
+ dc(k,nres+i)=c(k,nres+i)-c(k,i)
+ dc_norm(k,nres+i)=dc(k,nres+i)/d
+ dc(k,nres+j)=c(k,nres+j)-c(k,j)
+ dc_norm(k,nres+j)=dc(k,nres+j)/d
+ enddo
+
+ call dyn_ssbond_ene(i,j,eij)
+ enddo
+ enddo
+
+ call exit(1)
+
+ return
+ end
+
+C-----------------------------------------------------------------------------
+
+ subroutine dyn_ssbond_ene(resi,resj,eij)
+c implicit none
+
+c Includes
+ include 'DIMENSIONS'
+ include 'COMMON.SBRIDGE'
+ include 'COMMON.CHAIN'
+ include 'COMMON.DERIV'
+ include 'COMMON.LOCAL'
+ include 'COMMON.INTERACT'
+ include 'COMMON.VAR'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.CALC'
+#ifndef CLUST
+#ifndef WHAM
+C include 'COMMON.MD'
+#endif
+#endif
+
+c External functions
+ double precision h_base
+ external h_base
+
+c Input arguments
+ integer resi,resj
+
+c Output arguments
+ double precision eij
+
+c Local variables
+ logical havebond
+c integer itypi,itypj,k,l
+ double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
+ double precision sig0ij,ljd,sig,fac,e1,e2
+ double precision dcosom1(3),dcosom2(3),ed
+ double precision pom1,pom2
+ double precision ljA,ljB,ljXs
+ double precision d_ljB(1:3)
+ double precision ssA,ssB,ssC,ssXs
+ double precision ssxm,ljxm,ssm,ljm
+ double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
+ double precision f1,f2,h1,h2,hd1,hd2
+ double precision omega,delta_inv,deltasq_inv,fac1,fac2
+c-------FIRST METHOD
+ double precision xm,d_xm(1:3)
+c-------END FIRST METHOD
+c-------SECOND METHOD
+c$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
+c-------END SECOND METHOD
+
+c-------TESTING CODE
+ logical checkstop,transgrad
+ common /sschecks/ checkstop,transgrad
+
+ integer icheck,nicheck,jcheck,njcheck
+ double precision echeck(-1:1),deps,ssx0,ljx0
+c-------END TESTING CODE
+
+
+ i=resi
+ j=resj
+
+ itypi=itype(i)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+ dsci_inv=vbld_inv(i+nres)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ xi=dmod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=dmod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=dmod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
+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)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ xj=dmod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=dmod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=dmod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.gt.bordlipbot)
+ &.and.(zj.lt.bordliptop)) then
+C the energy transfer exist
+ if (zj.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((positi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipj=1.0d0
+ ssgradlipj=0.0
+ endif
+ else
+ sslipj=0.0d0
+ ssgradlipj=0.0
+ endif
+ 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
+
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ dscj_inv=vbld_inv(j+nres)
+
+ chi1=chi(itypi,itypj)
+ chi2=chi(itypj,itypi)
+ chi12=chi1*chi2
+ chip1=chip(itypi)
+ chip2=chip(itypj)
+ chip12=chip1*chip2
+ alf1=alp(itypi)
+ alf2=alp(itypj)
+ alf12=0.5D0*(alf1+alf2)
+
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
+c The following are set in sc_angular
+c erij(1)=xj*rij
+c erij(2)=yj*rij
+c erij(3)=zj*rij
+c om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
+c om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
+c om12=dxi*dxj+dyi*dyj+dzi*dzj
+ call sc_angular
+ rij=1.0D0/rij ! Reset this so it makes sense
+
+ sig0ij=sigma(itypi,itypj)
+ sig=sig0ij*dsqrt(1.0D0/sigsq)
+
+ ljXs=sig-sig0ij
+ ljA=eps1*eps2rt**2*eps3rt**2
+ ljB=ljA*bb
+ ljA=ljA*aa
+ ljxm=ljXs+(-2.0D0*aa/bb)**(1.0D0/6.0D0)
+
+ ssXs=d0cm
+ deltat1=1.0d0-om1
+ deltat2=1.0d0+om2
+ deltat12=om2-om1+2.0d0
+ cosphi=om12-om1*om2
+ ssA=akcm
+ ssB=akct*deltat12
+ ssC=ss_depth
+ & +akth*(deltat1*deltat1+deltat2*deltat2)
+ & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
+ ssxm=ssXs-0.5D0*ssB/ssA
+
+c-------TESTING CODE
+c$$$c Some extra output
+c$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
+c$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
+c$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
+c$$$ if (ssx0.gt.0.0d0) then
+c$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
+c$$$ else
+c$$$ ssx0=ssxm
+c$$$ endif
+c$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+c$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
+c$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
+c$$$ return
+c-------END TESTING CODE
+
+c-------TESTING CODE
+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/aa
+ if (ssm.lt.ljm .and.
+ & dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
+ nicheck=1000
+ njcheck=1
+ deps=0.5d-7
+ else
+ checkstop=.false.
+ endif
+ endif
+ if (.not.checkstop) then
+ nicheck=0
+ njcheck=-1
+ endif
+
+ do icheck=0,nicheck
+ do jcheck=-1,njcheck
+ if (checkstop) rij=(ssxm-1.0d0)+
+ & ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
+c-------END TESTING CODE
+
+ if (rij.gt.ljxm) then
+ havebond=.false.
+ ljd=rij-ljXs
+ fac=(1.0D0/ljd)**expon
+ e1=fac*fac*aa
+ e2=fac*bb
+ eij=eps1*eps2rt*eps3rt*(e1+e2)
+C write(iout,*) eij,'TU?1'
+ eps2der=eij*eps3rt
+ eps3der=eij*eps2rt
+ eij=eij*eps2rt*eps3rt
+
+ sigder=-sig/sigsq
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ ed=-expon*(e1+eij)/ljd
+ sigder=ed*sigder
+ 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
+ & -2.0D0*alf12*eps3der+sigder*sigsq_om12
+ else if (rij.lt.ssxm) then
+ havebond=.true.
+ ssd=rij-ssXs
+ eij=ssA*ssd*ssd+ssB*ssd+ssC
+C write(iout,*) 'TU?2',ssc,ssd
+ ed=2*akcm*ssd+akct*deltat12
+ pom1=akct*ssd
+ pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
+ eom1=-2*akth*deltat1-pom1-om2*pom2
+ eom2= 2*akth*deltat2+pom1-om1*pom2
+ eom12=pom2
+ else
+ omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
+
+ d_ssxm(1)=0.5D0*akct/ssA
+ d_ssxm(2)=-d_ssxm(1)
+ d_ssxm(3)=0.0D0
+
+ d_ljxm(1)=sig0ij/sqrt(sigsq**3)
+ d_ljxm(2)=d_ljxm(1)*sigsq_om2
+ d_ljxm(3)=d_ljxm(1)*sigsq_om12
+ d_ljxm(1)=d_ljxm(1)*sigsq_om1
+
+c-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
+ xm=0.5d0*(ssxm+ljxm)
+ do k=1,3
+ d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
+ enddo
+ if (rij.lt.xm) then
+ havebond=.true.
+ ssm=ssC-0.25D0*ssB*ssB/ssA
+ d_ssm(1)=0.5D0*akct*ssB/ssA
+ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
+ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
+ d_ssm(3)=omega
+ f1=(rij-xm)/(ssxm-xm)
+ f2=(rij-ssxm)/(xm-ssxm)
+ h1=h_base(f1,hd1)
+ h2=h_base(f2,hd2)
+ eij=ssm*h1+Ht*h2
+C write(iout,*) eij,'TU?3'
+ delta_inv=1.0d0/(xm-ssxm)
+ deltasq_inv=delta_inv*delta_inv
+ fac=ssm*hd1-Ht*hd2
+ fac1=deltasq_inv*fac*(xm-rij)
+ fac2=deltasq_inv*fac*(rij-ssxm)
+ ed=delta_inv*(Ht*hd2-ssm*hd1)
+ 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/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)
+ d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
+ f1=(rij-ljxm)/(xm-ljxm)
+ f2=(rij-xm)/(ljxm-xm)
+ h1=h_base(f1,hd1)
+ h2=h_base(f2,hd2)
+ eij=Ht*h1+ljm*h2
+C write(iout,*) 'TU?4',ssA
+ delta_inv=1.0d0/(ljxm-xm)
+ deltasq_inv=delta_inv*delta_inv
+ fac=Ht*hd1-ljm*hd2
+ fac1=deltasq_inv*fac*(ljxm-rij)
+ fac2=deltasq_inv*fac*(rij-xm)
+ ed=delta_inv*(ljm*hd2-Ht*hd1)
+ 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)
+ endif
+c-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
+
+c-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
+c$$$ ssd=rij-ssXs
+c$$$ ljd=rij-ljXs
+c$$$ fac1=rij-ljxm
+c$$$ fac2=rij-ssxm
+c$$$
+c$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
+c$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
+c$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
+c$$$
+c$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
+c$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
+c$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
+c$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
+c$$$ d_ssm(3)=omega
+c$$$
+c$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
+c$$$ do k=1,3
+c$$$ d_ljm(k)=ljm*d_ljB(k)
+c$$$ enddo
+c$$$ ljm=ljm*ljB
+c$$$
+c$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
+c$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
+c$$$ d_ss(2)=akct*ssd
+c$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
+c$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
+c$$$ d_ss(3)=omega
+c$$$
+c$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
+c$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
+c$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
+c$$$ do k=1,3
+c$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
+c$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
+c$$$ enddo
+c$$$ ljf=ljm+ljf*ljB*fac1*fac1
+c$$$
+c$$$ f1=(rij-ljxm)/(ssxm-ljxm)
+c$$$ f2=(rij-ssxm)/(ljxm-ssxm)
+c$$$ h1=h_base(f1,hd1)
+c$$$ h2=h_base(f2,hd2)
+c$$$ eij=ss*h1+ljf*h2
+c$$$ delta_inv=1.0d0/(ljxm-ssxm)
+c$$$ deltasq_inv=delta_inv*delta_inv
+c$$$ fac=ljf*hd2-ss*hd1
+c$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
+c$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
+c$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
+c$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
+c$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
+c$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
+c$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
+c$$$
+c$$$ havebond=.false.
+c$$$ if (ed.gt.0.0d0) havebond=.true.
+c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
+
+ endif
+C write(iout,*) 'havebond',havebond
+ if (havebond) then
+#ifndef CLUST
+#ifndef WHAM
+c if (dyn_ssbond_ij(i,j).eq.1.0d300) then
+c write(iout,'(a15,f12.2,f8.1,2i5)')
+c & "SSBOND_E_FORM",totT,t_bath,i,j
+c endif
+#endif
+#endif
+ dyn_ssbond_ij(i,j)=eij
+ else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
+ dyn_ssbond_ij(i,j)=1.0d300
+#ifndef CLUST
+#ifndef WHAM
+c write(iout,'(a15,f12.2,f8.1,2i5)')
+c & "SSBOND_E_BREAK",totT,t_bath,i,j
+#endif
+#endif
+ endif
+
+c-------TESTING CODE
+ if (checkstop) then
+ if (jcheck.eq.0) write(iout,'(a,3f15.8,$)')
+ & "CHECKSTOP",rij,eij,ed
+ echeck(jcheck)=eij
+ endif
+ enddo
+ if (checkstop) then
+ write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
+ endif
+ enddo
+ if (checkstop) then
+ transgrad=.true.
+ checkstop=.false.
+ endif
+c-------END TESTING CODE
+
+ do k=1,3
+ dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
+ dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
+ enddo
+ do k=1,3
+ gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
+ enddo
+ do k=1,3
+ gvdwx(k,i)=gvdwx(k,i)-gg(k)
+ & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
+ & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ gvdwx(k,j)=gvdwx(k,j)+gg(k)
+ & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
+ & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ enddo
+cgrad do k=i,j-1
+cgrad do l=1,3
+cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
+cgrad enddo
+cgrad enddo
+
+ do l=1,3
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ enddo
+
+ return
+ end
+
+C-----------------------------------------------------------------------------
+
+ double precision function h_base(x,deriv)
+c A smooth function going 0->1 in range [0,1]
+c It should NOT be called outside range [0,1], it will not work there.
+ implicit none
+
+c Input arguments
+ double precision x
+
+c Output arguments
+ double precision deriv
+
+c Local variables
+ double precision xsq
+
+
+c Two parabolas put together. First derivative zero at extrema
+c$$$ if (x.lt.0.5D0) then
+c$$$ h_base=2.0D0*x*x
+c$$$ deriv=4.0D0*x
+c$$$ else
+c$$$ deriv=1.0D0-x
+c$$$ h_base=1.0D0-2.0D0*deriv*deriv
+c$$$ deriv=4.0D0*deriv
+c$$$ endif
+
+c Third degree polynomial. First derivative zero at extrema
+ h_base=x*x*(3.0d0-2.0d0*x)
+ deriv=6.0d0*x*(1.0d0-x)
+
+c Fifth degree polynomial. First and second derivatives zero at extrema
+c$$$ xsq=x*x
+c$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
+c$$$ deriv=x-1.0d0
+c$$$ deriv=deriv*deriv
+c$$$ deriv=30.0d0*xsq*deriv
+
+ return
+ end
+
+c----------------------------------------------------------------------------
+
+ subroutine dyn_set_nss
+c Adjust nss and other relevant variables based on dyn_ssbond_ij
+c implicit none
+
+c Includes
+ include 'DIMENSIONS'
+#ifdef MPI
+ include "mpif.h"
+#endif
+ include 'COMMON.SBRIDGE'
+ include 'COMMON.CHAIN'
+ include 'COMMON.IOUNITS'
+C include 'COMMON.SETUP'
+#ifndef CLUST
+#ifndef WHAM
+C include 'COMMON.MD'
+#endif
+#endif
+
+c Local variables
+ double precision emin
+ integer i,j,imin
+ integer diff,allflag(maxdim),allnss,
+ & allihpb(maxdim),alljhpb(maxdim),
+ & newnss,newihpb(maxdim),newjhpb(maxdim)
+ logical found
+ integer i_newnss(1024),displ(0:1024)
+ integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss
+
+ allnss=0
+ do i=1,nres-1
+ do j=i+1,nres
+ if (dyn_ssbond_ij(i,j).lt.1.0d300) then
+ allnss=allnss+1
+ allflag(allnss)=0
+ allihpb(allnss)=i
+ alljhpb(allnss)=j
+ endif
+ enddo
+ enddo
+
+cmc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
+
+ 1 emin=1.0d300
+ do i=1,allnss
+ if (allflag(i).eq.0 .and.
+ & dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
+ emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
+ imin=i
+ endif
+ enddo
+ if (emin.lt.1.0d300) then
+ allflag(imin)=1
+ do i=1,allnss
+ if (allflag(i).eq.0 .and.
+ & (allihpb(i).eq.allihpb(imin) .or.
+ & alljhpb(i).eq.allihpb(imin) .or.
+ & allihpb(i).eq.alljhpb(imin) .or.
+ & alljhpb(i).eq.alljhpb(imin))) then
+ allflag(i)=-1
+ endif
+ enddo
+ goto 1
+ endif
+
+cmc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
+
+ newnss=0
+ do i=1,allnss
+ if (allflag(i).eq.1) then
+ newnss=newnss+1
+ newihpb(newnss)=allihpb(i)
+ newjhpb(newnss)=alljhpb(i)
+ endif
+ enddo
+
+#ifdef MPI
+ if (nfgtasks.gt.1)then
+
+ call MPI_Reduce(newnss,g_newnss,1,
+ & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+ call MPI_Gather(newnss,1,MPI_INTEGER,
+ & i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_newnss(i-1)+displ(i-1)
+ enddo
+ call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,
+ & g_newihpb,i_newnss,displ,MPI_INTEGER,
+ & king,FG_COMM,IERR)
+ call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,
+ & g_newjhpb,i_newnss,displ,MPI_INTEGER,
+ & king,FG_COMM,IERR)
+ if(fg_rank.eq.0) then
+c print *,'g_newnss',g_newnss
+c print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
+c print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
+ newnss=g_newnss
+ do i=1,newnss
+ newihpb(i)=g_newihpb(i)
+ newjhpb(i)=g_newjhpb(i)
+ enddo
+ endif
+ endif
+#endif
+
+ diff=newnss-nss
+
+cmc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
+
+ do i=1,nss
+ found=.false.
+ do j=1,newnss
+ if (idssb(i).eq.newihpb(j) .and.
+ & jdssb(i).eq.newjhpb(j)) found=.true.
+ enddo
+#ifndef CLUST
+#ifndef WHAM
+c if (.not.found.and.fg_rank.eq.0)
+c & write(iout,'(a15,f12.2,f8.1,2i5)')
+c & "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
+#endif
+#endif
+ enddo
+
+ do i=1,newnss
+ found=.false.
+ do j=1,nss
+ if (newihpb(i).eq.idssb(j) .and.
+ & newjhpb(i).eq.jdssb(j)) found=.true.
+ enddo
+#ifndef CLUST
+#ifndef WHAM
+c if (.not.found.and.fg_rank.eq.0)
+c & write(iout,'(a15,f12.2,f8.1,2i5)')
+c & "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
+#endif
+#endif
+ enddo
+
+ nss=newnss
+ do i=1,nss
+ idssb(i)=newihpb(i)
+ jdssb(i)=newjhpb(i)
+ enddo
+
+ return
+ end
+
+
+c$$$c-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine ss_relax(i_in,j_in)
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.INTERACT'
+c$$$
+c$$$c Input arguments
+c$$$ integer i_in,j_in
+c$$$
+c$$$c Local variables
+c$$$ integer i,iretcode,nfun_sc
+c$$$ logical scfail
+c$$$ double precision var(maxvar),e_sc,etot
+c$$$
+c$$$
+c$$$ mask_r=.true.
+c$$$ do i=nnt,nct
+c$$$ mask_side(i)=0
+c$$$ enddo
+c$$$ mask_side(i_in)=1
+c$$$ mask_side(j_in)=1
+c$$$
+c$$$c Minimize the two selected side-chains
+c$$$ call overlap_sc(scfail) ! Better not fail!
+c$$$ call minimize_sc(e_sc,var,iretcode,nfun_sc)
+c$$$
+c$$$ mask_r=.false.
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$c-------------------------------------------------------------
+c$$$
+c$$$ subroutine minimize_sc(etot_sc,iretcode,nfun)
+c$$$c Minimize side-chains only, starting from geom but without modifying
+c$$$c bond lengths.
+c$$$c If mask_r is already set, only the selected side-chains are minimized,
+c$$$c otherwise all side-chains are minimized keeping the backbone frozen.
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.GEO'
+c$$$ include 'COMMON.MINIM'
+c$$$ integer icall
+c$$$ common /srutu/ icall
+c$$$
+c$$$c Output arguments
+c$$$ double precision etot_sc
+c$$$ integer iretcode,nfun
+c$$$
+c$$$c External functions/subroutines
+c$$$ external func_sc,grad_sc,fdum
+c$$$
+c$$$c Local variables
+c$$$ integer liv,lv
+c$$$ parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
+c$$$ integer iv(liv)
+c$$$ double precision rdum(1)
+c$$$ double precision d(maxvar),v(1:lv),x(maxvar),xx(maxvar)
+c$$$ integer idum(1)
+c$$$ integer i,nvar_restr
+c$$$
+c$$$
+c$$$cmc start_minim=.true.
+c$$$ call deflt(2,iv,liv,lv,v)
+c$$$* 12 means fresh start, dont call deflt
+c$$$ iv(1)=12
+c$$$* max num of fun calls
+c$$$ if (maxfun.eq.0) maxfun=500
+c$$$ iv(17)=maxfun
+c$$$* max num of iterations
+c$$$ if (maxmin.eq.0) maxmin=1000
+c$$$ iv(18)=maxmin
+c$$$* controls output
+c$$$ iv(19)=1
+c$$$* selects output unit
+c$$$ iv(21)=0
+c$$$c iv(21)=iout ! DEBUG
+c$$$c iv(21)=8 ! DEBUG
+c$$$* 1 means to print out result
+c$$$ iv(22)=0
+c$$$c iv(22)=1 ! DEBUG
+c$$$* 1 means to print out summary stats
+c$$$ iv(23)=0
+c$$$c iv(23)=1 ! DEBUG
+c$$$* 1 means to print initial x and d
+c$$$ iv(24)=0
+c$$$c iv(24)=1 ! DEBUG
+c$$$* min val for v(radfac) default is 0.1
+c$$$ v(24)=0.1D0
+c$$$* max val for v(radfac) default is 4.0
+c$$$ v(25)=2.0D0
+c$$$c v(25)=4.0D0
+c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
+c$$$* the sumsl default is 0.1
+c$$$ v(26)=0.1D0
+c$$$* false conv if (act fnctn decrease) .lt. v(34)
+c$$$* the sumsl default is 100*machep
+c$$$ v(34)=v(34)/100.0D0
+c$$$* absolute convergence
+c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4
+c$$$ v(31)=tolf
+c$$$* relative convergence
+c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-1
+c$$$ v(32)=rtolf
+c$$$* controls initial step size
+c$$$ v(35)=1.0D-1
+c$$$* large vals of d correspond to small components of step
+c$$$ do i=1,nphi
+c$$$ d(i)=1.0D-1
+c$$$ enddo
+c$$$ do i=nphi+1,nvar
+c$$$ d(i)=1.0D-1
+c$$$ enddo
+c$$$
+c$$$ call geom_to_var(nvar,x)
+c$$$ IF (mask_r) THEN
+c$$$ do i=1,nres ! Just in case...
+c$$$ mask_phi(i)=0
+c$$$ mask_theta(i)=0
+c$$$ enddo
+c$$$ call x2xx(x,xx,nvar_restr)
+c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc,
+c$$$ & iv,liv,lv,v,idum,rdum,fdum)
+c$$$ call xx2x(x,xx)
+c$$$ ELSE
+c$$$c When minimizing ALL side-chains, etotal_sc is a little
+c$$$c faster if we don't set mask_r
+c$$$ do i=1,nres
+c$$$ mask_phi(i)=0
+c$$$ mask_theta(i)=0
+c$$$ mask_side(i)=1
+c$$$ enddo
+c$$$ call x2xx(x,xx,nvar_restr)
+c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc,
+c$$$ & iv,liv,lv,v,idum,rdum,fdum)
+c$$$ call xx2x(x,xx)
+c$$$ ENDIF
+c$$$ call var_to_geom(nvar,x)
+c$$$ call chainbuild_sc
+c$$$ etot_sc=v(10)
+c$$$ iretcode=iv(1)
+c$$$ nfun=iv(6)
+c$$$ return
+c$$$ end
+c$$$
+c$$$C--------------------------------------------------------------------------
+c$$$
+c$$$ subroutine chainbuild_sc
+c$$$ implicit none
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.INTERACT'
+c$$$
+c$$$c Local variables
+c$$$ integer i
+c$$$
+c$$$
+c$$$ do i=nnt,nct
+c$$$ if (.not.mask_r .or. mask_side(i).eq.1) then
+c$$$ call locate_side_chain(i)
+c$$$ endif
+c$$$ enddo
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$C--------------------------------------------------------------------------
+c$$$
+c$$$ subroutine func_sc(n,x,nf,f,uiparm,urparm,ufparm)
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.MINIM'
+c$$$ include 'COMMON.IOUNITS'
+c$$$
+c$$$c Input arguments
+c$$$ integer n
+c$$$ double precision x(maxvar)
+c$$$ double precision ufparm
+c$$$ external ufparm
+c$$$
+c$$$c Input/Output arguments
+c$$$ integer nf
+c$$$ integer uiparm(1)
+c$$$ double precision urparm(1)
+c$$$
+c$$$c Output arguments
+c$$$ double precision f
+c$$$
+c$$$c Local variables
+c$$$ double precision energia(0:n_ene)
+c$$$#ifdef OSF
+c$$$c Variables used to intercept NaNs
+c$$$ double precision x_sum
+c$$$ integer i_NAN
+c$$$#endif
+c$$$
+c$$$
+c$$$ nfl=nf
+c$$$ icg=mod(nf,2)+1
+c$$$
+c$$$#ifdef OSF
+c$$$c Intercept NaNs in the coordinates, before calling etotal_sc
+c$$$ x_sum=0.D0
+c$$$ do i_NAN=1,n
+c$$$ x_sum=x_sum+x(i_NAN)
+c$$$ enddo
+c$$$c Calculate the energy only if the coordinates are ok
+c$$$ if ((.not.(x_sum.lt.0.D0)) .and. (.not.(x_sum.ge.0.D0))) then
+c$$$ write(iout,*)" *** func_restr_sc : Found NaN in coordinates"
+c$$$ f=1.0D+77
+c$$$ nf=0
+c$$$ else
+c$$$#endif
+c$$$
+c$$$ call var_to_geom_restr(n,x)
+c$$$ call zerograd
+c$$$ call chainbuild_sc
+c$$$ call etotal_sc(energia(0))
+c$$$ f=energia(0)
+c$$$ if (energia(1).eq.1.0D20 .or. energia(0).eq.1.0D99) nf=0
+c$$$
+c$$$#ifdef OSF
+c$$$ endif
+c$$$#endif
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$c-------------------------------------------------------
+c$$$
+c$$$ subroutine grad_sc(n,x,nf,g,uiparm,urparm,ufparm)
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.INTERACT'
+c$$$ include 'COMMON.MINIM'
+c$$$
+c$$$c Input arguments
+c$$$ integer n
+c$$$ double precision x(maxvar)
+c$$$ double precision ufparm
+c$$$ external ufparm
+c$$$
+c$$$c Input/Output arguments
+c$$$ integer nf
+c$$$ integer uiparm(1)
+c$$$ double precision urparm(1)
+c$$$
+c$$$c Output arguments
+c$$$ double precision g(maxvar)
+c$$$
+c$$$c Local variables
+c$$$ double precision f,gphii,gthetai,galphai,gomegai
+c$$$ integer ig,ind,i,j,k,igall,ij
+c$$$
+c$$$
+c$$$ icg=mod(nf,2)+1
+c$$$ if (nf-nfl+1) 20,30,40
+c$$$ 20 call func_sc(n,x,nf,f,uiparm,urparm,ufparm)
+c$$$c write (iout,*) 'grad 20'
+c$$$ if (nf.eq.0) return
+c$$$ goto 40
+c$$$ 30 call var_to_geom_restr(n,x)
+c$$$ call chainbuild_sc
+c$$$C
+c$$$C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
+c$$$C
+c$$$ 40 call cartder
+c$$$C
+c$$$C Convert the Cartesian gradient into internal-coordinate gradient.
+c$$$C
+c$$$
+c$$$ ig=0
+c$$$ ind=nres-2
+c$$$ do i=2,nres-2
+c$$$ IF (mask_phi(i+2).eq.1) THEN
+c$$$ gphii=0.0D0
+c$$$ do j=i+1,nres-1
+c$$$ ind=ind+1
+c$$$ do k=1,3
+c$$$ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
+c$$$ gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
+c$$$ enddo
+c$$$ enddo
+c$$$ ig=ig+1
+c$$$ g(ig)=gphii
+c$$$ ELSE
+c$$$ ind=ind+nres-1-i
+c$$$ ENDIF
+c$$$ enddo
+c$$$
+c$$$
+c$$$ ind=0
+c$$$ do i=1,nres-2
+c$$$ IF (mask_theta(i+2).eq.1) THEN
+c$$$ ig=ig+1
+c$$$ gthetai=0.0D0
+c$$$ do j=i+1,nres-1
+c$$$ ind=ind+1
+c$$$ do k=1,3
+c$$$ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
+c$$$ gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
+c$$$ enddo
+c$$$ enddo
+c$$$ g(ig)=gthetai
+c$$$ ELSE
+c$$$ ind=ind+nres-1-i
+c$$$ ENDIF
+c$$$ enddo
+c$$$
+c$$$ do i=2,nres-1
+c$$$ if (itype(i).ne.10) then
+c$$$ IF (mask_side(i).eq.1) THEN
+c$$$ ig=ig+1
+c$$$ galphai=0.0D0
+c$$$ do k=1,3
+c$$$ galphai=galphai+dxds(k,i)*gradx(k,i,icg)
+c$$$ enddo
+c$$$ g(ig)=galphai
+c$$$ ENDIF
+c$$$ endif
+c$$$ enddo
+c$$$
+c$$$
+c$$$ do i=2,nres-1
+c$$$ if (itype(i).ne.10) then
+c$$$ IF (mask_side(i).eq.1) THEN
+c$$$ ig=ig+1
+c$$$ gomegai=0.0D0
+c$$$ do k=1,3
+c$$$ gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
+c$$$ enddo
+c$$$ g(ig)=gomegai
+c$$$ ENDIF
+c$$$ endif
+c$$$ enddo
+c$$$
+c$$$C
+c$$$C Add the components corresponding to local energy terms.
+c$$$C
+c$$$
+c$$$ ig=0
+c$$$ igall=0
+c$$$ do i=4,nres
+c$$$ igall=igall+1
+c$$$ if (mask_phi(i).eq.1) then
+c$$$ ig=ig+1
+c$$$ g(ig)=g(ig)+gloc(igall,icg)
+c$$$ endif
+c$$$ enddo
+c$$$
+c$$$ do i=3,nres
+c$$$ igall=igall+1
+c$$$ if (mask_theta(i).eq.1) then
+c$$$ ig=ig+1
+c$$$ g(ig)=g(ig)+gloc(igall,icg)
+c$$$ endif
+c$$$ enddo
+c$$$
+c$$$ do ij=1,2
+c$$$ do i=2,nres-1
+c$$$ if (itype(i).ne.10) then
+c$$$ igall=igall+1
+c$$$ if (mask_side(i).eq.1) then
+c$$$ ig=ig+1
+c$$$ g(ig)=g(ig)+gloc(igall,icg)
+c$$$ endif
+c$$$ endif
+c$$$ enddo
+c$$$ enddo
+c$$$
+c$$$cd do i=1,ig
+c$$$cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i)
+c$$$cd enddo
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$C-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine etotal_sc(energy_sc)
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.INTERACT'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.FFIELD'
+c$$$
+c$$$c Output arguments
+c$$$ double precision energy_sc(0:n_ene)
+c$$$
+c$$$c Local variables
+c$$$ double precision evdw,escloc
+c$$$ integer i,j
+c$$$
+c$$$
+c$$$ do i=1,n_ene
+c$$$ energy_sc(i)=0.0D0
+c$$$ enddo
+c$$$
+c$$$ if (mask_r) then
+c$$$ call egb_sc(evdw)
+c$$$ call esc_sc(escloc)
+c$$$ else
+c$$$ call egb(evdw)
+c$$$ call esc(escloc)
+c$$$ endif
+c$$$
+c$$$ if (evdw.eq.1.0D20) then
+c$$$ energy_sc(0)=evdw
+c$$$ else
+c$$$ energy_sc(0)=wsc*evdw+wscloc*escloc
+c$$$ endif
+c$$$ energy_sc(1)=evdw
+c$$$ energy_sc(12)=escloc
+c$$$
+c$$$C
+c$$$C Sum up the components of the Cartesian gradient.
+c$$$C
+c$$$ do i=1,nct
+c$$$ do j=1,3
+c$$$ gradx(j,i,icg)=wsc*gvdwx(j,i)
+c$$$ enddo
+c$$$ enddo
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$C-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine egb_sc(evdw)
+c$$$C
+c$$$C This subroutine calculates the interaction energy of nonbonded side chains
+c$$$C assuming the Gay-Berne potential of interaction.
+c$$$C
+c$$$ implicit real*8 (a-h,o-z)
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.GEO'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.LOCAL'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.NAMES'
+c$$$ include 'COMMON.INTERACT'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.CALC'
+c$$$ include 'COMMON.CONTROL'
+c$$$ logical lprn
+c$$$ evdw=0.0D0
+c$$$ energy_dec=.false.
+c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
+c$$$ evdw=0.0D0
+c$$$ lprn=.false.
+c$$$c if (icall.eq.0) lprn=.false.
+c$$$ ind=0
+c$$$ do i=iatsc_s,iatsc_e
+c$$$ itypi=itype(i)
+c$$$ itypi1=itype(i+1)
+c$$$ xi=c(1,nres+i)
+c$$$ yi=c(2,nres+i)
+c$$$ zi=c(3,nres+i)
+c$$$ dxi=dc_norm(1,nres+i)
+c$$$ dyi=dc_norm(2,nres+i)
+c$$$ dzi=dc_norm(3,nres+i)
+c$$$c dsci_inv=dsc_inv(itypi)
+c$$$ dsci_inv=vbld_inv(i+nres)
+c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
+c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
+c$$$C
+c$$$C Calculate SC interaction energy.
+c$$$C
+c$$$ do iint=1,nint_gr(i)
+c$$$ do j=istart(i,iint),iend(i,iint)
+c$$$ IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN
+c$$$ ind=ind+1
+c$$$ itypj=itype(j)
+c$$$c dscj_inv=dsc_inv(itypj)
+c$$$ dscj_inv=vbld_inv(j+nres)
+c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
+c$$$c & 1.0d0/vbld(j+nres)
+c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
+c$$$ sig0ij=sigma(itypi,itypj)
+c$$$ chi1=chi(itypi,itypj)
+c$$$ chi2=chi(itypj,itypi)
+c$$$ chi12=chi1*chi2
+c$$$ chip1=chip(itypi)
+c$$$ chip2=chip(itypj)
+c$$$ chip12=chip1*chip2
+c$$$ alf1=alp(itypi)
+c$$$ alf2=alp(itypj)
+c$$$ alf12=0.5D0*(alf1+alf2)
+c$$$C For diagnostics only!!!
+c$$$c chi1=0.0D0
+c$$$c chi2=0.0D0
+c$$$c chi12=0.0D0
+c$$$c chip1=0.0D0
+c$$$c chip2=0.0D0
+c$$$c chip12=0.0D0
+c$$$c alf1=0.0D0
+c$$$c alf2=0.0D0
+c$$$c alf12=0.0D0
+c$$$ xj=c(1,nres+j)-xi
+c$$$ yj=c(2,nres+j)-yi
+c$$$ zj=c(3,nres+j)-zi
+c$$$ dxj=dc_norm(1,nres+j)
+c$$$ dyj=dc_norm(2,nres+j)
+c$$$ dzj=dc_norm(3,nres+j)
+c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
+c$$$c write (iout,*) "j",j," dc_norm",
+c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
+c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+c$$$ rij=dsqrt(rrij)
+c$$$C Calculate angle-dependent terms of energy and contributions to their
+c$$$C derivatives.
+c$$$ call sc_angular
+c$$$ sigsq=1.0D0/sigsq
+c$$$ sig=sig0ij*dsqrt(sigsq)
+c$$$ rij_shift=1.0D0/rij-sig+sig0ij
+c$$$c for diagnostics; uncomment
+c$$$c rij_shift=1.2*sig0ij
+c$$$C I hate to put IF's in the loops, but here don't have another choice!!!!
+c$$$ if (rij_shift.le.0.0D0) then
+c$$$ evdw=1.0D20
+c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+c$$$cd & restyp(itypi),i,restyp(itypj),j,
+c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
+c$$$ return
+c$$$ endif
+c$$$ sigder=-sig*sigsq
+c$$$c---------------------------------------------------------------
+c$$$ rij_shift=1.0D0/rij_shift
+c$$$ fac=rij_shift**expon
+c$$$ e1=fac*fac*aa(itypi,itypj)
+c$$$ e2=fac*bb(itypi,itypj)
+c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2)
+c$$$ eps2der=evdwij*eps3rt
+c$$$ eps3der=evdwij*eps2rt
+c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
+c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
+c$$$ evdwij=evdwij*eps2rt*eps3rt
+c$$$ evdw=evdw+evdwij
+c$$$ if (lprn) then
+c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+c$$$ & restyp(itypi),i,restyp(itypj),j,
+c$$$ & epsi,sigm,chi1,chi2,chip1,chip2,
+c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
+c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
+c$$$ & evdwij
+c$$$ endif
+c$$$
+c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)')
+c$$$ & 'evdw',i,j,evdwij
+c$$$
+c$$$C Calculate gradient components.
+c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2
+c$$$ fac=-expon*(e1+evdwij)*rij_shift
+c$$$ sigder=fac*sigder
+c$$$ fac=rij*fac
+c$$$c fac=0.0d0
+c$$$C Calculate the radial part of the gradient
+c$$$ gg(1)=xj*fac
+c$$$ gg(2)=yj*fac
+c$$$ gg(3)=zj*fac
+c$$$C Calculate angular part of the gradient.
+c$$$ call sc_grad
+c$$$ ENDIF
+c$$$ enddo ! j
+c$$$ enddo ! iint
+c$$$ enddo ! i
+c$$$ energy_dec=.false.
+c$$$ return
+c$$$ end
+c$$$
+c$$$c-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine esc_sc(escloc)
+c$$$C Calculate the local energy of a side chain and its derivatives in the
+c$$$C corresponding virtual-bond valence angles THETA and the spherical angles
+c$$$C ALPHA and OMEGA.
+c$$$ implicit real*8 (a-h,o-z)
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.GEO'
+c$$$ include 'COMMON.LOCAL'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.INTERACT'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.NAMES'
+c$$$ include 'COMMON.FFIELD'
+c$$$ include 'COMMON.CONTROL'
+c$$$ double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
+c$$$ & ddersc0(3),ddummy(3),xtemp(3),temp(3)
+c$$$ common /sccalc/ time11,time12,time112,theti,it,nlobit
+c$$$ delta=0.02d0*pi
+c$$$ escloc=0.0D0
+c$$$c write (iout,'(a)') 'ESC'
+c$$$ do i=loc_start,loc_end
+c$$$ IF (mask_side(i).eq.1) THEN
+c$$$ it=itype(i)
+c$$$ if (it.eq.10) goto 1
+c$$$ nlobit=nlob(it)
+c$$$c print *,'i=',i,' it=',it,' nlobit=',nlobit
+c$$$c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
+c$$$ theti=theta(i+1)-pipol
+c$$$ x(1)=dtan(theti)
+c$$$ x(2)=alph(i)
+c$$$ x(3)=omeg(i)
+c$$$
+c$$$ if (x(2).gt.pi-delta) then
+c$$$ xtemp(1)=x(1)
+c$$$ xtemp(2)=pi-delta
+c$$$ xtemp(3)=x(3)
+c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
+c$$$ xtemp(2)=pi
+c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
+c$$$ call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
+c$$$ & escloci,dersc(2))
+c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
+c$$$ & ddersc0(1),dersc(1))
+c$$$ call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
+c$$$ & ddersc0(3),dersc(3))
+c$$$ xtemp(2)=pi-delta
+c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
+c$$$ xtemp(2)=pi
+c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
+c$$$ call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
+c$$$ & dersc0(2),esclocbi,dersc02)
+c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
+c$$$ & dersc12,dersc01)
+c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd)
+c$$$ dersc0(1)=dersc01
+c$$$ dersc0(2)=dersc02
+c$$$ dersc0(3)=0.0d0
+c$$$ do k=1,3
+c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
+c$$$ enddo
+c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
+c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
+c$$$c & esclocbi,ss,ssd
+c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi
+c$$$c escloci=esclocbi
+c$$$c write (iout,*) escloci
+c$$$ else if (x(2).lt.delta) then
+c$$$ xtemp(1)=x(1)
+c$$$ xtemp(2)=delta
+c$$$ xtemp(3)=x(3)
+c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
+c$$$ xtemp(2)=0.0d0
+c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
+c$$$ call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
+c$$$ & escloci,dersc(2))
+c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
+c$$$ & ddersc0(1),dersc(1))
+c$$$ call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
+c$$$ & ddersc0(3),dersc(3))
+c$$$ xtemp(2)=delta
+c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
+c$$$ xtemp(2)=0.0d0
+c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
+c$$$ call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
+c$$$ & dersc0(2),esclocbi,dersc02)
+c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
+c$$$ & dersc12,dersc01)
+c$$$ dersc0(1)=dersc01
+c$$$ dersc0(2)=dersc02
+c$$$ dersc0(3)=0.0d0
+c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd)
+c$$$ do k=1,3
+c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
+c$$$ enddo
+c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
+c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
+c$$$c & esclocbi,ss,ssd
+c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi
+c$$$c write (iout,*) escloci
+c$$$ else
+c$$$ call enesc(x,escloci,dersc,ddummy,.false.)
+c$$$ endif
+c$$$
+c$$$ escloc=escloc+escloci
+c$$$ if (energy_dec) write (iout,'(a6,i,0pf7.3)')
+c$$$ & 'escloc',i,escloci
+c$$$c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
+c$$$
+c$$$ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
+c$$$ & wscloc*dersc(1)
+c$$$ gloc(ialph(i,1),icg)=wscloc*dersc(2)
+c$$$ gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
+c$$$ 1 continue
+c$$$ ENDIF
+c$$$ enddo
+c$$$ return
+c$$$ end
+c$$$
+c$$$C-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine egb_ij(i_sc,j_sc,evdw)
+c$$$C
+c$$$C This subroutine calculates the interaction energy of nonbonded side chains
+c$$$C assuming the Gay-Berne potential of interaction.
+c$$$C
+c$$$ implicit real*8 (a-h,o-z)
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.GEO'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.LOCAL'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.NAMES'
+c$$$ include 'COMMON.INTERACT'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.CALC'
+c$$$ include 'COMMON.CONTROL'
+c$$$ logical lprn
+c$$$ evdw=0.0D0
+c$$$ energy_dec=.false.
+c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
+c$$$ evdw=0.0D0
+c$$$ lprn=.false.
+c$$$ ind=0
+c$$$c$$$ do i=iatsc_s,iatsc_e
+c$$$ i=i_sc
+c$$$ itypi=itype(i)
+c$$$ itypi1=itype(i+1)
+c$$$ xi=c(1,nres+i)
+c$$$ yi=c(2,nres+i)
+c$$$ zi=c(3,nres+i)
+c$$$ dxi=dc_norm(1,nres+i)
+c$$$ dyi=dc_norm(2,nres+i)
+c$$$ dzi=dc_norm(3,nres+i)
+c$$$c dsci_inv=dsc_inv(itypi)
+c$$$ dsci_inv=vbld_inv(i+nres)
+c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
+c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
+c$$$C
+c$$$C Calculate SC interaction energy.
+c$$$C
+c$$$c$$$ do iint=1,nint_gr(i)
+c$$$c$$$ do j=istart(i,iint),iend(i,iint)
+c$$$ j=j_sc
+c$$$ ind=ind+1
+c$$$ itypj=itype(j)
+c$$$c dscj_inv=dsc_inv(itypj)
+c$$$ dscj_inv=vbld_inv(j+nres)
+c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
+c$$$c & 1.0d0/vbld(j+nres)
+c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
+c$$$ sig0ij=sigma(itypi,itypj)
+c$$$ chi1=chi(itypi,itypj)
+c$$$ chi2=chi(itypj,itypi)
+c$$$ chi12=chi1*chi2
+c$$$ chip1=chip(itypi)
+c$$$ chip2=chip(itypj)
+c$$$ chip12=chip1*chip2
+c$$$ alf1=alp(itypi)
+c$$$ alf2=alp(itypj)
+c$$$ alf12=0.5D0*(alf1+alf2)
+c$$$C For diagnostics only!!!
+c$$$c chi1=0.0D0
+c$$$c chi2=0.0D0
+c$$$c chi12=0.0D0
+c$$$c chip1=0.0D0
+c$$$c chip2=0.0D0
+c$$$c chip12=0.0D0
+c$$$c alf1=0.0D0
+c$$$c alf2=0.0D0
+c$$$c alf12=0.0D0
+c$$$ xj=c(1,nres+j)-xi
+c$$$ yj=c(2,nres+j)-yi
+c$$$ zj=c(3,nres+j)-zi
+c$$$ dxj=dc_norm(1,nres+j)
+c$$$ dyj=dc_norm(2,nres+j)
+c$$$ dzj=dc_norm(3,nres+j)
+c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
+c$$$c write (iout,*) "j",j," dc_norm",
+c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
+c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+c$$$ rij=dsqrt(rrij)
+c$$$C Calculate angle-dependent terms of energy and contributions to their
+c$$$C derivatives.
+c$$$ call sc_angular
+c$$$ sigsq=1.0D0/sigsq
+c$$$ sig=sig0ij*dsqrt(sigsq)
+c$$$ rij_shift=1.0D0/rij-sig+sig0ij
+c$$$c for diagnostics; uncomment
+c$$$c rij_shift=1.2*sig0ij
+c$$$C I hate to put IF's in the loops, but here don't have another choice!!!!
+c$$$ if (rij_shift.le.0.0D0) then
+c$$$ evdw=1.0D20
+c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+c$$$cd & restyp(itypi),i,restyp(itypj),j,
+c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
+c$$$ return
+c$$$ endif
+c$$$ sigder=-sig*sigsq
+c$$$c---------------------------------------------------------------
+c$$$ rij_shift=1.0D0/rij_shift
+c$$$ fac=rij_shift**expon
+c$$$ e1=fac*fac*aa(itypi,itypj)
+c$$$ e2=fac*bb(itypi,itypj)
+c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2)
+c$$$ eps2der=evdwij*eps3rt
+c$$$ eps3der=evdwij*eps2rt
+c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
+c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
+c$$$ evdwij=evdwij*eps2rt*eps3rt
+c$$$ evdw=evdw+evdwij
+c$$$ if (lprn) then
+c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+c$$$ & restyp(itypi),i,restyp(itypj),j,
+c$$$ & epsi,sigm,chi1,chi2,chip1,chip2,
+c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
+c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
+c$$$ & evdwij
+c$$$ endif
+c$$$
+c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)')
+c$$$ & 'evdw',i,j,evdwij
+c$$$
+c$$$C Calculate gradient components.
+c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2
+c$$$ fac=-expon*(e1+evdwij)*rij_shift
+c$$$ sigder=fac*sigder
+c$$$ fac=rij*fac
+c$$$c fac=0.0d0
+c$$$C Calculate the radial part of the gradient
+c$$$ gg(1)=xj*fac
+c$$$ gg(2)=yj*fac
+c$$$ gg(3)=zj*fac
+c$$$C Calculate angular part of the gradient.
+c$$$ call sc_grad
+c$$$c$$$ enddo ! j
+c$$$c$$$ enddo ! iint
+c$$$c$$$ enddo ! i
+c$$$ energy_dec=.false.
+c$$$ return
+c$$$ end
+c$$$
+c$$$C-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine perturb_side_chain(i,angle)
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.GEO'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.LOCAL'
+c$$$ include 'COMMON.IOUNITS'
+c$$$
+c$$$c External functions
+c$$$ external ran_number
+c$$$ double precision ran_number
+c$$$
+c$$$c Input arguments
+c$$$ integer i
+c$$$ double precision angle ! In degrees
+c$$$
+c$$$c Local variables
+c$$$ integer i_sc
+c$$$ double precision rad_ang,rand_v(3),length,cost,sint
+c$$$
+c$$$
+c$$$ i_sc=i+nres
+c$$$ rad_ang=angle*deg2rad
+c$$$
+c$$$ length=0.0
+c$$$ do while (length.lt.0.01)
+c$$$ rand_v(1)=ran_number(0.01D0,1.0D0)
+c$$$ rand_v(2)=ran_number(0.01D0,1.0D0)
+c$$$ rand_v(3)=ran_number(0.01D0,1.0D0)
+c$$$ length=rand_v(1)*rand_v(1)+rand_v(2)*rand_v(2)+
+c$$$ + rand_v(3)*rand_v(3)
+c$$$ length=sqrt(length)
+c$$$ rand_v(1)=rand_v(1)/length
+c$$$ rand_v(2)=rand_v(2)/length
+c$$$ rand_v(3)=rand_v(3)/length
+c$$$ cost=rand_v(1)*dc_norm(1,i_sc)+rand_v(2)*dc_norm(2,i_sc)+
+c$$$ + rand_v(3)*dc_norm(3,i_sc)
+c$$$ length=1.0D0-cost*cost
+c$$$ if (length.lt.0.0D0) length=0.0D0
+c$$$ length=sqrt(length)
+c$$$ rand_v(1)=rand_v(1)-cost*dc_norm(1,i_sc)
+c$$$ rand_v(2)=rand_v(2)-cost*dc_norm(2,i_sc)
+c$$$ rand_v(3)=rand_v(3)-cost*dc_norm(3,i_sc)
+c$$$ enddo
+c$$$ rand_v(1)=rand_v(1)/length
+c$$$ rand_v(2)=rand_v(2)/length
+c$$$ rand_v(3)=rand_v(3)/length
+c$$$
+c$$$ cost=dcos(rad_ang)
+c$$$ sint=dsin(rad_ang)
+c$$$ dc(1,i_sc)=vbld(i_sc)*(dc_norm(1,i_sc)*cost+rand_v(1)*sint)
+c$$$ dc(2,i_sc)=vbld(i_sc)*(dc_norm(2,i_sc)*cost+rand_v(2)*sint)
+c$$$ dc(3,i_sc)=vbld(i_sc)*(dc_norm(3,i_sc)*cost+rand_v(3)*sint)
+c$$$ dc_norm(1,i_sc)=dc(1,i_sc)*vbld_inv(i_sc)
+c$$$ dc_norm(2,i_sc)=dc(2,i_sc)*vbld_inv(i_sc)
+c$$$ dc_norm(3,i_sc)=dc(3,i_sc)*vbld_inv(i_sc)
+c$$$ c(1,i_sc)=c(1,i)+dc(1,i_sc)
+c$$$ c(2,i_sc)=c(2,i)+dc(2,i_sc)
+c$$$ c(3,i_sc)=c(3,i)+dc(3,i_sc)
+c$$$
+c$$$ call chainbuild_cart
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$c----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine ss_relax3(i_in,j_in)
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.INTERACT'
+c$$$
+c$$$c External functions
+c$$$ external ran_number
+c$$$ double precision ran_number
+c$$$
+c$$$c Input arguments
+c$$$ integer i_in,j_in
+c$$$
+c$$$c Local variables
+c$$$ double precision energy_sc(0:n_ene),etot
+c$$$ double precision org_dc(3),org_dc_norm(3),org_c(3)
+c$$$ double precision ang_pert,rand_fact,exp_fact,beta
+c$$$ integer n,i_pert,i
+c$$$ logical notdone
+c$$$
+c$$$
+c$$$ beta=1.0D0
+c$$$
+c$$$ mask_r=.true.
+c$$$ do i=nnt,nct
+c$$$ mask_side(i)=0
+c$$$ enddo
+c$$$ mask_side(i_in)=1
+c$$$ mask_side(j_in)=1
+c$$$
+c$$$ call etotal_sc(energy_sc)
+c$$$ etot=energy_sc(0)
+c$$$c write(iout,'(a,3d15.5)')" SS_MC_START ",energy_sc(0),
+c$$$c + energy_sc(1),energy_sc(12)
+c$$$
+c$$$ notdone=.true.
+c$$$ n=0
+c$$$ do while (notdone)
+c$$$ if (mod(n,2).eq.0) then
+c$$$ i_pert=i_in
+c$$$ else
+c$$$ i_pert=j_in
+c$$$ endif
+c$$$ n=n+1
+c$$$
+c$$$ do i=1,3
+c$$$ org_dc(i)=dc(i,i_pert+nres)
+c$$$ org_dc_norm(i)=dc_norm(i,i_pert+nres)
+c$$$ org_c(i)=c(i,i_pert+nres)
+c$$$ enddo
+c$$$ ang_pert=ran_number(0.0D0,3.0D0)
+c$$$ call perturb_side_chain(i_pert,ang_pert)
+c$$$ call etotal_sc(energy_sc)
+c$$$ exp_fact=exp(beta*(etot-energy_sc(0)))
+c$$$ rand_fact=ran_number(0.0D0,1.0D0)
+c$$$ if (rand_fact.lt.exp_fact) then
+c$$$c write(iout,'(a,3d15.5)')" SS_MC_ACCEPT ",energy_sc(0),
+c$$$c + energy_sc(1),energy_sc(12)
+c$$$ etot=energy_sc(0)
+c$$$ else
+c$$$c write(iout,'(a,3d15.5)')" SS_MC_REJECT ",energy_sc(0),
+c$$$c + energy_sc(1),energy_sc(12)
+c$$$ do i=1,3
+c$$$ dc(i,i_pert+nres)=org_dc(i)
+c$$$ dc_norm(i,i_pert+nres)=org_dc_norm(i)
+c$$$ c(i,i_pert+nres)=org_c(i)
+c$$$ enddo
+c$$$ endif
+c$$$
+c$$$ if (n.eq.10000.or.etot.lt.30.0D0) notdone=.false.
+c$$$ enddo
+c$$$
+c$$$ mask_r=.false.
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$c----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine ss_relax2(etot,iretcode,nfun,i_in,j_in)
+c$$$ implicit none
+c$$$ include 'DIMENSIONS'
+c$$$ integer liv,lv
+c$$$ parameter (liv=60,lv=(77+maxres6*(maxres6+17)/2))
+c$$$*********************************************************************
+c$$$* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for *
+c$$$* the calling subprogram. *
+c$$$* when d(i)=1.0, then v(35) is the length of the initial step, *
+c$$$* calculated in the usual pythagorean way. *
+c$$$* absolute convergence occurs when the function is within v(31) of *
+c$$$* zero. unless you know the minimum value in advance, abs convg *
+c$$$* is probably not useful. *
+c$$$* relative convergence is when the model predicts that the function *
+c$$$* will decrease by less than v(32)*abs(fun). *
+c$$$*********************************************************************
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.GEO'
+c$$$ include 'COMMON.MINIM'
+c$$$ include 'COMMON.CHAIN'
+c$$$
+c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist
+c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar),
+c$$$ + orig_ss_dist(maxres2,maxres2)
+c$$$
+c$$$ double precision etot
+c$$$ integer iretcode,nfun,i_in,j_in
+c$$$
+c$$$ external dist
+c$$$ double precision dist
+c$$$ external ss_func,fdum
+c$$$ double precision ss_func,fdum
+c$$$
+c$$$ integer iv(liv),uiparm(2)
+c$$$ double precision v(lv),x(maxres6),d(maxres6),rdum
+c$$$ integer i,j,k
+c$$$
+c$$$
+c$$$ call deflt(2,iv,liv,lv,v)
+c$$$* 12 means fresh start, dont call deflt
+c$$$ iv(1)=12
+c$$$* max num of fun calls
+c$$$ if (maxfun.eq.0) maxfun=500
+c$$$ iv(17)=maxfun
+c$$$* max num of iterations
+c$$$ if (maxmin.eq.0) maxmin=1000
+c$$$ iv(18)=maxmin
+c$$$* controls output
+c$$$ iv(19)=2
+c$$$* selects output unit
+c$$$c iv(21)=iout
+c$$$ iv(21)=0
+c$$$* 1 means to print out result
+c$$$ iv(22)=0
+c$$$* 1 means to print out summary stats
+c$$$ iv(23)=0
+c$$$* 1 means to print initial x and d
+c$$$ iv(24)=0
+c$$$* min val for v(radfac) default is 0.1
+c$$$ v(24)=0.1D0
+c$$$* max val for v(radfac) default is 4.0
+c$$$ v(25)=2.0D0
+c$$$c v(25)=4.0D0
+c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
+c$$$* the sumsl default is 0.1
+c$$$ v(26)=0.1D0
+c$$$* false conv if (act fnctn decrease) .lt. v(34)
+c$$$* the sumsl default is 100*machep
+c$$$ v(34)=v(34)/100.0D0
+c$$$* absolute convergence
+c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4
+c$$$ v(31)=tolf
+c$$$ v(31)=1.0D-1
+c$$$* relative convergence
+c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-4
+c$$$ v(32)=rtolf
+c$$$ v(32)=1.0D-1
+c$$$* controls initial step size
+c$$$ v(35)=1.0D-1
+c$$$* large vals of d correspond to small components of step
+c$$$ do i=1,6*nres
+c$$$ d(i)=1.0D0
+c$$$ enddo
+c$$$
+c$$$ do i=0,2*nres
+c$$$ do j=1,3
+c$$$ orig_ss_dc(j,i)=dc(j,i)
+c$$$ enddo
+c$$$ enddo
+c$$$ call geom_to_var(nvar,orig_ss_var)
+c$$$
+c$$$ do i=1,nres
+c$$$ do j=i,nres
+c$$$ orig_ss_dist(j,i)=dist(j,i)
+c$$$ orig_ss_dist(j+nres,i)=dist(j+nres,i)
+c$$$ orig_ss_dist(j,i+nres)=dist(j,i+nres)
+c$$$ orig_ss_dist(j+nres,i+nres)=dist(j+nres,i+nres)
+c$$$ enddo
+c$$$ enddo
+c$$$
+c$$$ k=0
+c$$$ do i=1,nres-1
+c$$$ do j=1,3
+c$$$ k=k+1
+c$$$ x(k)=dc(j,i)
+c$$$ enddo
+c$$$ enddo
+c$$$ do i=2,nres-1
+c$$$ if (ialph(i,1).gt.0) then
+c$$$ do j=1,3
+c$$$ k=k+1
+c$$$ x(k)=dc(j,i+nres)
+c$$$ enddo
+c$$$ endif
+c$$$ enddo
+c$$$
+c$$$ uiparm(1)=i_in
+c$$$ uiparm(2)=j_in
+c$$$ call smsno(k,d,x,ss_func,iv,liv,lv,v,uiparm,rdum,fdum)
+c$$$ etot=v(10)
+c$$$ iretcode=iv(1)
+c$$$ nfun=iv(6)+iv(30)
+c$$$
+c$$$ k=0
+c$$$ do i=1,nres-1
+c$$$ do j=1,3
+c$$$ k=k+1
+c$$$ dc(j,i)=x(k)
+c$$$ enddo
+c$$$ enddo
+c$$$ do i=2,nres-1
+c$$$ if (ialph(i,1).gt.0) then
+c$$$ do j=1,3
+c$$$ k=k+1
+c$$$ dc(j,i+nres)=x(k)
+c$$$ enddo
+c$$$ endif
+c$$$ enddo
+c$$$ call chainbuild_cart
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$C-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine ss_func(n,x,nf,f,uiparm,urparm,ufparm)
+c$$$ implicit none
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.INTERACT'
+c$$$ include 'COMMON.SBRIDGE'
+c$$$
+c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist
+c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar),
+c$$$ + orig_ss_dist(maxres2,maxres2)
+c$$$
+c$$$ integer n
+c$$$ double precision x(maxres6)
+c$$$ integer nf
+c$$$ double precision f
+c$$$ integer uiparm(2)
+c$$$ real*8 urparm(1)
+c$$$ external ufparm
+c$$$ double precision ufparm
+c$$$
+c$$$ external dist
+c$$$ double precision dist
+c$$$
+c$$$ integer i,j,k,ss_i,ss_j
+c$$$ double precision tempf,var(maxvar)
+c$$$
+c$$$
+c$$$ ss_i=uiparm(1)
+c$$$ ss_j=uiparm(2)
+c$$$ f=0.0D0
+c$$$
+c$$$ k=0
+c$$$ do i=1,nres-1
+c$$$ do j=1,3
+c$$$ k=k+1
+c$$$ dc(j,i)=x(k)
+c$$$ enddo
+c$$$ enddo
+c$$$ do i=2,nres-1
+c$$$ if (ialph(i,1).gt.0) then
+c$$$ do j=1,3
+c$$$ k=k+1
+c$$$ dc(j,i+nres)=x(k)
+c$$$ enddo
+c$$$ endif
+c$$$ enddo
+c$$$ call chainbuild_cart
+c$$$
+c$$$ call geom_to_var(nvar,var)
+c$$$
+c$$$c Constraints on all angles
+c$$$ do i=1,nvar
+c$$$ tempf=var(i)-orig_ss_var(i)
+c$$$ f=f+tempf*tempf
+c$$$ enddo
+c$$$
+c$$$c Constraints on all distances
+c$$$ do i=1,nres-1
+c$$$ if (i.gt.1) then
+c$$$ tempf=dist(i+nres,i)-orig_ss_dist(i+nres,i)
+c$$$ f=f+tempf*tempf
+c$$$ endif
+c$$$ do j=i+1,nres
+c$$$ tempf=dist(j,i)-orig_ss_dist(j,i)
+c$$$ if (tempf.lt.0.0D0 .or. j.eq.i+1) f=f+tempf*tempf
+c$$$ tempf=dist(j+nres,i)-orig_ss_dist(j+nres,i)
+c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf
+c$$$ tempf=dist(j,i+nres)-orig_ss_dist(j,i+nres)
+c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf
+c$$$ tempf=dist(j+nres,i+nres)-orig_ss_dist(j+nres,i+nres)
+c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf
+c$$$ enddo
+c$$$ enddo
+c$$$
+c$$$c Constraints for the relevant CYS-CYS
+c$$$ tempf=dist(nres+ss_i,nres+ss_j)-8.0D0
+c$$$ f=f+tempf*tempf
+c$$$CCCCCCCCCCCCCCCCC ADD SOME ANGULAR STUFF
+c$$$
+c$$$c$$$ if (nf.ne.nfl) then
+c$$$c$$$ write(iout,'(a,i10,2d15.5)')"IN DIST_FUNC (NF,F,DIST)",nf,
+c$$$c$$$ + f,dist(5+nres,14+nres)
+c$$$c$$$ endif
+c$$$
+c$$$ nfl=nf
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$C-----------------------------------------------------------------------------
+c$$$C-----------------------------------------------------------------------------
+ subroutine triple_ssbond_ene(resi,resj,resk,eij)
+ include 'DIMENSIONS'
+ include 'COMMON.SBRIDGE'
+ include 'COMMON.CHAIN'
+ include 'COMMON.DERIV'
+ include 'COMMON.LOCAL'
+ include 'COMMON.INTERACT'
+ include 'COMMON.VAR'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.CALC'
+#ifndef CLUST
+#ifndef WHAM
+C include 'COMMON.MD'
+#endif
+#endif
+
+c External functions
+ double precision h_base
+ external h_base
+
+c Input arguments
+ integer resi,resj,resk
+
+c Output arguments
+ double precision eij,eij1,eij2,eij3
+
+c Local variables
+ logical havebond
+c integer itypi,itypj,k,l
+ double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
+ double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
+ double precision xik,yik,zik,xjk,yjk,zjk
+ double precision sig0ij,ljd,sig,fac,e1,e2
+ double precision dcosom1(3),dcosom2(3),ed
+ double precision pom1,pom2
+ double precision ljA,ljB,ljXs
+ double precision d_ljB(1:3)
+ double precision ssA,ssB,ssC,ssXs
+ double precision ssxm,ljxm,ssm,ljm
+ double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
+
+ i=resi
+ j=resj
+ k=resk
+C write(iout,*) resi,resj,resk
+ itypi=itype(i)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+ dsci_inv=vbld_inv(i+nres)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+
+ itypj=itype(j)
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ dscj_inv=vbld_inv(j+nres)
+ itypk=itype(k)
+ xk=c(1,nres+k)
+ yk=c(2,nres+k)
+ zk=c(3,nres+k)
+
+ dxk=dc_norm(1,nres+k)
+ dyk=dc_norm(2,nres+k)
+ dzk=dc_norm(3,nres+k)
+ dscj_inv=vbld_inv(k+nres)
+ xij=xj-xi
+ xik=xk-xi
+ xjk=xk-xj
+ yij=yj-yi
+ yik=yk-yi
+ yjk=yk-yj
+ zij=zj-zi
+ zik=zk-zi
+ zjk=zk-zj
+ rrij=(xij*xij+yij*yij+zij*zij)
+ rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
+ rrik=(xik*xik+yik*yik+zik*zik)
+ rik=dsqrt(rrik)
+ rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
+ rjk=dsqrt(rrjk)
+C there are three combination of distances for each trisulfide bonds
+C The first case the ith atom is the center
+C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
+C distance y is second distance the a,b,c,d are parameters derived for
+C this problem d parameter was set as a penalty currenlty set to 1.
+ eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**2+ctriss)
+C second case jth atom is center
+ eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**2+ctriss)
+C the third case kth atom is the center
+ eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**2+ctriss)
+C eij2=0.0
+C eij3=0.0
+C eij1=0.0
+ eij=eij1+eij2+eij3
+C write(iout,*)i,j,k,eij
+C The energy penalty calculated now time for the gradient part
+C derivative over rij
+ fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+2.0*btriss*(rij+rik))
+ &-eij2**2/dtriss*(2.0*atriss*(rij-rjk)+2.0*btriss*(rij+rjk))
+ gg(1)=xij*fac/rij
+ gg(2)=yij*fac/rij
+ gg(3)=zij*fac/rij
+ do m=1,3
+ gvdwx(m,i)=gvdwx(m,i)-gg(m)
+ gvdwx(m,j)=gvdwx(m,j)+gg(m)
+ enddo
+ do l=1,3
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ enddo
+C now derivative over rik
+ fac=-eij1**2/dtriss*(-2.0*atriss*(rij-rik)+2.0*btriss*(rij+rik))
+ &-eij3**2/dtriss*(2.0*atriss*(rik-rjk)+2.0*btriss*(rik+rjk))
+ gg(1)=xik*fac/rik
+ gg(2)=yik*fac/rik
+ gg(3)=zik*fac/rik
+ do m=1,3
+ gvdwx(m,i)=gvdwx(m,i)-gg(m)
+ gvdwx(m,k)=gvdwx(m,k)+gg(m)
+ enddo
+ do l=1,3
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,k)=gvdwc(l,k)+gg(l)
+ enddo
+C now derivative over rjk
+ fac=-eij2**2/dtriss*(-2.0*atriss*(rij-rjk)+2.0*btriss*(rij+rjk))-
+ &eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+2.0*btriss*(rik+rjk))
+ gg(1)=xjk*fac/rjk
+ gg(2)=yjk*fac/rjk
+ gg(3)=zjk*fac/rjk
+ do m=1,3
+ gvdwx(m,j)=gvdwx(m,j)-gg(m)
+ gvdwx(m,k)=gvdwx(m,k)+gg(m)
+ enddo
+ do l=1,3
+ gvdwc(l,j)=gvdwc(l,j)-gg(l)
+ gvdwc(l,k)=gvdwc(l,k)+gg(l)
+ enddo
+ return
+ end
if (lprint) then
write (iout,*) "Partition of work between processors"
- do i=0,nprocs-1
- write (iout,'(a,i5,a,i7,a,i7,a,i7)')
- & "Processor",i," indstart",indstart(i),
- & " indend",indend(i)," count",scount(i)
- enddo
- endif
+C do i=0,nprocs-1
+C write (iout,'(a,i5,a,i7,a,i7,a,i7)')
+C & "Processor",i," indstart",indstart(i),
+C & " indend",indend(i)," count",scount(i)
+C enddo
+ endif
+ write(iout,*) "just before leave"
return
end
#endif
proc_cont.f
define_pairs.f
mysort.f
+ ssMD.F
)
set(UNRES_WHAM_M_PP_SRC
& vbldsc0_all(maxbondterm,ntyp,max_parm),
& aksc_all(maxbondterm,ntyp,max_parm),
& abond0_all(maxbondterm,ntyp,max_parm),
- & a0thet_all(ntyp,max_parm),athet_all(2,ntyp,max_parm),
- & bthet_all(2,ntyp,max_parm),polthet_all(0:3,ntyp,max_parm),
- & gthet_all(3,ntyp,max_parm),theta0_all(ntyp,max_parm),
- & sig0_all(ntyp,max_parm),sigc0_all(ntyp,max_parm),
- & aa0thet_all(maxthetyp1,maxthetyp1,maxthetyp1,max_parm),
- & aathet_all(maxtheterm,maxthetyp1,maxthetyp1,maxthetyp1,max_parm),
- & bbthet_all(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,
- & maxthetyp1,max_parm),
- & ccthet_all(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,
- & maxthetyp1,max_parm),
- & ddthet_all(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,
- & maxthetyp1,max_parm),
- & eethet_all(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,
- & maxthetyp1,max_parm),
- & ffthet_all(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1,
- & maxthetyp1,max_parm),
- & ggthet_all(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1,
- & maxthetyp1,max_parm),
+ & a0thet_all(-ntyp:ntyp,max_parm),
+ & athet_all(2,-ntyp:ntyp,-1:1,-1:1,max_parm),
+ & bthet_all(2,-ntyp:ntyp,-1:1,-1:1,max_parm),
+ & polthet_all(0:3,-ntyp:ntyp,max_parm),
+ & gthet_all(3,-ntyp:ntyp,max_parm),theta0_all(-ntyp:ntyp,max_parm),
+ & sig0_all(-ntyp:ntyp,max_parm),sigc0_all(-ntyp:ntyp,max_parm),
+ & aa0thet_all(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,
+ & -maxthetyp1:maxthetyp1,2,max_parm),
+ & aathet_all(maxtheterm,-maxthetyp1:maxthetyp1,
+ & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm),
+ & bbthet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,
+ & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm),
+ & ccthet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,
+ &-maxthetyp1:maxthetyp1,
+ & -maxthetyp1:maxthetyp1,2,max_parm),
+ & ddthet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,
+ & -maxthetyp1:maxthetyp1,
+ & -maxthetyp1:maxthetyp1,2,max_parm),
+ & eethet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,
+ & -maxthetyp1:maxthetyp1,
+ & -maxthetyp1:maxthetyp1,2,max_parm),
+ & ffthet_all1(maxdouble,maxdouble,maxtheterm3,
+ & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,
+ & -maxthetyp1:maxthetyp1,max_parm),
+ & ggthet_all1(maxdouble,maxdouble,maxtheterm3,
+ & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,
+ & -maxthetyp1:maxthetyp1,max_parm),
+ & ffthet_all2(maxdouble,maxdouble,maxtheterm3,
+ & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,
+ & -maxthetyp1:maxthetyp1,max_parm),
+ & ggthet_all2(maxdouble,maxdouble,maxtheterm3,
+ & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,
+ & -maxthetyp1:maxthetyp1,max_parm),
& dsc_all(ntyp1,max_parm),bsc_all(maxlob,ntyp,max_parm),
- & censc_all(3,maxlob,ntyp,max_parm),
- & gaussc_all(3,3,maxlob,ntyp,max_parm),dsc0_all(ntyp1,max_parm),
+ & censc_all(3,maxlob,-ntyp:ntyp,max_parm),
+ & gaussc_all(3,3,maxlob,-ntyp:ntyp,max_parm),
+ & dsc0_all(ntyp1,max_parm),
& sc_parmin_all(65,ntyp,max_parm),
- & v0_all(maxtor,maxtor,max_parm),
- & v1_all(maxterm,maxtor,maxtor,max_parm),
- & v2_all(maxterm,maxtor,maxtor,max_parm),
+ & v0_all(-maxtor:maxtor,-maxtor:maxtor,2,max_parm),
+ & v1_all(maxterm,-maxtor:maxtor,-maxtor:maxtor,2,max_parm),
+ & v2_all(maxterm,-maxtor:maxtor,-maxtor:maxtor,2,max_parm),
& vlor1_all(maxlor,maxtor,maxtor,max_parm),
& vlor2_all(maxlor,maxtor,maxtor,max_parm),
& vlor3_all(maxlor,maxtor,maxtor,max_parm),
- & v1c_all(2,maxtermd_1,maxtor,maxtor,maxtor,max_parm),
- & v1s_all(2,maxtermd_1,maxtor,maxtor,maxtor,max_parm),
- & v2c_all(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor,max_parm),
- & v2s_all(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor,max_parm),
- & b1_all(2,maxtor,max_parm),b2_all(2,maxtor,max_parm),
- & cc_all(2,2,maxtor,max_parm),dd_all(2,2,maxtor,max_parm),
- & ee_all(2,2,maxtor,max_parm),ctilde_all(2,2,maxtor,max_parm),
- & dtilde_all(2,2,maxtor,max_parm),b1tilde_all(2,maxtor,max_parm),
+ & v1c_all(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,
+ & -maxtor:maxtor,2,max_parm),
+ & v1s_all(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,
+ & -maxtor:maxtor,2,max_parm),
+ & v2c_all(maxtermd_2,maxtermd_2,-maxtor:maxtor,
+ & -maxtor:maxtor,-maxtor:maxtor,2,max_parm),
+ & v2s_all(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,
+ & -maxtor:maxtor,2,max_parm),
+ & b1_all(2,-maxtor:maxtor,max_parm),
+ & b2_all(2,-maxtor:maxtor,max_parm),
+ & cc_all(2,2,-maxtor:maxtor,max_parm),
+ & dd_all(2,2,-maxtor:maxtor,max_parm),
+ & ee_all(2,2,-maxtor:maxtor,max_parm),
+ & ctilde_all(2,2,-maxtor:maxtor,max_parm),
+ & dtilde_all(2,2,-maxtor:maxtor,max_parm),
+ & b1tilde_all(2,-maxtor:maxtor,max_parm),
& app_all(2,2,max_parm),bpp_all(2,2,max_parm),
& ael6_all(2,2,max_parm),ael3_all(2,2,max_parm),
& aad_all(ntyp,2,max_parm),bad_all(ntyp,2,max_parm),
- & aa_all(ntyp,ntyp,max_parm),bb_all(ntyp,ntyp,max_parm),
+ & aa_aq_all(ntyp,ntyp,max_parm),bb_aq_all(ntyp,ntyp,max_parm),
+ & aa_lip_all(ntyp,ntyp,max_parm),bb_lip_all(ntyp,ntyp,max_parm),
& augm_all(ntyp,ntyp,max_parm),eps_all(ntyp,ntyp,max_parm),
+ & epslip_all(ntyp,ntyp,max_parm),
& sigma_all(ntyp,ntyp,max_parm),r0_all(ntyp,ntyp,max_parm),
& chi_all(ntyp,ntyp,max_parm),chip_all(ntyp,max_parm),
& alp_all(ntyp,max_parm),ebr_all(max_parm),d0cm_all(max_parm),
& v1sccor_all(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp,max_parm),
& v2sccor_all(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp,max_parm)
integer nlob_all(ntyp1,max_parm),
- & nlor_all(-maxtor:maxtor,-maxtor:maxtor,max_parm),
- & nterm_all(-maxtor:maxtor,-maxtor:maxtor,max_parm),
+ & nlor_all(-maxtor:maxtor,-maxtor:maxtor,2,max_parm),
+ & nterm_all(-maxtor:maxtor,-maxtor:maxtor,2,max_parm),
& ntermd1_all(-maxtor:maxtor,-maxtor:maxtor,
- & -maxtor:maxtor,max_parm),
+ & -maxtor:maxtor,2,max_parm),
& ntermd2_all(-maxtor:maxtor,-maxtor:maxtor,
- & -maxtor:maxtor,max_parm),
+ & -maxtor:maxtor,2,max_parm),
& nbondterm_all(ntyp,max_parm),nthetyp_all(max_parm),
- & ithetyp_all(ntyp1,max_parm),ntheterm_all(max_parm),
+ & ithetyp_all(-ntyp1:ntyp1,max_parm),ntheterm_all(max_parm),
& ntheterm2_all(max_parm),ntheterm3_all(max_parm),
& nsingle_all(max_parm),ndouble_all(max_parm),
& nntheterm_all(max_parm),
&nterm_sccor_all(-ntyp:ntyp,-ntyp:ntyp,max_parm)
common /allparm/ ww_all,vbldp0_all,akp_all,vbldsc0_all,aksc_all,
& abond0_all,aa0thet_all,aathet_all,bbthet_all,ccthet_all,
- & ddthet_all,eethet_all,ffthet_all,ggthet_all,
+ & ddthet_all,eethet_all,ffthet_all1,ggthet_all1,
+ & ffthet_all2,ggthet_all2,
& a0thet_all,athet_all,bthet_all,polthet_all,gthet_all,theta0_all,
& sig0_all,sigc0_all,dsc_all,bsc_all,censc_all,gaussc_all,dsc0_all,
& sc_parmin_all,
& v0_all,v1_all,v2_all,vlor1_all,vlor2_all,vlor3_all,v1c_all,
& v1s_all,v2c_all,v2s_all,b1_all,b2_all,cc_all,dd_all,ee_all,
& ctilde_all,dtilde_all,b1tilde_all,app_all,bpp_all,ael6_all,
- & ael3_all,aad_all,bad_all,aa_all,bb_all,augm_all,
+ & ael3_all,aad_all,bad_all,aa_aq_all,bb_aq_all,augm_all,
+ & aa_lip_all,bb_lip_all,epslip_all,
& eps_all,sigma_all,r0_all,chi_all,chip_all,alp_all,ebr_all,
& d0cm_all,akcm_all,akth_all,akct_all,v1ss_all,v2ss_all,v3ss_all,
& v1sccor_all,v2sccor_all,nbondterm_all,
&nsup,nstart_sup,anatemp,
&nend_sup,chain_length,tabperm(maxperm,maxsym),nperm,
& nstart_seq,ishift_pdb
+ 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
+
integer iscode,indpdb,outpdb,outmol2,icomparfunc,pdbint,
- & ensembles,constr_dist,symetr
+ & ensembles,constr_dist,symetr,
+ & constr_homology,homol_nset,
+ & iset,ihset
+ real*8 waga_homology
+ real*8 waga_dist, waga_angle, waga_theta, waga_d, dist_cut,
+ & dist2_cut
logical refstr,pdbref,punch_dist,print_rms,caonly,verbose,
& merge_helices,bxfile,cxfile,histfile,entfile,zscfile,
- & rmsrgymap,with_dihed_constr,check_conf,histout
+ & rmsrgymap,with_dihed_constr,check_conf,histout,out1file,
+ & read2sigma,l_homo,with_theta_constr
common /cntrl/ iscode,indpdb,refstr,pdbref,outpdb,outmol2,
& punch_dist,print_rms,caonly,verbose,icomparfunc,pdbint,
& merge_helices,bxfile,cxfile,histfile,entfile,zscfile,rmsrgymap,
- & ensembles,with_dihed_constr,constr_dist,check_conf,histout,
- &symetr
+ & ensembles,with_dihed_constr,check_conf,histout,
+ & with_theta_constr,
+ & symetr,
+ & constr_dist,
+ & constr_homology,out1file,homol_nset,read2sigma
+ common /homol/ waga_homology(maxR),
+ & waga_dist,waga_angle,waga_theta,waga_d,dist_cut,dist2_cut,
+ & iset,ihset,l_homo(max_template,maxdim)
+
--- /dev/null
+ real*8 odl(max_template,maxdim),sigma_odl(max_template,maxdim),
+ & dih(max_template,maxres),sigma_dih(max_template,maxres),
+ & sigma_odlir(max_template,maxdim)
+c
+c Specification of new variables used in subroutine e_modeller
+c modified by FP (Nov.,2014)
+ real*8 xxtpl(max_template,maxres),yytpl(max_template,maxres),
+ & zztpl(max_template,maxres),thetatpl(max_template,maxres),
+ & sigma_theta(max_template,maxres),
+ & sigma_d(max_template,maxres)
+c
+
+ integer ires_homo(maxdim),jres_homo(maxdim)
+
+ double precision
+ & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst,
+ & dUdxconst(3,0:MAXRES),dqwol(3,0:MAXRES),dxqwol(3,0:MAXRES),
+ & dutheta(maxres),dugamma(maxres),
+ & duscdiff(3,maxres),
+ & duscdiffx(3,maxres),
+ & uconst_back
+ integer lim_odl,lim_dih,link_start_homo,link_end_homo,
+ & idihconstr_start_homo,idihconstr_end_homo
+c
+c FP (30/10/2014)
+c
+c integer ithetaconstr_start_homo,ithetaconstr_end_homo
+c
+ integer nresn,nyosh,nnos
+ common /back_constr/ uconst_back,uscdiff,
+ & dutheta,dugamma,duscdiff,duscdiffx
+ common /homrestr/ odl,dih,sigma_dih,sigma_odl,
+ & lim_odl,lim_dih,ires_homo,jres_homo,link_start_homo,
+ & link_end_homo,idihconstr_start_homo,idihconstr_end_homo,
+c
+c FP (30/10/2014,04/03/2015)
+c
+ & xxtpl,yytpl,zztpl,thetatpl,sigma_theta,sigma_d,sigma_odlir
+c
C General I/O units & files
integer inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep,irotam,
& itorp,itordp,ifourier,ielep,isidep,iscpp,isccor,icbase,
- & istat,ientin,ientout,isidep1,ibond,ihist,izsc,idistr
+ & istat,ientin,ientout,isidep1,ibond,ihist,izsc,idistr,
+ & iliptranpar
common /iounits/ inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep,
& irotam,itorp,itordp,ifourier,ielep,isidep,iscpp,isccor,
& icbase,istat,ientin,ientout,isidep1,ibond,ihist,izsc,
- & idistr
+ & idistr,iliptranpar
character*256 outname,intname,pdbname,mol2name,statname,intinname,
& entname,restartname,prefix,scratchdir,sidepname,pdbfile,
& histname,zscname
& sidepname,pdbfile,histname,zscname
C Parameter files
character*256 bondname,thetname,rotname,torname,tordname,
- & fouriername,elename,sidename,scpname,sccorname,patname
+ & fouriername,elename,sidename,scpname,sccorname,patname,
+ & liptranname
common /parfiles/ thetname,rotname,torname,tordname,bondname,
- & fouriername,elename,sidename,scpname,sccorname,patname
+ & fouriername,elename,sidename,scpname,sccorname,patname,
+ & liptranname
character*3 pot
C-----------------------------------------------------------------------
C INP - main input file
--- /dev/null
+ double precision r_cut,rlamb
+ common /splitele/ r_cut,rlamb
double precision theta,phi,alph,omeg,vbld,vbld_ref,
& theta_ref,phi_ref,alph_ref,omeg_ref,
& costtab,sinttab,cost2tab,sint2tab,tauangle,omicron,
- & xxtab,yytab,zztab
+ & xxtab,yytab,zztab,
+ & thetaref,phiref,xxref,yyref,zzref
common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres),
- & vbld(2*maxres),
+ & vbld(2*maxres),thetaref(maxres),phiref(maxres),
& costtab(maxres), sinttab(maxres), cost2tab(maxres),
& sint2tab(maxres),xxtab(maxres),yytab(maxres),
- & zztab(maxres),
+ & zztab(maxres),xxref(maxres),yyref(maxres),zzref(maxres),
& ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar,
& omicron(2,maxres),tauangle(3,maxres)
C Angles from experimental structure
C Max. number of AA residues
integer maxres
c parameter (maxres=250)
- parameter (maxres=100)
+ parameter (maxres=800)
C Appr. max. number of interaction sites
integer maxres2
parameter (maxres2=2*maxres)
parameter (maxconts=maxres)
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)
integer nntyp
parameter (nntyp=ntyp*(ntyp+1)/2)
C Max. number of types of dihedral angles & multiplicity of torsional barriers
C Maximum number of terms in SC bond-stretching potential
integer maxbondterm
parameter (maxbondterm=3)
+C Maximum number of templates in homology-modeling restraints
+ integer max_template
+ parameter(max_template=25)
integer MaxR,MaxT_h
integer MaxSlice
parameter (Max_Parm=1)
- parameter (MaxQ=1,MaxQ1=MaxQ+2)
- parameter(MaxR=1,MaxT_h=32)
+ parameter (MaxQ=4,MaxQ1=MaxQ+2)
+ parameter(MaxR=1,MaxT_h=36)
parameter(MaxSlice=40)
integer MaxN
parameter (MaxN=100)
c Maximum number of structures in the database, energy components, proteins,
c and structural classes
c#ifdef JUBL
- parameter (maxstr=200000,max_ene=21,maxprot=7,maxclass=5000)
+ parameter (maxstr=200000,max_ene=25,maxprot=7,maxclass=5000)
parameter (maxclass1=10)
c Maximum number of structures to be dealt with by one processor
parameter (maxstr_proc=10000)
parameter (max_x=200,max_y=200,max_minim=1000)
c Maximum number of processors
integer MaxProcs
- parameter (MaxProcs = 2048)
+ parameter (MaxProcs = 128)
c Maximum number of optimizable parameters
integer max_paropt
parameter (max_paropt=500)
* Derivatives in alpha and omega:
*
do i=2,nres-1
- dsci=dsc(itype(i))
+ dsci=dsc(iabs(itype(i)))
alphi=alph(i)
omegi=omeg(i)
cd print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
implicit none
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.FREE'
include 'COMMON.CONTROL'
include 'COMMON.IOUNITS'
include 'COMMON.CHAIN'
endif
110 format (a,'(',i3,')',9f8.3)
do i=ist,ien-kkk
- iti=itype(i)
+ iti=iabs(itype(i))
if (iti.le.0 .or. iti.gt.ntyp) cycle
do j=i+kkk,ien
- itj=itype(j)
+ itj=iabs(itype(j))
if (itj.le.0 .or. itj.gt.ntyp) cycle
itypi=iti
itypj=itj
it2=itype(i2)
write (iout,'(i3,2x,a,i4,2x,a,i4,5f8.3,3f10.5)')
& i,restyp(it1),i1,restyp(it2),i2,cscore(i),
- & sc_cutoff(it1,it2),ddsc(i),ddla(i),ddlb(i),
+ & sc_cutoff(iabs(it1),iabs(it2)),ddsc(i),ddla(i),ddlb(i),
& omt1(i),omt2(i),omt12(i)
enddo
endif
call xdrffloat_(ixdrf, rt_bath, iret)
call xdrfint_(ixdrf, nss, iret)
do j=1,nss
- call xdrfint_(ixdrf, ihpb(j), iret)
- call xdrfint_(ixdrf, jhpb(j), iret)
+ if (dyn_ss) then
+ call xdrfint(ixdrf, idssb(j), iret)
+ call xdrfint(ixdrf, jdssb(j), iret)
+ idssb(j)=idssb(j)-nres
+ jdssb(j)=jdssb(j)-nres
+ else
+ call xdrfint_(ixdrf, ihpb(j), iret)
+ call xdrfint_(ixdrf, jhpb(j), iret)
+ endif
enddo
call xdrfint_(ixdrf, nprop, iret)
if (umbrella(iparm) .or. read_iset(iparm) .or. hamil_rep)
call xdrffloat(ixdrf, rt_bath, iret)
call xdrfint(ixdrf, nss, iret)
do j=1,nss
- call xdrfint(ixdrf, ihpb(j), iret)
- call xdrfint(ixdrf, jhpb(j), iret)
+ if (dyn_ss) then
+ call xdrfint(ixdrf, idssb(j), iret)
+ call xdrfint(ixdrf, jdssb(j), iret)
+ else
+ call xdrfint(ixdrf, ihpb(j), iret)
+ call xdrfint(ixdrf, jhpb(j), iret)
+ endif
enddo
call xdrfint(ixdrf, nprop, iret)
c write (iout,*) "nprop",nprop
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
include 'DIMENSIONS.COMPAR'
+ include 'DIMENSIONS.FREE'
include 'COMMON.IOUNITS'
include 'COMMON.TIME1'
include 'COMMON.SBRIDGE'
integer snk_p(MaxR,MaxT_h,Max_parm)
logical lerr
character*64 bprotfile_temp
+ integer scount_t(0:maxprocs-1)
call opentmp(islice,ientout,bprotfile_temp)
iii=0
ii=0
enddo
enddo
enddo
+ write (iout,*) "indstart(me1),indend(me1)"
+ &,indstart(me1),indend(me1)
do i=indstart(me1),indend(me1)
#else
do iparm=1,nParmSet
& wtor_d,wsccor,wbond
#endif
call etotal(energia(0),fT)
+ if (constr_homology.gt.0) energia(0)=energia(0)+
+ & waga_homology(iset)*energia(22)
+c write (iout,*) "constr_homology",constr_homology," iset",iset,
+c & " waga_homology",waga_homology(iset)
#ifdef DEBUG
write (iout,*) "Conformation",i
write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
call enerprint(energia(0),fT)
write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21)
- write (iout,*) "ftors",ftors
+ write (iout,*) "ftors(1)",ftors(1)
call briefout(i,energia(0))
temp=1.0d0/(beta_h(ib,ipar)*1.987D-3)
write (iout,*) "temp", temp
endif
endif
potE(iii+1,iparm)=energia(0)
- do k=1,21
+ do k=1,22
enetb(k,iii+1,iparm)=energia(k)
enddo
#ifdef DEBUG
write (iout,*) "Me",me," scount",scount(me)
call flush(iout)
c Master gathers updated numbers of conformations written by all procs.
- call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount(0), 1,
+ call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount_t(0), 1,
& MPI_INTEGER, WHAM_COMM, IERROR)
+ do k=0,nprocs-1
+ scount(k) = scount_t(k)
+ enddo
indstart(0)=1
indend(0)=scount(0)
do i=1, Nprocs-1
include "COMMON.ENERGIES"
include "COMMON.COMPAR"
include "COMMON.PROT"
+ include "COMMON.CONTACTS1"
character*64 nazwa
character*80 bxname,cxname
character*64 bprotfile_temp
double precision energ
integer ilen,iroof
external ilen,iroof
- integer ir,ib,iparm
+ integer ir,ib,iparm, scount_buff(0:99)
+ integer isecstr(maxres)
write (licz2,'(bz,i2.2)') islice
call opentmp(islice,ientout,bprotfile_temp)
write (iout,*) "bprotfile_temp ",bprotfile_temp
iscore=0
c write (iout,*) "Calling conf_compar",i
c call flush(iout)
+ anatemp= 1.0d0/(beta_h(ib,iparm)*1.987D-3)
if (indpdb.gt.0) then
call conf_compar(i,.false.,.true.)
+c else
+c call elecont(.false.,ncont,icont,nnt,nct)
+c call secondary2(.false.,.false.,ncont,icont,isecstr)
endif
c write (iout,*) "Exit conf_compar",i
c call flush(iout)
c call flush(iout)
call xdrfint_(ixdrf, nss, iret)
do j=1,nss
- call xdrfint_(ixdrf, ihpb(j), iret)
- call xdrfint_(ixdrf, jhpb(j), iret)
+ if (dyn_ss) then
+ call xdrfint(ixdrf, idssb(j)+nres, iret)
+ call xdrfint(ixdrf, jdssb(j)+nres, iret)
+ else
+ call xdrfint_(ixdrf, ihpb(j), iret)
+ call xdrfint_(ixdrf, jhpb(j), iret)
+ endif
enddo
call xdrffloat_(ixdrf,real(eini),iret)
call xdrffloat_(ixdrf,real(efree),iret)
call xdrfint(ixdrf, nss, iret)
do j=1,nss
- call xdrfint(ixdrf, ihpb(j), iret)
- call xdrfint(ixdrf, jhpb(j), iret)
+ if (dyn_ss) then
+ call xdrfint(ixdrf, idssb(j)+nres, iret)
+ call xdrfint(ixdrf, jdssb(j)+nres, iret)
+ else
+ call xdrfint(ixdrf, ihpb(j), iret)
+ call xdrfint(ixdrf, jhpb(j), iret)
+ endif
enddo
call xdrffloat(ixdrf,real(eini),iret)
call xdrffloat(ixdrf,real(efree),iret)
endif
call int_from_cart1(.false.)
do j=nnt+1,nct
- if (itype(j-1).ne.21 .and. itype(j).ne.21 .and.
- & (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0)) then
+ if (itype(j-1).ne.ntyp1 .and. itype(j).ne.ntyp1 .and.
+ & (vbld(j).lt.2.0d0 .or. vbld(j).gt.6.0d0)) then
if (iprint.gt.0)
& write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),
& " for conformation",ii
enddo
do j=nnt,nct
itj=itype(j)
- if (itype(j).ne.10 .and.itype(j).ne.21 .and.
- & (vbld(nres+j)-dsc(itj)).gt.2.0d0) then
+ if (itype(j).ne.10 .and.itype(j).ne.ntyp1 .and.
+ & (vbld(nres+j)-dsc(iabs(itj))).gt.5.0d0) then
if (iprint.gt.0)
& write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j),
& " for conformation",ii
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.FREE'
#ifndef ISNAN
external proc_proc
include 'COMMON.INTERACT'
include 'COMMON.SBRIDGE'
include 'COMMON.CHAIN'
+ include 'COMMON.CONTROL'
double precision fact(6)
cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
cd print *,'nnt=',nnt,' nct=',nct
call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
c print *,ecorr,ecorr5,ecorr6,eturn6
+ else
+ ecorr=0.0d0
+ ecorr5=0.0d0
+ ecorr6=0.0d0
+ eturn6=0.0d0
endif
if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
endif
+c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology
+ if (constr_homology.ge.1) then
+ call e_modeller(ehomology_constr)
+ else
+ ehomology_constr=0.0d0
+ endif
+
+c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
#ifdef SPLITELE
etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
& +wvdwpp*evdw1
& +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
- & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
+ & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
& +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
& +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
& +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
& +welec*fact(1)*(ees+evdw1)
& +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
- & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
+ & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
& +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
& +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
& +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
energia(19)=esccor
energia(20)=edihcnstr
energia(21)=evdw_t
+ energia(22)=ehomology_constr
c detecting NaNQ
#ifdef ISNAN
#ifdef AIX
#ifdef MPL
c endif
#endif
+#define DEBUG
+#ifdef DEBUG
+ call enerprint(energia,fact)
+#endif
+#undef DEBUG
if (calc_grad) then
C
C Sum up the components of the Cartesian gradient.
& wcorr6*fact(5)*gradcorr6(j,i)+
& wturn6*fact(5)*gcorr6_turn(j,i)+
& wsccor*fact(2)*gsccorc(j,i)
+ & +wliptran*gliptranc(j,i)
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)+
& wcorr6*fact(5)*gradcorr6(j,i)+
& wturn6*fact(5)*gcorr6_turn(j,i)+
& wsccor*fact(2)*gsccorc(j,i)
+ & +wliptran*gliptranc(j,i)
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*fact(1)*gsccorx(j,i)
+ & +wliptran*gliptranx(j,i)
enddo
#endif
enddo
& +wturn3*fact(2)*gel_loc_turn3(i)
& +wturn6*fact(5)*gel_loc_turn6(i)
& +wel_loc*fact(2)*gel_loc_loc(i)
+c & +wsccor*fact(1)*gsccor_loc(i)
+c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
enddo
endif
+ if (dyn_ss) call dyn_set_nss
return
end
C------------------------------------------------------------------------
esccor=energia(19)
edihcnstr=energia(20)
estr=energia(18)
+ ehomology_constr=energia(22)
#ifdef SPLITELE
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
& wvdwpp,
& ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
& eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
& eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
- & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
+ & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss,etot
10 format (/'Virtual-chain energies:'//
& 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
& 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
& 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
& 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
& 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
+ & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
& 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
& 'ETOT= ',1pE16.6,' (total)')
#else
& ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
& eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
& eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
- & edihcnstr,ebr*nss,etot
+ & edihcnstr,ehomology_constr,ebr*nss,
+ & etot
10 format (/'Virtual-chain energies:'//
& 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
& 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
& 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
& 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
& 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
+ & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
& 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
& 'ETOT= ',1pE16.6,' (total)')
#endif
evdw=0.0D0
evdw_t=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)
+ e1=fac*fac*aa
+ e2=fac*bb
evdwij=e1+e2
ij=icant(itypi,itypj)
eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- if (bb(itypi,itypj).gt.0.0d0) then
+ if (bb.gt.0.0d0) then
evdw=evdw+evdwij
else
evdw_t=evdw_t+evdwij
evdw=0.0D0
evdw_t=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)
+ e1=fac*fac*aa
+ e2=fac*bb
evdwij=e_augm+e1+e2
ij=icant(itypi,itypj)
eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- if (bb(itypi,itypj).gt.0.0d0) then
+ if (bb.gt.0.0d0) then
evdw=evdw+evdwij
else
evdw_t=evdw_t+evdwij
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
dscj_inv=vbld_inv(j+nres)
chi1=chi(itypi,itypj)
chi2=chi(itypj,itypi)
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
eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
& /dabs(eps(itypi,itypj))
eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
- if (bb(itypi,itypj).gt.0.0d0) then
+ if (bb.gt.0.0d0) then
evdw=evdw+evdwij
else
evdw_t=evdw_t+evdwij
endif
if (calc_grad) then
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),15(0pf7.3))')
& restyp(itypi),i,restyp(itypj),j,
& epsi,sigm,chi1,chi2,chip1,chip2,
include 'COMMON.ENEPS'
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
+ include 'COMMON.SBRIDGE'
logical lprn
common /srutu/icall
- integer icant
+ integer icant,xshift,yshift,zshift
external icant
do i=1,210
do j=1,2
c if (icall.gt.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)
+C returning the ith atom to box
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
+ if ((zi.gt.bordlipbot)
+ &.and.(zi.lt.bordliptop)) then
+C the energy transfer exist
+ if (zi.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((zi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipi=1.0d0
+ ssgradlipi=0.0
+ endif
+ else
+ sslipi=0.0d0
+ ssgradlipi=0.0
+ endif
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
C
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
+ IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
+ call dyn_ssbond_ene(i,j,evdwij)
+ evdw=evdw+evdwij
+C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
+C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
+C triple bond artifac removal
+ do k=j+1,iend(i,iint)
+C search over all next residues
+ if (dyn_ss_mask(k)) then
+C check if they are cysteins
+C write(iout,*) 'k=',k
+ call triple_ssbond_ene(i,j,k,evdwij)
+C call the energy function that removes the artifical triple disulfide
+C bond the soubroutine is located in ssMD.F
+ evdw=evdw+evdwij
+C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
+C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
+ endif!dyn_ss_mask(k)
+ enddo! k
+ ELSE
ind=ind+1
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
dscj_inv=vbld_inv(j+nres)
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
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+C returning jth atom to box
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.gt.bordlipbot)
+ &.and.(zj.lt.bordliptop)) then
+C the energy transfer exist
+ if (zj.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((zj-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zj.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipj=1.0d0
+ ssgradlipj=0.0
+ endif
+ else
+ sslipj=0.0d0
+ ssgradlipj=0.0
+ endif
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+C if (aa.ne.aa_aq(itypi,itypj)) then
+
+C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
+C & bb_aq(itypi,itypj)-bb,
+C & sslipi,sslipj
+C endif
+
+C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
+C checking the distance
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+C finding the closest
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
+
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
c write (iout,*) i,j,xj,yj,zj
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))
+ if (sss.le.0.0) cycle
C Calculate angle-dependent terms of energy and contributions to their
C derivatives.
+
call sc_angular
sigsq=1.0D0/sigsq
sig=sig0ij*dsqrt(sigsq)
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
- if (bb(itypi,itypj).gt.0) then
- evdw=evdw+evdwij
+ if (bb.gt.0) then
+ evdw=evdw+evdwij*sss
else
- evdw_t=evdw_t+evdwij
+ evdw_t=evdw_t+evdwij*sss
endif
ij=icant(itypi,itypj)
aux=eps1*eps2rt**2*eps3rt**2
c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
c & aux*e2/eps(itypi,itypj)
c 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
+C#define DEBUG
#ifdef DEBUG
write (iout,'(2(a3,i3,2x),17(0pf7.3))')
& restyp(itypi),i,restyp(itypj),j,
& evdwij
write (iout,*) "partial sum", evdw, evdw_t
#endif
+C#undef DEBUG
c endif
if (calc_grad) then
C Calculate gradient components.
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
C Calculate angular part of the gradient.
call sc_grad
endif
+C write(iout,*) "partial sum", evdw, evdw_t
+ ENDIF ! dyn_ss
enddo ! j
enddo ! iint
enddo ! i
c if (icall.gt.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)
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
dscj_inv=vbld_inv(j+nres)
sig0ij=sigma(itypi,itypj)
r0ij=r0(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
fac_augm=rrij**expon
e_augm=augm(itypi,itypj)*fac_augm
evdwij=evdwij*eps2rt*eps3rt
- if (bb(itypi,itypj).gt.0.0d0) then
+ if (bb.gt.0.0d0) then
evdw=evdw+evdwij+e_augm
else
evdw_t=evdw_t+evdwij+e_augm
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.FREE'
include 'COMMON.CONTROL'
include 'COMMON.IOUNITS'
include 'COMMON.GEO'
gcorr_loc(i)=0.0d0
enddo
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
+ & .or. ((i+2).gt.nres)
+ & .or. ((i-1).le.0)
+ & .or. itype(i+2).eq.ntyp1
+ & .or. itype(i-1).eq.ntyp1
+ &) cycle
+C endif
if (itel(i).eq.0) goto 1215
dxi=dc(1,i)
dyi=dc(2,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)
+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 (j.le.1) cycle
+ if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
+ & .or.((j+2).gt.nres)
+ & .or.((j-1).le.0)
+ & .or.itype(j+2).eq.ntyp1
+ & .or.itype(j-1).eq.ntyp1
+ &) cycle
if (itel(j).eq.0) goto 1216
ind=ind+1
iteli=itel(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)
+ 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
+ sss=sscale(sqrt(rij))
+ sssgrad=sscagrad(sqrt(rij))
rrmij=1.0D0/rij
rij=dsqrt(rij)
rmij=1.0D0/rij
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,
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
& aggj(3,4),aggj1(3,4),a_temp(2,2)
common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
if (j.eq.i+2) then
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+C changes suggested by Ana to avoid out of bounds
+C & .or.((i+5).gt.nres)
+C & .or.((i-1).le.0)
+C end of changes suggested by Ana
+ & .or. itype(i+2).eq.ntyp1
+ & .or. itype(i+3).eq.ntyp1
+C & .or. itype(i+5).eq.ntyp1
+C & .or. itype(i).eq.ntyp1
+C & .or. itype(i-1).eq.ntyp1
+ & ) goto 179
+
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Third-order contributions
& +0.5d0*(pizda(1,1)+pizda(2,2))
enddo
endif
- else if (j.eq.i+3 .and. itype(i+2).ne.21) then
+ 179 continue
+ else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+C changes suggested by Ana to avoid out of bounds
+C & .or.((i+5).gt.nres)
+C & .or.((i-1).le.0)
+C end of changes suggested by Ana
+ & .or. itype(i+3).eq.ntyp1
+ & .or. itype(i+4).eq.ntyp1
+C & .or. itype(i+5).eq.ntyp1
+ & .or. itype(i).eq.ntyp1
+C & .or. itype(i-1).eq.ntyp1
+ & ) goto 178
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Fourth-order contributions
gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
enddo
endif
+ 178 continue
endif
return
end
c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
c & ' scal14',scal14
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)
c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
xi=0.5D0*(c(1,i)+c(1,i+1))
yi=0.5D0*(c(2,i)+c(2,i+1))
zi=0.5D0*(c(3,i)+c(3,i+1))
-
+C Returning the ith atom to box
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
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)
+C returning the jth atom to box
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+C Finding the closest jth atom
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+C sss is scaling function for smoothing the cutoff gradient otherwise
+C the gradient would not be continuouse
+ sss=sscale(1.0d0/(dsqrt(rrij)))
+ 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
-c write (iout,*) i,j,evdwij
- evdw2=evdw2+evdwij
+c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
+c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
+c & bad(itypj,iteli)
+ evdw2=evdw2+evdwij*sss
if (calc_grad) then
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
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.FREE'
include 'COMMON.SBRIDGE'
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.VAR'
include 'COMMON.INTERACT'
+ include 'COMMON.CONTROL'
+ include 'COMMON.IOUNITS'
dimension ggg(3)
ehpb=0.0D0
cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
cd print *,'link_start=',link_start,' link_end=',link_end
+C write(iout,*) link_end, "link_end"
if (link_end.eq.0) return
do i=link_start,link_end
C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
endif
C 24/11/03 AL: SS bridges handled separately because of introducing a specific
C distance and angle dependent SS bond potential.
- if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
+C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
+C & iabs(itype(jjj)).eq.1) then
+C write(iout,*) constr_dist,"const"
+ if (.not.dyn_ss .and. i.le.nss) then
+ if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
+ & iabs(itype(jjj)).eq.1) then
call ssbond_ene(iii,jjj,eij)
ehpb=ehpb+2*eij
- else
-C Calculate the distance between the two points and its difference from the
-C target distance.
- dd=dist(ii,jj)
- rdis=dd-dhpb(i)
+ endif !ii.gt.neres
+ else if (ii.gt.nres .and. jj.gt.nres) then
+c Restraints from contact prediction
+ dd=dist(ii,jj)
+ if (constr_dist.eq.11) then
+C ehpb=ehpb+fordepth(i)**4.0d0
+C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
+ ehpb=ehpb+fordepth(i)**4.0d0
+ & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
+ fac=fordepth(i)**4.0d0
+ & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
+C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
+C & ehpb,fordepth(i),dd
+C write(iout,*) ehpb,"atu?"
+C ehpb,"tu?"
+C fac=fordepth(i)**4.0d0
+C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
+ else
+ if (dhpb1(i).gt.0.0d0) then
+ ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
+c write (iout,*) "beta nmr",
+c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ else
+ dd=dist(ii,jj)
+ rdis=dd-dhpb(i)
+C Get the force constant corresponding to this distance.
+ waga=forcon(i)
+C Calculate the contribution to energy.
+ ehpb=ehpb+waga*rdis*rdis
+c write (iout,*) "beta reg",dd,waga*rdis*rdis
+C
+C Evaluate gradient.
+C
+ fac=waga*rdis/dd
+ endif !end dhpb1(i).gt.0
+ endif !end const_dist=11
+ do j=1,3
+ ggg(j)=fac*(c(j,jj)-c(j,ii))
+ enddo
+ do j=1,3
+ ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
+ ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
+ enddo
+ do k=1,3
+ ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
+ ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
+ enddo
+ else !ii.gt.nres
+C write(iout,*) "before"
+ dd=dist(ii,jj)
+C write(iout,*) "after",dd
+ if (constr_dist.eq.11) then
+ ehpb=ehpb+fordepth(i)**4.0d0
+ & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
+ fac=fordepth(i)**4.0d0
+ & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
+C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
+C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
+C print *,ehpb,"tu?"
+C write(iout,*) ehpb,"btu?",
+C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
+C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
+C & ehpb,fordepth(i),dd
+ else
+ if (dhpb1(i).gt.0.0d0) then
+ ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
+c write (iout,*) "alph nmr",
+c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ else
+ rdis=dd-dhpb(i)
C Get the force constant corresponding to this distance.
- waga=forcon(i)
+ waga=forcon(i)
C Calculate the contribution to energy.
- ehpb=ehpb+waga*rdis*rdis
+ ehpb=ehpb+waga*rdis*rdis
+c write (iout,*) "alpha reg",dd,waga*rdis*rdis
C
C Evaluate gradient.
C
- fac=waga*rdis/dd
-cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
-cd & ' waga=',waga,' fac=',fac
+ fac=waga*rdis/dd
+ endif
+ endif
+
do j=1,3
ggg(j)=fac*(c(j,jj)-c(j,ii))
enddo
enddo
endif
enddo
- ehpb=0.5D0*ehpb
+ if (constr_dist.ne.11) ehpb=0.5D0*ehpb
return
end
C--------------------------------------------------------------------------
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)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
dsci_inv=dsc_inv(itypi)
- itypj=itype(j)
+ itypj=iabs(itype(j))
dscj_inv=dsc_inv(itypj)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
return
end
C--------------------------------------------------------------------------
+c MODELLER restraint function
+ subroutine e_modeller(ehomology_constr)
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.FREE'
+ integer nnn, i, j, k, ki, irec, l
+ integer katy, odleglosci, test7
+ real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
+ real*8 distance(max_template),distancek(max_template),
+ & min_odl,godl(max_template),dih_diff(max_template)
+
+c
+c FP - 30/10/2014 Temporary specifications for homology restraints
+c
+ double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
+ & sgtheta
+ double precision, dimension (maxres) :: guscdiff,usc_diff
+ double precision, dimension (max_template) ::
+ & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
+ & theta_diff
+
+ include 'COMMON.SBRIDGE'
+ include 'COMMON.CHAIN'
+ include 'COMMON.GEO'
+ include 'COMMON.DERIV'
+ include 'COMMON.LOCAL'
+ include 'COMMON.INTERACT'
+ include 'COMMON.VAR'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.CONTROL'
+ include 'COMMON.HOMRESTR'
+c
+ include 'COMMON.SETUP'
+ include 'COMMON.NAMES'
+
+ do i=1,max_template
+ distancek(i)=9999999.9
+ enddo
+
+ odleg=0.0d0
+
+c Pseudo-energy and gradient from homology restraints (MODELLER-like
+c function)
+C AL 5/2/14 - Introduce list of restraints
+c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
+#ifdef DEBUG
+ write(iout,*) "------- dist restrs start -------"
+#endif
+ do ii = link_start_homo,link_end_homo
+ i = ires_homo(ii)
+ j = jres_homo(ii)
+ dij=dist(i,j)
+c write (iout,*) "dij(",i,j,") =",dij
+ do k=1,constr_homology
+ if(.not.l_homo(k,ii)) cycle
+ distance(k)=odl(k,ii)-dij
+c write (iout,*) "distance(",k,") =",distance(k)
+c
+c For Gaussian-type Urestr
+c
+ distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
+c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
+c write (iout,*) "distancek(",k,") =",distancek(k)
+c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
+c
+c For Lorentzian-type Urestr
+c
+ if (waga_dist.lt.0.0d0) then
+ sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
+ distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
+ & (distance(k)**2+sigma_odlir(k,ii)**2))
+ endif
+ enddo
+
+c min_odl=minval(distancek)
+ do kk=1,constr_homology
+ if(l_homo(kk,ii)) then
+ min_odl=distancek(kk)
+ exit
+ endif
+ enddo
+ do kk=1,constr_homology
+ if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
+ & min_odl=distancek(kk)
+ enddo
+c write (iout,* )"min_odl",min_odl
+#ifdef DEBUG
+ write (iout,*) "ij dij",i,j,dij
+ write (iout,*) "distance",(distance(k),k=1,constr_homology)
+ write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
+ write (iout,* )"min_odl",min_odl
+#endif
+ odleg2=0.0d0
+ do k=1,constr_homology
+c Nie wiem po co to liczycie jeszcze raz!
+c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
+c & (2*(sigma_odl(i,j,k))**2))
+ if(.not.l_homo(k,ii)) cycle
+ if (waga_dist.ge.0.0d0) then
+c
+c For Gaussian-type Urestr
+c
+ godl(k)=dexp(-distancek(k)+min_odl)
+ odleg2=odleg2+godl(k)
+c
+c For Lorentzian-type Urestr
+c
+ else
+ odleg2=odleg2+distancek(k)
+ endif
+
+ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
+ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
+ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
+ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
+
+ enddo
+c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
+c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
+#ifdef DEBUG
+ write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
+ write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
+#endif
+ if (waga_dist.ge.0.0d0) then
+c
+c For Gaussian-type Urestr
+c
+ odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
+c
+c For Lorentzian-type Urestr
+c
+ else
+ odleg=odleg+odleg2/constr_homology
+ endif
+c
+#ifdef GRAD
+c write (iout,*) "odleg",odleg ! sum of -ln-s
+c Gradient
+c
+c For Gaussian-type Urestr
+c
+ if (waga_dist.ge.0.0d0) sum_godl=odleg2
+ sum_sgodl=0.0d0
+ do k=1,constr_homology
+c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
+c & *waga_dist)+min_odl
+c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
+c
+ if(.not.l_homo(k,ii)) cycle
+ if (waga_dist.ge.0.0d0) then
+c For Gaussian-type Urestr
+c
+ sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
+c
+c For Lorentzian-type Urestr
+c
+ else
+ sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
+ & sigma_odlir(k,ii)**2)**2)
+ endif
+ sum_sgodl=sum_sgodl+sgodl
+
+c sgodl2=sgodl2+sgodl
+c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
+c write(iout,*) "constr_homology=",constr_homology
+c write(iout,*) i, j, k, "TEST K"
+ enddo
+ if (waga_dist.ge.0.0d0) then
+c
+c For Gaussian-type Urestr
+c
+ grad_odl3=waga_homology(iset)*waga_dist
+ & *sum_sgodl/(sum_godl*dij)
+c
+c For Lorentzian-type Urestr
+c
+ else
+c Original grad expr modified by analogy w Gaussian-type Urestr grad
+c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
+ grad_odl3=-waga_homology(iset)*waga_dist*
+ & sum_sgodl/(constr_homology*dij)
+ endif
+c
+c grad_odl3=sum_sgodl/(sum_godl*dij)
+
+
+c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
+c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
+c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
+
+ccc write(iout,*) godl, sgodl, grad_odl3
+
+c grad_odl=grad_odl+grad_odl3
+
+ do jik=1,3
+ ggodl=grad_odl3*(c(jik,i)-c(jik,j))
+ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
+ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
+ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
+ ghpbc(jik,i)=ghpbc(jik,i)+ggodl
+ ghpbc(jik,j)=ghpbc(jik,j)-ggodl
+ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
+ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
+c if (i.eq.25.and.j.eq.27) then
+c write(iout,*) "jik",jik,"i",i,"j",j
+c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
+c write(iout,*) "grad_odl3",grad_odl3
+c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
+c write(iout,*) "ggodl",ggodl
+c write(iout,*) "ghpbc(",jik,i,")",
+c & ghpbc(jik,i),"ghpbc(",jik,j,")",
+c & ghpbc(jik,j)
+c endif
+ enddo
+#endif
+ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
+ccc & dLOG(odleg2),"-odleg=", -odleg
+
+ enddo ! ii-loop for dist
+#ifdef DEBUG
+ write(iout,*) "------- dist restrs end -------"
+c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
+c & waga_d.eq.1.0d0) call sum_gradient
+#endif
+c Pseudo-energy and gradient from dihedral-angle restraints from
+c homology templates
+c write (iout,*) "End of distance loop"
+c call flush(iout)
+ kat=0.0d0
+c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
+#ifdef DEBUG
+ write(iout,*) "------- dih restrs start -------"
+ do i=idihconstr_start_homo,idihconstr_end_homo
+ write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
+ enddo
+#endif
+ do i=idihconstr_start_homo,idihconstr_end_homo
+ kat2=0.0d0
+c betai=beta(i,i+1,i+2,i+3)
+ betai = phi(i+3)
+c write (iout,*) "betai =",betai
+ do k=1,constr_homology
+ dih_diff(k)=pinorm(dih(k,i)-betai)
+c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
+c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
+c & -(6.28318-dih_diff(i,k))
+c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
+c & 6.28318+dih_diff(i,k)
+
+ kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
+c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
+ gdih(k)=dexp(kat3)
+ kat2=kat2+gdih(k)
+c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
+c write(*,*)""
+ enddo
+c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
+c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
+#ifdef DEBUG
+ write (iout,*) "i",i," betai",betai," kat2",kat2
+ write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
+#endif
+ if (kat2.le.1.0d-14) cycle
+ kat=kat-dLOG(kat2/constr_homology)
+c write (iout,*) "kat",kat ! sum of -ln-s
+
+ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
+ccc & dLOG(kat2), "-kat=", -kat
+
+#ifdef GRAD
+c ----------------------------------------------------------------------
+c Gradient
+c ----------------------------------------------------------------------
+
+ sum_gdih=kat2
+ sum_sgdih=0.0d0
+ do k=1,constr_homology
+ sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
+c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
+ sum_sgdih=sum_sgdih+sgdih
+ enddo
+c grad_dih3=sum_sgdih/sum_gdih
+ grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
+
+c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
+ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
+ccc & gloc(nphi+i-3,icg)
+ gloc(i,icg)=gloc(i,icg)+grad_dih3
+c if (i.eq.25) then
+c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
+c endif
+ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
+ccc & gloc(nphi+i-3,icg)
+#endif
+ enddo ! i-loop for dih
+#ifdef DEBUG
+ write(iout,*) "------- dih restrs end -------"
+#endif
+
+c Pseudo-energy and gradient for theta angle restraints from
+c homology templates
+c FP 01/15 - inserted from econstr_local_test.F, loop structure
+c adapted
+
+c
+c For constr_homology reference structures (FP)
+c
+c Uconst_back_tot=0.0d0
+ Eval=0.0d0
+ Erot=0.0d0
+c Econstr_back legacy
+#ifdef GRAD
+ do i=1,nres
+c do i=ithet_start,ithet_end
+ dutheta(i)=0.0d0
+c enddo
+c do i=loc_start,loc_end
+ do j=1,3
+ duscdiff(j,i)=0.0d0
+ duscdiffx(j,i)=0.0d0
+ enddo
+ enddo
+#endif
+c
+c do iref=1,nref
+c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
+c write (iout,*) "waga_theta",waga_theta
+ if (waga_theta.gt.0.0d0) then
+#ifdef DEBUG
+ write (iout,*) "usampl",usampl
+ write(iout,*) "------- theta restrs start -------"
+c do i=ithet_start,ithet_end
+c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
+c enddo
+#endif
+c write (iout,*) "maxres",maxres,"nres",nres
+
+ do i=ithet_start,ithet_end
+c
+c do i=1,nfrag_back
+c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
+c
+c Deviation of theta angles wrt constr_homology ref structures
+c
+ utheta_i=0.0d0 ! argument of Gaussian for single k
+ gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
+c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
+c over residues in a fragment
+c write (iout,*) "theta(",i,")=",theta(i)
+ do k=1,constr_homology
+c
+c dtheta_i=theta(j)-thetaref(j,iref)
+c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
+ theta_diff(k)=thetatpl(k,i)-theta(i)
+c
+ utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
+c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
+ gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
+ gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
+c Gradient for single Gaussian restraint in subr Econstr_back
+c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
+c
+ enddo
+c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
+c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
+
+c
+#ifdef GRAD
+c Gradient for multiple Gaussian restraint
+ sum_gtheta=gutheta_i
+ sum_sgtheta=0.0d0
+ do k=1,constr_homology
+c New generalized expr for multiple Gaussian from Econstr_back
+ sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
+c
+c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
+ sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
+ enddo
+c
+c Final value of gradient using same var as in Econstr_back
+ dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
+ & *waga_homology(iset)
+c dutheta(i)=sum_sgtheta/sum_gtheta
+c
+c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
+#endif
+ Eval=Eval-dLOG(gutheta_i/constr_homology)
+c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
+c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
+c Uconst_back=Uconst_back+utheta(i)
+ enddo ! (i-loop for theta)
+#ifdef DEBUG
+ write(iout,*) "------- theta restrs end -------"
+#endif
+ endif
+c
+c Deviation of local SC geometry
+c
+c Separation of two i-loops (instructed by AL - 11/3/2014)
+c
+c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
+c write (iout,*) "waga_d",waga_d
+
+#ifdef DEBUG
+ write(iout,*) "------- SC restrs start -------"
+ write (iout,*) "Initial duscdiff,duscdiffx"
+ do i=loc_start,loc_end
+ write (iout,*) i,(duscdiff(jik,i),jik=1,3),
+ & (duscdiffx(jik,i),jik=1,3)
+ enddo
+#endif
+ do i=loc_start,loc_end
+ usc_diff_i=0.0d0 ! argument of Gaussian for single k
+ guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
+c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
+c write(iout,*) "xxtab, yytab, zztab"
+c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
+ do k=1,constr_homology
+c
+ dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
+c Original sign inverted for calc of gradients (s. Econstr_back)
+ dyy=-yytpl(k,i)+yytab(i) ! ibid y
+ dzz=-zztpl(k,i)+zztab(i) ! ibid z
+c write(iout,*) "dxx, dyy, dzz"
+c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
+c
+ usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
+c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
+c uscdiffk(k)=usc_diff(i)
+ guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
+ guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
+c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
+c & xxref(j),yyref(j),zzref(j)
+ enddo
+c
+c Gradient
+c
+c Generalized expression for multiple Gaussian acc to that for a single
+c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
+c
+c Original implementation
+c sum_guscdiff=guscdiff(i)
+c
+c sum_sguscdiff=0.0d0
+c do k=1,constr_homology
+c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
+c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
+c sum_sguscdiff=sum_sguscdiff+sguscdiff
+c enddo
+c
+c Implementation of new expressions for gradient (Jan. 2015)
+c
+c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
+#ifdef GRAD
+ do k=1,constr_homology
+c
+c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
+c before. Now the drivatives should be correct
+c
+ dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
+c Original sign inverted for calc of gradients (s. Econstr_back)
+ dyy=-yytpl(k,i)+yytab(i) ! ibid y
+ dzz=-zztpl(k,i)+zztab(i) ! ibid z
+c
+c New implementation
+c
+ sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
+ & sigma_d(k,i) ! for the grad wrt r'
+c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
+c
+c
+c New implementation
+ sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
+ do jik=1,3
+ duscdiff(jik,i-1)=duscdiff(jik,i-1)+
+ & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
+ & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
+ duscdiff(jik,i)=duscdiff(jik,i)+
+ & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
+ & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
+ duscdiffx(jik,i)=duscdiffx(jik,i)+
+ & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
+ & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
+c
+#ifdef DEBUG
+ write(iout,*) "jik",jik,"i",i
+ write(iout,*) "dxx, dyy, dzz"
+ write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
+ write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
+c write(iout,*) "sum_sguscdiff",sum_sguscdiff
+cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
+c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
+c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
+c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
+c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
+c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
+c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
+c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
+c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
+c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
+c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
+c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
+c endif
+#endif
+ enddo
+ enddo
+#endif
+c
+c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
+c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
+c
+c write (iout,*) i," uscdiff",uscdiff(i)
+c
+c Put together deviations from local geometry
+
+c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
+c & wfrag_back(3,i,iset)*uscdiff(i)
+ Erot=Erot-dLOG(guscdiff(i)/constr_homology)
+c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
+c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
+c Uconst_back=Uconst_back+usc_diff(i)
+c
+c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
+c
+c New implment: multiplied by sum_sguscdiff
+c
+
+ enddo ! (i-loop for dscdiff)
+
+c endif
+
+#ifdef DEBUG
+ write(iout,*) "------- SC restrs end -------"
+ write (iout,*) "------ After SC loop in e_modeller ------"
+ do i=loc_start,loc_end
+ write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
+ write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
+ enddo
+ if (waga_theta.eq.1.0d0) then
+ write (iout,*) "in e_modeller after SC restr end: dutheta"
+ do i=ithet_start,ithet_end
+ write (iout,*) i,dutheta(i)
+ enddo
+ endif
+ if (waga_d.eq.1.0d0) then
+ write (iout,*) "e_modeller after SC loop: duscdiff/x"
+ do i=1,nres
+ write (iout,*) i,(duscdiff(j,i),j=1,3)
+ write (iout,*) i,(duscdiffx(j,i),j=1,3)
+ enddo
+ endif
+#endif
+
+c Total energy from homology restraints
+#ifdef DEBUG
+ write (iout,*) "odleg",odleg," kat",kat
+ write (iout,*) "odleg",odleg," kat",kat
+ write (iout,*) "Eval",Eval," Erot",Erot
+ write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
+ write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
+ write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
+#endif
+c
+c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
+c
+c ehomology_constr=odleg+kat
+c
+c For Lorentzian-type Urestr
+c
+
+ if (waga_dist.ge.0.0d0) then
+c
+c For Gaussian-type Urestr
+c
+c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
+c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
+ ehomology_constr=waga_dist*odleg+waga_angle*kat+
+ & waga_theta*Eval+waga_d*Erot
+c write (iout,*) "ehomology_constr=",ehomology_constr
+ else
+c
+c For Lorentzian-type Urestr
+c
+c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
+c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
+ ehomology_constr=-waga_dist*odleg+waga_angle*kat+
+ & waga_theta*Eval+waga_d*Erot
+c write (iout,*) "ehomology_constr=",ehomology_constr
+ endif
+#ifdef DEBUG
+ write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
+ & "Eval",waga_theta,eval,
+ & "Erot",waga_d,Erot
+ write (iout,*) "ehomology_constr",ehomology_constr
+#endif
+ return
+
+ 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
+ 747 format(a12,i4,i4,i4,f8.3,f8.3)
+ 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
+ 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
+ 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
+ & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
+ end
+c-----------------------------------------------------------------------
subroutine ebond(estr)
c
c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.FREE'
include 'COMMON.LOCAL'
include 'COMMON.GEO'
include 'COMMON.INTERACT'
estr1=0.0d0
c write (iout,*) "distchainmax",distchainmax
do i=nnt+1,nct
- 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,vbld(i),distchainmax,
- & 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,vbld(i),distchainmax,
+C & gnmr1(vbld(i),-1.0d0,distchainmax)
+C else
+ if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
+ diff = vbld(i)-vbldpDUM
+C write(iout,*) i,diff
+ else
diff = vbld(i)-vbldp0
c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
+ endif
estr=estr+diff*diff
do j=1,3
gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
enddo
- endif
-
+C endif
+C write (iout,'(a7,i5,4f7.3)')
+C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
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=nnt,nct
- 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)
-c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
-c & AKSC(1,iti),AKSC(1,iti)*diff*diff
+C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
+C & AKSC(1,iti),AKSC(1,iti)*diff*diff
estr=estr+0.5d0*AKSC(1,iti)*diff*diff
do j=1,3
gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
c write (*,'(a,i2)') 'EBEND ICG=',icg
c write (iout,*) ithet_start,ithet_end
do i=ithet_start,ithet_end
- if (itype(i-1).eq.21) cycle
+C if (itype(i-1).eq.ntyp1) cycle
+ if (i.le.2) 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.eq.3) then
+ y(1)=0.0D0
+ y(2)=0.0D0
+ else
+
+ if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
#ifdef OSF
phii=phi(i)
- icrc=0
- call proc_proc(phii,icrc)
+c icrc=0
+c call proc_proc(phii,icrc)
if (icrc.eq.1) phii=150.0
#else
phii=phi(i)
y(1)=0.0D0
y(2)=0.0D0
endif
- if (i.lt.nres .and. itype(i).ne.21) then
+ endif
+ if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
#ifdef OSF
phii1=phi(i+1)
- icrc=0
- call proc_proc(phii1,icrc)
+c icrc=0
+c call proc_proc(phii1,icrc)
if (icrc.eq.1) phii1=150.0
phii1=pinorm(phii1)
z(1)=cos(phii1)
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)
+ 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)
enddo
c write (iout,*) "thet_pred_mean",thet_pred_mean
thet_pred_mean=thet_pred_mean*ss+a0thet(it)
c write (iout,*) "thet_pred_mean",thet_pred_mean
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
+c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
+c & 'ebend',i,ethetai,theta(i),itype(i)
c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
c & rad2deg*phii,rad2deg*phii1,ethetai
if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
- 1215 continue
+c 1215 continue
+ enddo
+ ethetacnstr=0.0d0
+C print *,ithetaconstr_start,ithetaconstr_end,"TU"
+ do i=1,ntheta_constr
+ itheta=itheta_constr(i)
+ thetiii=theta(itheta)
+ difi=pinorm(thetiii-theta_constr0(i))
+ if (difi.gt.theta_drange(i)) then
+ difi=difi-theta_drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
+ & +for_thet_constr(i)*difi**3
+ else if (difi.lt.-drange(i)) then
+ difi=difi+drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
+ & +for_thet_constr(i)*difi**3
+ else
+ difi=0.0
+ endif
+C if (energy_dec) then
+C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
+C & i,itheta,rad2deg*thetiii,
+C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
+C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
+C & gloc(itheta+nphi-2,icg)
+C endif
enddo
C Ufff.... We've done all this!!!
return
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.FREE'
include 'COMMON.LOCAL'
include 'COMMON.GEO'
include 'COMMON.INTERACT'
etheta=0.0D0
c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
do i=ithet_start,ithet_end
- if (itype(i-1).eq.21) cycle
+ if (i.eq.2) 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)))
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)
c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
c call flush(iout)
- 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)
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
+c gloc(nphi+i-2,icg)=wang*dethetai
+ gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
+ enddo
+C now constrains
+ ethetacnstr=0.0d0
+C print *,ithetaconstr_start,ithetaconstr_end,"TU"
+ do i=1,ntheta_constr
+ itheta=itheta_constr(i)
+ thetiii=theta(itheta)
+ difi=pinorm(thetiii-theta_constr0(i))
+ if (difi.gt.theta_drange(i)) then
+ difi=difi-theta_drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
+ & +for_thet_constr(i)*difi**3
+ else if (difi.lt.-drange(i)) then
+ difi=difi+drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
+ & +for_thet_constr(i)*difi**3
+ else
+ difi=0.0
+ endif
+C if (energy_dec) then
+C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
+C & i,itheta,rad2deg*thetiii,
+C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
+C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
+C & gloc(itheta+nphi-2,icg)
+C endif
enddo
return
end
+
#endif
#ifdef CRYST_SC
c-----------------------------------------------------------------------------
common /sccalc/ time11,time12,time112,theti,it,nlobit
delta=0.02d0*pi
escloc=0.0D0
-c write (iout,'(a)') 'ESC'
+C write (iout,*) '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
+C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
theti=theta(i+1)-pipol
x(1)=dtan(theti)
x(2)=alph(i)
dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
enddo
dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
-c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c & esclocbi,ss,ssd
+ write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
+ & esclocbi,ss,ssd
escloci=ss*escloci+(1.0d0-ss)*esclocbi
c escloci=esclocbi
c write (iout,*) escloci
enddo
dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c & esclocbi,ss,ssd
+c & esclocbi,ss,ssd
escloci=ss*escloci+(1.0d0-ss)*esclocbi
-c write (iout,*) escloci
+C write (iout,*) 'i=',i, escloci
else
call enesc(x,escloci,dersc,ddummy,.false.)
endif
escloc=escloc+escloci
-c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
+C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
+ write (iout,'(a6,i5,0pf7.3)')
+ & 'escloc',i,escloci
gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
& wscloc*dersc(1)
do iii=-1,1
do j=1,nlobit
- expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
+ expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
cd print *,'j=',j,' expfac=',expfac
escloc_i=escloc_i+expfac
do k=1,3
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
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.FREE'
include 'COMMON.GEO'
include 'COMMON.LOCAL'
include 'COMMON.VAR'
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.0d0,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 sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
escloc = escloc + sumene
c write (2,*) "escloc",escloc
+c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
+c & zz,xx,yy
if (.not. calc_grad) goto 1
#ifdef DEBUG
C
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))
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) cycle
+ if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
+ & .or. itype(i).eq.ntyp1) cycle
itori=itortyp(itype(i-2))
itori1=itortyp(itype(i-1))
phii=phi(i)
difi=phii-phi0(i)
if (difi.gt.drange(i)) then
difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
else if (difi.lt.-drange(i)) then
difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
endif
-! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
-! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
+C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
+C & i,itori,rad2deg*phii,
+C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
enddo
! write (iout,*) 'edihcnstr',edihcnstr
return
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
+ if (i.le.2) 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 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
+C & .or. itype(i).eq.ntyp1) cycle
if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
+ 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)
pom=vl2ij*cosphi+vl3ij*sinphi
pom1=1.0d0/(pom*pom+1.0d0)
etors=etors+vl1ij*pom1
+c if (energy_dec) etors_ii=etors_ii+
+c & vl1ij*pom1
pom=-pom*pom1*pom1
gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
enddo
C Subtract the constant term
- etors=etors-v0(itori,itori1)
+ etors=etors-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,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
1215 continue
edihi=0.0d0
if (difi.gt.drange(i)) then
difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
- edihi=0.25d0*ftors*difi**4
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
+ edihi=0.25d0*ftors(i)*difi**4
else if (difi.lt.-drange(i)) then
difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
- edihi=0.25d0*ftors*difi**4
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
+ edihi=0.25d0*ftors(i)*difi**4
else
difi=0.0d0
endif
+ write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
+ & i,itori,rad2deg*phii,
+ & rad2deg*difi,0.25d0*ftors(i)*difi**4
c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
c & drange(i),edihi
! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
-! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
+! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
enddo
! write (iout,*) 'edihcnstr',edihcnstr
return
c lprn=.true.
etors_d=0.0D0
do i=iphi_start,iphi_end-1
- 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
+ if (i.le.3) cycle
+C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
+C & .or. itype(i).eq.ntyp1 .or. 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
if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
& goto 1215
itori=itortyp(itype(i-2))
phii1=phi(i+1)
gloci1=0.0D0
gloci2=0.0D0
+ iblock=1
+ if (iabs(itype(i+1)).eq.20) iblock=2
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)
+ 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)
gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
& -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
- & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
+ & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
enddo
enddo
gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.FREE'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.LOCAL'
integer dimen1,dimen2,atom,indx
double precision buffer(dimen1,dimen2)
double precision zapas
- common /contacts_hb/ zapas(3,20,maxres,7),
- & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
- & num_cont_hb(maxres),jcont_hb(20,maxres)
+ common /contacts_hb/ zapas(3,ntyp,maxres,7),
+ & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
+ & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
num_kont=num_cont_hb(atom)
do i=1,num_kont
do k=1,7
integer dimen1,dimen2,atom,indx
double precision buffer(dimen1,dimen2)
double precision zapas
- common /contacts_hb/ zapas(3,20,maxres,7),
- & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
- & num_cont_hb(maxres),jcont_hb(20,maxres)
+ common /contacts_hb/ zapas(3,ntyp,maxres,7),
+ & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
+ & ees0m(ntyp,maxres),
+ & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
num_kont=buffer(1,indx+26)
num_kont_old=num_cont_hb(atom)
num_cont_hb(atom)=num_kont+num_kont_old
C Set lprn=.true. for debugging
lprn=.false.
eturn6=0.0d0
+ ecorr6=0.0d0
#ifdef MPL
n_corr=0
n_corr1=0
cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
eturn6=eturn6+eello_turn6(i,jj,kk)
cd write (2,*) 'multibody_eello:eturn6',eturn6
+ else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
+ eturn6=0.0d0
+ ecorr6=0.0d0
endif
+
ENDIF
1111 continue
else if (j1.eq.j) then
enddo ! kk
enddo ! jj
enddo ! i
+ write (iout,*) "eturn6",eturn6,ecorr6
return
end
c------------------------------------------------------------------------------
scalar=sc
return
end
+C-----------------------------------------------------------------------
+ double precision function sscale(r)
+ double precision r,gamm
+ include "COMMON.SPLITELE"
+ if(r.lt.r_cut-rlamb) then
+ sscale=1.0d0
+ else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
+ gamm=(r-(r_cut-rlamb))/rlamb
+ sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
+ else
+ sscale=0d0
+ endif
+ return
+ end
+C-----------------------------------------------------------------------
+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-----------------------------------------------------------------------
+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
ires=0
do i=nnt,nct
iti=itype(i)
- if (iti.eq.21) then
+ if (iti.eq.ntyp1) then
ichain=ichain+1
ires=0
write (ipdb,'(a)') 'TER'
enddo
write (ipdb,'(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 (ipdb,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 (ipdb,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 (ipdb,30) ica(i),ica(i)+1
endif
enddo
write (ipdb,30) ica(nct),ica(nct)+1
endif
do i=1,nss
- write (ipdb,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
+C if (dyn_ss) then
+C write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1
+C else
+C write (ipdb,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
+C endif
enddo
write (ipdb,'(a6)') 'ENDMDL'
10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3)
write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
enddo
do i=1,nss
- write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
+C write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
+ if (dyn_ss) then
+ write(imol2,'(a6,i4,1x,a3,i7,4x,a3,i7)')
+ & 'SSBOND',i,'CYS',ihpb(i)-1-nres,
+ & 'CYS',jhpb(i)-1-nres
+C & 'SSBOND',i,'CYS',idssb(i)-nnt+1,
+C & 'CYS',jdssb(i)-nnt+1
+ else
+ write(imol2,'(a6,i4,1x,a3,i7,4x,a3,i7)')
+ & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres,
+ & 'CYS',jhpb(i)-nnt+1-nres
+ endif
enddo
write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
do i=nnt,nct
return
end
c---------------------------------------------------------------------------------
+ double precision function rlornmr1(y,ymin,ymax,sigma)
+ implicit none
+ double precision y,ymin,ymax,sigma
+ double precision wykl /4.0d0/
+ if (y.lt.ymin) then
+ rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
+ else if (y.gt.ymax) then
+ rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
+ else
+ rlornmr1=0.0d0
+ endif
+ return
+ end
+c------------------------------------------------------------------------------
+ double precision function rlornmr1prim(y,ymin,ymax,sigma)
+ implicit none
+ double precision y,ymin,ymax,sigma
+ double precision wykl /4.0d0/
+ if (y.lt.ymin) then
+ rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/
+ & ((ymin-y)**wykl+sigma**wykl)**2
+ else if (y.gt.ymax) then
+ rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/
+ & ((y-ymax)**wykl+sigma**wykl)**2
+ else
+ rlornmr1prim=0.0d0
+ endif
+ return
+ end
+
double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gvdwpp,
& gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gvdwx,gradcorr,gradxorr,
+ & gliptranc,gliptranx,
& gradcorr5,gradcorr6,gel_loc,gcorr3_turn,gcorr4_turn,gcorr6_turn,
& gel_loc_loc,gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,
& g_corr5_loc,g_corr6_loc,gradb,gradbx,gsccorc,gsccorx,gsccor_loc,
- & gscloc,gsclocx
+ & gscloc,gsclocx,gshieldx,gradafm,
+ & gshieldc, gshieldc_loc, gshieldx_ec, gshieldc_ec,
+ & gshieldc_loc_ec, gshieldx_t3,gshieldc_t3,gshieldc_loc_t3,
+ & gshieldx_t4, gshieldc_t4,gshieldc_loc_t4,gshieldx_ll,
+ & gshieldc_ll, gshieldc_loc_ll
+
integer nfl,icg
logical calc_grad
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),gvdwpp(3,maxres),
& gradx_scp(3,maxres),
+ & gliptranc(3,-1:maxres),
+ & gliptranx(3,-1:maxres),
+ & gshieldx(3,-1:maxres), gshieldc(3,-1:maxres),
+ & gshieldc_loc(3,-1:maxres),
+ & gshieldx_ec(3,-1:maxres), gshieldc_ec(3,-1:maxres),
+ & gshieldc_loc_ec(3,-1:maxres),
+ & gshieldx_t3(3,-1:maxres), gshieldc_t3(3,-1:maxres),
+ & gshieldc_loc_t3(3,-1:maxres),
+ & gshieldx_t4(3,-1:maxres), gshieldc_t4(3,-1:maxres),
+ & gshieldc_loc_t4(3,-1:maxres),
+ & gshieldx_ll(3,-1:maxres), gshieldc_ll(3,-1:maxres),
+ & gshieldc_loc_ll(3,-1:maxres),
& gvdwc_scp(3,maxres),ghpbx(3,maxres),ghpbc(3,maxres),
& gloc(maxvar,2),gradcorr(3,maxres),gradxorr(3,maxres),
& gradcorr5(3,maxres),gradcorr6(3,maxres),
double precision wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc,
& wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4,
& wturn6,wvdwpp,wbond,weights,scal14,cutoff_corr,delt_corr,
- & r0_corr
+ & r0_corr,wliptran
integer ipot,n_ene_comp
common /ffield/ wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc,
& wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4,
- & wturn6,wvdwpp,wbond,weights(max_ene),
+ & wturn6,wvdwpp,wbond,wliptran,weights(max_ene),
& scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp
common /potentials/ potname(5)
character*3 potname
- double precision aa,bb,augm,aad,bad,app,bpp,ael6,ael3
+ double precision aa_aq,bb_aq,augm,aad,bad,app,bpp,ael6,ael3,
+ & aa_lip,bb_lip
integer nnt,nct,nint_gr,istart,iend,itype,itel,itypro,ielstart,
& ielend,nscp_gr,iscpstart,iscpend,iatsc_s,iatsc_e,iatel_s,
& iatel_e,iatscp_s,iatscp_e,ispp,iscp,expon,expon2
- common /interact/aa(ntyp,ntyp),bb(ntyp,ntyp),augm(ntyp,ntyp),
+ common /interact/aa_aq(ntyp,ntyp),bb_aq(ntyp,ntyp),
+ & augm(ntyp,ntyp),aa_lip(ntyp,ntyp),bb_lip(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,
C 12/1/95 Array EPS included in the COMMON block.
double precision eps,sigma,sigmaii,rs0,chi,chip,chip0,alp,signa0,
& sigii,sigma0,rr0,r0,r0e,r0d,rpp,epp,elpp6,elpp3,eps_scp,rscp,
- & eps_orig
+ & eps_orig,epslip
common /body/eps(ntyp,ntyp),sigma(ntyp,ntyp),sigmaii(ntyp,ntyp),
+ &epslip(ntyp,ntyp),
& rs0(ntyp,ntyp),chi(ntyp,ntyp),chip(ntyp),chip0(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),eps_orig(ntyp,ntyp)
+ & eps_scp(ntyp,2),rscp(ntyp,2),eps_orig(ntyp,ntyp)
c 12/5/03 modified 09/18/03 Bond stretching parameters.
double precision vbldp0,vbldsc0,akp,aksc,abond0,distchainmax
+ &,vbldpDUM
integer nbondterm
common /stretch/ vbldp0,vbldsc0(maxbondterm,ntyp),akp,
& aksc(maxbondterm,ntyp),abond0(maxbondterm,ntyp),
& distchainmax,nbondterm(ntyp)
+ &,vbldpDUM
+C 01/29/15 Lipidic parameters
+ double precision pepliptran,liptranene
+ common /lipid/ pepliptran,liptranene(ntyp)
+
+
double precision a0thet,athet,bthet,polthet,gthet,theta0,sig0,
- & sigc0,dsc,dsc_inv,bsc,censc,gaussc,dsc0,vbl,vblinv,vblinv2,
- & vbl_cis,vbl0,vbld_inv
- integer nlob,loc_start,loc_end,ithet_start,ithet_end,
- & iphi_start,iphi_end,itau_start,itau_end
+ & 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)
-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)
- common /theta_abinitio/aa0thet,aathet,bbthet,ccthet,ddthet,eethet,
- & ffthet,
- & ggthet,ithetyp,nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,
- & ndouble,nntheterm
+ 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:ntyp1),nntheterm
+ common /theta_abinitio/ 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),
+ & ithetyp,nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,
+ & ndouble,nntheterm
+
+ double precision aa0thet,aathet,bbthet,ccthet,ddthet,eethet,
+ & ffthet,
+ & ggthet
C Virtual-bond lenghts
+ double precision vbl,vblinv,vblinv2,vbl_cis,vbl0,vbld_inv
+ integer loc_start,loc_end,ithet_start,ithet_end,iphi_start,
+ & 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
common /peptbond/ vbl,vblinv,vblinv2,vbl_cis,vbl0
common /indices/ loc_start,loc_end,ithet_start,ithet_end,
- & iphi_start,iphi_end,itau_start,itau_end
+ & iphi_start,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
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(max_ene),wname(max_ene),nprint_ene,
- double precision ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,dhpb,
- & forcon,weidis
- integer ns,nss,nfree,iss,ihpb,jhpb,nhpb,link_start,link_end
- common /sbridge/ ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,ns,nss,
- & nfree,iss(maxss)
- common /links/ dhpb(maxdim),forcon(maxdim),ihpb(maxdim),
- & jhpb(maxdim),nhpb
+ double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss
+ integer ns,nss,nfree,iss
+ common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,
+ & ns,nss,nfree,iss(maxss)
+ double precision dhpb,dhpb1,forcon,fordepth
+ integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb
+ common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim),
+ & fordepth(maxdim),
+ & ihpb(maxdim),jhpb(maxdim),nhpb
+ double precision weidis
common /restraints/ weidis
+ integer link_start,link_end
common /links_split/ link_start,link_end
+ double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss
+ logical dyn_ss,dyn_ss_mask
+ common /dyn_ssbond/ dtriss,atriss,btriss,ctriss,Ht,
+ & dyn_ssbond_ij(maxres,maxres),
+ & idssb(maxdim),jdssb(maxdim),ibecarb(maxdim)
+ common /dyn_ss_logic/
+ & dyn_ss,dyn_ss_mask(maxres)
C Parameters of the SC rotamers (local) term
double precision sc_parmin
- common/scrot/sc_parmin(maxsccoef,20)
+ common/scrot/sc_parmin(maxsccoef,ntyp)
--- /dev/null
+ integer king,idint,idreal,idchar,is_done
+ parameter (king=0,idint=1105,idreal=1729,idchar=1597,is_done=1)
+ integer me,cg_rank,fg_rank,fg_rank1,nodes,Nprocs,nfgtasks,kolor,
+ & koniec(0:maxprocs-1),WhatsUp,ifinish(maxprocs-1),CG_COMM,FG_COMM,
+ & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp(0:maxprocs-1),
+ & kolor1,key1,nfgtasks1,MyRank,
+ & max_gs_size
+ logical yourjob, finished, cgdone
+ common/setup/me,MyRank,cg_rank,fg_rank,fg_rank1,nodes,Nprocs,
+ & nfgtasks,nfgtasks1,
+ & max_gs_size,kolor,koniec,WhatsUp,ifinish,CG_COMM,FG_COMM,
+ & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp
+ integer MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2,
+ & MPI_THET,MPI_GAM,
+ & MPI_ROTAT1(0:1),MPI_ROTAT2(0:1),MPI_ROTAT_OLD(0:1),
+ & MPI_PRECOMP11(0:1),MPI_PRECOMP12(0:1),MPI_PRECOMP22(0:1),
+ & MPI_PRECOMP23(0:1)
+ common /types/ MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2,
+ & MPI_THET,MPI_GAM,
+ & MPI_ROTAT1,MPI_ROTAT2,MPI_ROTAT_OLD,MPI_PRECOMP11,MPI_PRECOMP12,
+ & MPI_PRECOMP22,MPI_PRECOMP23
- integer ndih_constr,idih_constr(maxdih_constr)
+ integer ndih_constr,idih_constr(maxdih_constr),ntheta_constr,
+ & itheta_constr(maxdih_constr)
integer ndih_nconstr,idih_nconstr(maxdih_constr)
- double precision phi0(maxdih_constr),drange(maxdih_constr),ftors
- common /torcnstr/ phi0,drange,ftors,ndih_constr,idih_constr,
- & ndih_nconstr,idih_nconstr
+ integer idihconstr_start,idihconstr_end,ithetaconstr_start,
+ & ithetaconstr_end
+ double precision phi0(maxdih_constr),drange(maxdih_constr),
+ & ftors(maxdih_constr),theta_constr0(maxdih_constr),
+ & theta_drange(maxdih_constr),for_thet_constr(maxdih_constr)
+ common /torcnstr/ phi0,drange,ftors,theta_constr0,theta_drange,
+ & for_thet_constr,
+ & ndih_constr,idih_constr,
+ & ndih_nconstr,idih_nconstr,idihconstr_start,idihconstr_end,
+ & ntheta_constr,itheta_constr,ithetaconstr_start,
+ & ithetaconstr_end
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),
+ 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(ntyp),ntortyp,nterm(maxtor,maxtor),
- & nlor(maxtor,maxtor),nterm_old
+ & itortyp(-ntyp:ntyp),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,b1tilde
+ double precision b1,b2,cc,dd,ee,ctilde,dtilde,b2tilde,b1tilde
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,-maxtor:maxtor),b2(2,-maxtor:maxtor)
+ & ,cc(2,2,-maxtor:maxtor),
+ & dd(2,2,-maxtor:maxtor),ee(2,2,-maxtor:maxtor),
+ & ctilde(2,2,-maxtor:maxtor),
+ & dtilde(2,2,-maxtor:maxtor),b1tilde(2,-maxtor:maxtor),nloctyp
double precision b
- common /fourier1/ b(13,maxtor)
+ common /fourier1/ b(13,0:maxtor)
& epp_low(2,2),epp_up(2,2),rpp_low(2,2),rpp_up(2,2),
& elpp6_low(2,2),elpp6_up(2,2),elpp3_low(2,2),elpp3_up(2,2),
& b_low(13,3),b_up(13,3),x_up(max_paropt),x_low(max_paropt),
- & epscp_low(0:20,2),epscp_up(0:20,2),rscp_low(0:20,2),
- & rscp_up(0:20,2),epss_low(ntyp),epss_up(ntyp),epsp_low(nntyp),
+ & epscp_low(0:ntyp,2),epscp_up(0:ntyp,2),rscp_low(0:ntyp,2),
+ & rscp_up(0:ntyp,2),epss_low(ntyp),epss_up(ntyp),epsp_low(nntyp),
& epsp_up(nntyp),
& xm(max_paropt,0:maxprot),xm1(max_paropt,0:maxprot),
& xm2(max_paropt,0:maxprot),
& imask(max_ene),nsingle_sc,npair_sc,ityp_ssc(ntyp),
& ityp_psc(2,nntyp),mask_elec(2,2,4),
& mask_fourier(13,3),
- & mask_scp(0:20,2,2),mod_other_params,mod_fourier(0:3),
+ & mask_scp(0:ntyp,2,2),mod_other_params,mod_fourier(0:3),
& mod_elec,mod_scp,mod_side,indz(maxbatch+1,maxprot),iw(max_ene)
ihist=30
iweight=31
izsc=32
+C Lipidic input file for parameters range 60-79
+ iliptranpar=60
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_lip(i,j)=0.0D0
+ bb_lip(i,j)=0.0D0
+ aa_aq(i,j)=0.0D0
+ bb_aq(i,j)=0.0D0
augm(i,j)=0.0D0
sigma(i,j)=0.0D0
r0(i,j)=0.0D0
sigii(i)=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 j=1,2
+ 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
polthet(j,i)=0.0D0
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
+ 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
do i=1,maxres
ihpb(i)=0
jhpb(i)=0
+ dyn_ss_mask(i)=.false.
enddo
C
C Initialize timing.
include 'COMMON.WEIGHTS'
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 ",
& "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
& "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB","EVDWPP",
- & "EVDW2_14","ESTR","ESCCOR","EDIHC","EVDW_T"/
+ & "EVDW2_14","ESTR","ESCCOR","EDIHC","EVDW_T","ELIPTRAN",
+ & "EAFM","ETHETC","EMPTY"/
data wname /
& "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
& "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
- & "WHPB","WVDWPP","WSCP14","WBOND","WSCCOR","WDIHC","WSC"/
+ & "WHPB","WVDWPP","WSCP14","WBOND","WSCCOR","WDIHC","WSC",
+ & "WLIPTRAN","WAFM","WTHETC","WSHIELD"/
data ww0 /1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,
& 1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,0.4d0,1.0d0,1.0d0,
- & 0.0d0,0.0/
- data nprint_ene /21/
+ & 0.0d0,0.0,0.0d0,0.0d0,0.0d0,0.0d0/
+ data nprint_ene /22/
data print_order /1,2,3,18,11,12,13,14,4,5,6,7,8,9,10,19,
- & 16,15,17,20,21/
+ & 16,15,17,20,21,24,22,23,1/
end
c---------------------------------------------------------------------------
subroutine init_int_table
cd & (ihpb(i),jhpb(i),i=1,nss)
do i=nnt,nct-1
scheck=.false.
+ if (dyn_ss) goto 10
do ii=1,nss
if (ihpb(ii).eq.i+nres) then
scheck=.true.
#else
loc_start=2
loc_end=nres-1
- ithet_start=3
+ ithet_start=3
ithet_end=nres
iphi_start=nnt+3
iphi_end=nct
cd & ' link_end',link_end
return
end
+c------------------------------------------------------------------------------
+ subroutine homology_partition
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.FREE'
+#ifdef MPI
+ include 'mpif.h'
+#endif
+ include 'COMMON.SBRIDGE'
+ include 'COMMON.IOUNITS'
+c include 'COMMON.SETUP'
+ include 'COMMON.CONTROL'
+ include 'COMMON.CHAIN'
+ include 'COMMON.INTERACT'
+ include 'COMMON.HOMRESTR'
+ write(iout,*)"homology_partition: lim_odl=",lim_odl,
+ & " lim_dih",lim_dih
+#ifdef MPL
+ call int_bounds(lim_odl,link_start_homo,link_end_homo)
+ call int_bounds(lim_dih-nnt+1,idihconstr_start_homo,
+ & idihconstr_end_homo)
+ idihconstr_start_homo=idihconstr_start_homo+nnt-1
+ idihconstr_end_homo=idihconstr_end_homo+nnt-1
+ if (me.eq.king .or. .not. out1file)
+ & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
+ & ' absolute rank',MyRank,
+ & ' lim_odl',lim_odl,' link_start=',link_start_homo,
+ & ' link_end',link_end_homo,' lim_dih',lim_dih,
+ & ' idihconstr_start_homo',idihconstr_start_homo,
+ & ' idihconstr_end_homo',idihconstr_end_homo
+#else
+ link_start_homo=1
+ link_end_homo=lim_odl
+ idihconstr_start_homo=nnt
+ idihconstr_end_homo=lim_dih
+ write (iout,*)
+ & ' lim_odl',lim_odl,' link_start=',link_start_homo,
+ & ' link_end',link_end_homo,' lim_dih',lim_dih,
+ & ' idihconstr_start_homo',idihconstr_start_homo,
+ & ' idihconstr_end_homo',idihconstr_end_homo
+#endif
+ return
+ end
double precision fT(6),fTprim(6),fTbis(6),quot,quotl1,quotl,kfacl,
& eprim,ebis,temper,kfac/2.4d0/,T0/300.0d0/
double precision etot,evdw,evdw_t,evdw2,ees,evdw1,ebe,etors,
- & escloc,
+ & escloc,ehomology_constr,
& ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3,
& eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor,tt
integer i,ii,ik,iproc,iscor,j,k,l,ib,iparm,iprot,nlist
character*5 ctemper
integer ilen
external ilen
- real*4 Fdimless(MaxStr)
+ real*4 Fdimless(MaxStr),Fdimless_(MaxStr)
double precision enepot(MaxStr)
integer iperm(MaxStr)
integer islice
estr=enetb(18,i,iparm)
esccor=enetb(19,i,iparm)
edihcnstr=enetb(20,i,iparm)
+ ehomology_constr=enetb(22,i,iparm)
#ifdef SPLITELE
etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees
& +wvdwpp*evdw1
& +ft(2)*wturn3*eello_turn3
& +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc
& +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor
- & +wbond*estr
+ & +wbond*estr+ehomology_constr
#else
etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2
& +ft(1)*welec*(ees+evdw1)
& +ft(2)*wturn3*eello_turn3
& +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr
& +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor
- & +wbond*estr
+ & +wbond*estr+ehomology_constr
#endif
#ifdef MPI
- Fdimless(i)=
+ Fdimless_(i)=
& beta_h(ib,iparm)*etot-entfac(i)
potE(i,iparm)=etot
#ifdef DEBUG
- write (iout,*) i,indstart(me)+i-1,ib,
+ write (iout,*) 'EEE',i,indstart(me)+i-1,ib,
& 1.0d0/(1.987d-3*beta_h(ib,iparm)),potE(i,iparm),
& -entfac(i),Fdimless(i)
#endif
#endif
enddo ! i
#ifdef MPI
- call MPI_Gatherv(Fdimless(1),scount(me),
+ call MPI_Gatherv(Fdimless_(1),scount(me),
& MPI_REAL,Fdimless(1),
& scount(0),idispl(0),MPI_REAL,Master,
& WHAM_COMM, IERROR)
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.FREE'
include 'COMMON.IOUNITS'
include 'COMMON.GEO'
include 'COMMON.VAR'
write (iout,'(20i4)') (itype(i),i=1,nres)
do i=1,nres-1
#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
itel(i)=2
endif
enddo
+ write (iout,*) "ITEL"
+ do i=1,nres-1
+ write (iout,*) i,itype(i),itel(i)
+ enddo
call read_bridge
if (with_dihed_constr) then
read (inp,*) ndih_constr
if (ndih_constr.gt.0) then
- read (inp,*) ftors
- write (iout,*) 'FTORS',ftors
- read (inp,*) (idih_constr(i),phi0(i),drange(i),i=1,ndih_constr)
+C read (inp,*) ftors
+C write (iout,*) 'FTORS',ftors
+ read (inp,*) (idih_constr(i),phi0(i),drange(i),ftors(i),
+ & i=1,ndih_constr)
write (iout,*)
& 'There are',ndih_constr,' constraints on phi angles.'
do i=1,ndih_constr
- write (iout,'(i5,2f8.3)') idih_constr(i),phi0(i),drange(i)
+ write (iout,'(i5,3f8.3)') idih_constr(i),phi0(i),drange(i),
+ & ftors(i)
enddo
do i=1,ndih_constr
phi0(i)=deg2rad*phi0(i)
endif
endif
-
+ if (with_theta_constr) then
+C with_theta_constr is keyword allowing for occurance of theta constrains
+ read (inp,*) ntheta_constr
+C ntheta_constr is the number of theta constrains
+ if (ntheta_constr.gt.0) then
+C read (inp,*) ftors
+ read (inp,*) (itheta_constr(i),theta_constr0(i),
+ & theta_drange(i),for_thet_constr(i),
+ & i=1,ntheta_constr)
+C the above code reads from 1 to ntheta_constr
+C itheta_constr(i) residue i for which is theta_constr
+C theta_constr0 the global minimum value
+C theta_drange is range for which there is no energy penalty
+C for_thet_constr is the force constant for quartic energy penalty
+C E=k*x**4
+C if(me.eq.king.or..not.out1file)then
+ write (iout,*)
+ & 'There are',ntheta_constr,' constraints on phi angles.'
+ do i=1,ntheta_constr
+ write (iout,'(i5,3f8.3)') itheta_constr(i),theta_constr0(i),
+ & theta_drange(i),
+ & for_thet_constr(i)
+ enddo
+C endif
+ do i=1,ntheta_constr
+ theta_constr0(i)=deg2rad*theta_constr0(i)
+ theta_drange(i)=deg2rad*theta_drange(i)
+ enddo
+C if(me.eq.king.or..not.out1file)
+C & write (iout,*) 'FTORS',ftors
+C do i=1,ntheta_constr
+C ii = itheta_constr(i)
+C thetabound(1,ii) = phi0(i)-drange(i)
+C thetabound(2,ii) = phi0(i)+drange(i)
+C enddo
+ endif ! ntheta_constr.gt.0
+ endif! with_theta_constr
nnt=1
nct=nres
- 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
write(iout,*) 'NNT=',NNT,' NCT=',NCT
+ if (constr_homology.gt.0) then
+c write (iout,*) "About to call read_constr_homology"
+c call flush(iout)
+ call read_constr_homology
+ write (iout,*) "Exit read_constr_homology"
+ call flush(iout)
+cref if (indpdb.gt.0 .or. pdbref) then
+cref do i=1,2*nres
+cref do j=1,3
+cref c(j,i)=crefjlee(j,i)
+cref cref(j,i)=crefjlee(j,i)
+cref enddo
+cref enddo
+cref endif
+ else
+ homol_nset=0
+ endif
+
+
call setup_var
call init_int_table
if (ns.gt.0) then
write (iout,'(/a,i3,a)') 'The chain contains',ns,
& ' disulfide-bridging cysteines.'
write (iout,'(20i4)') (iss(i),i=1,ns)
+ if (dyn_ss) then
+ write(iout,*)"Running with dynamic disulfide-bond formation"
+ else
write (iout,'(/a/)') 'Pre-formed links are:'
do i=1,nss
i1=ihpb(i)-nres
& dhpb(i),ebr,forcon(i)
enddo
endif
+ endif
write (iout,'(a)')
+ if (ns.gt.0.and.dyn_ss) then
+ do i=nss+1,nhpb
+ ihpb(i-nss)=ihpb(i)
+ jhpb(i-nss)=jhpb(i)
+ forcon(i-nss)=forcon(i)
+ dhpb(i-nss)=dhpb(i)
+ enddo
+ nhpb=nhpb-nss
+ nss=0
+ call hpb_partition
+ do i=1,ns
+ dyn_ss_mask(iss(i))=.true.
+ enddo
+ endif
return
end
c-----------------------------------------------------------------------------
do i=1,ns
if (itype(iss(i)).ne.1) then
write (iout,'(2a,i3,a)')
- & 'Do you REALLY think that the residue ',restyp(iss(i)),i,
+ & 'Do you REALLY think that the residue ',
+ & restyp(itype(iss(i))),i,
& ' can form a disulfide bridge?!!!'
write (*,'(2a,i3,a)')
- & 'Do you REALLY think that the residue ',restyp(iss(i)),i,
+ & 'Do you REALLY think that the residue ',
+ & restyp(itype(iss(i))),i,
& ' can form a disulfide bridge?!!!'
stop
endif
return
10 return1
end
+c====-------------------------------------------------------------------
+ subroutine read_constr_homology
+
+ include 'DIMENSIONS'
+ include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.FREE'
+#ifdef MPI
+ include 'mpif.h'
+#endif
+ include 'COMMON.SETUP'
+ include 'COMMON.CONTROL'
+ include 'COMMON.CHAIN'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.GEO'
+ include 'COMMON.INTERACT'
+ include 'COMMON.HOMRESTR'
+c
+c For new homol impl
+c
+ include 'COMMON.VAR'
+c include 'include_unres/COMMON.VAR'
+c
+
+c double precision odl_temp,sigma_odl_temp,waga_theta,waga_d,
+c & dist_cut
+c common /przechowalnia/ odl_temp(maxres,maxres,max_template),
+c & sigma_odl_temp(maxres,maxres,max_template)
+ character*2 kic2
+ character*24 model_ki_dist, model_ki_angle
+ character*500 controlcard
+ integer ki, i, j, k, l, ii_in_use(maxdim),i_tmp,idomain_tmp
+ integer idomain(max_template,maxres)
+ logical lprn /.true./
+ integer ilen
+ external ilen
+ logical unres_pdb
+c
+c FP - Nov. 2014 Temporary specifications for new vars
+c
+ double precision rescore_tmp,x12,y12,z12,rescore2_tmp
+ double precision, dimension (max_template,maxres) :: rescore
+ double precision, dimension (max_template,maxres) :: rescore2
+ character*24 tpl_k_rescore
+c -----------------------------------------------------------------
+c Reading multiple PDB ref structures and calculation of retraints
+c not using pre-computed ones stored in files model_ki_{dist,angle}
+c FP (Nov., 2014)
+c -----------------------------------------------------------------
+c
+c
+c Alternative: reading from input
+ call card_concat(controlcard,.true.)
+ call reada(controlcard,"HOMOL_DIST",waga_dist,1.0d0)
+ call reada(controlcard,"HOMOL_ANGLE",waga_angle,1.0d0)
+ call reada(controlcard,"HOMOL_THETA",waga_theta,1.0d0) ! new
+ call reada(controlcard,"HOMOL_SCD",waga_d,1.0d0) ! new
+ call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) ! for diff ways of calc sigma
+ call reada(controlcard,'DIST2_CUT',dist2_cut,9999.0d0)
+ call readi(controlcard,"HOMOL_SET",homol_nset,1)
+ read2sigma=(index(controlcard,'READ2SIGMA').gt.0)
+ call readi(controlcard,"IHSET",ihset,1)
+ if (homol_nset.gt.1)then
+ call card_concat(controlcard,.true.)
+ read(controlcard,*) (waga_homology(i),i=1,homol_nset)
+ if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
+ write(iout,*) "iset homology_weight "
+c do i=1,homol_nset
+c write(iout,*) i,waga_homology(i)
+c enddo
+ endif
+ iset=mod(kolor,homol_nset)+1
+ else
+ iset=1
+ waga_homology(1)=1.0
+ endif
+c write(iout,*) "waga_homology(",iset,")",waga_homology(iset)
+
+cd write (iout,*) "nnt",nnt," nct",nct
+cd call flush(iout)
+
+
+ lim_odl=0
+ lim_dih=0
+c
+c New
+c
+ lim_theta=0
+ lim_xx=0
+c
+c Reading HM global scores (prob not required)
+c
+ do i = nnt,nct
+ do k=1,constr_homology
+ idomain(k,i)=0
+ enddo
+ enddo
+c open (4,file="HMscore")
+c do k=1,constr_homology
+c read (4,*,end=521) hmscore_tmp
+c hmscore(k)=hmscore_tmp ! Another transformation can be used
+c write(*,*) "Model", k, ":", hmscore(k)
+c enddo
+c521 continue
+
+ ii=0
+ do i = nnt,nct-2
+ do j=i+2,nct
+ ii=ii+1
+ ii_in_use(ii)=0
+ enddo
+ enddo
+c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
+
+ do k=1,constr_homology
+
+ read(inp,'(a)') pdbfile
+c Next stament causes error upon compilation (?)
+c if(me.eq.king.or. .not. out1file)
+c write (iout,'(2a)') 'PDB data will be read from file ',
+c & pdbfile(:ilen(pdbfile))
+ write (iout,'(a,5x,a)') 'HOMOL: Opening PDB file',
+ & pdbfile(:ilen(pdbfile))
+ open(ipdbin,file=pdbfile,status='old',err=33)
+ goto 34
+ 33 write (iout,'(a,5x,a)') 'Error opening PDB file',
+ & pdbfile(:ilen(pdbfile))
+ stop
+ 34 continue
+c print *,'Begin reading pdb data'
+c
+c Files containing res sim or local scores (former containing sigmas)
+c
+
+ write(kic2,'(bz,i2.2)') k
+
+ tpl_k_rescore="template"//kic2//".sco"
+
+ unres_pdb=.false.
+ call readpdb
+cref do i=1,2*nres
+cref do j=1,3
+cref crefjlee(j,i)=c(j,i)
+cref enddo
+cref enddo
+#ifdef DEBUG
+ do i=1,nres
+ write (iout,'(i5,3f8.3,5x,3f8.3)') i,(crefjlee(j,i),j=1,3),
+ & (crefjlee(j,i+nres),j=1,3)
+ enddo
+#endif
+ write (iout,*) "read_constr_homology: after reading pdb file"
+ call flush(iout)
+
+c
+c Distance restraints
+c
+c ... --> odl(k,ii)
+C Copy the coordinates from reference coordinates (?)
+ do i=1,2*nres
+ do j=1,3
+c c(j,i)=cref(j,i)
+c write (iout,*) "c(",j,i,") =",c(j,i)
+ enddo
+ enddo
+c
+c From read_dist_constr (commented out 25/11/2014 <-> res sim)
+c
+c write(iout,*) "tpl_k_rescore - ",tpl_k_rescore
+ open (ientin,file=tpl_k_rescore,status='old')
+ if (nnt.gt.1) rescore(k,1)=0.0d0
+ do irec=nnt,maxdim ! loop for reading res sim
+ if (read2sigma) then
+ read (ientin,*,end=1401) i_tmp,rescore2_tmp,rescore_tmp,
+ & idomain_tmp
+ i_tmp=i_tmp+nnt-1
+ idomain(k,i_tmp)=idomain_tmp
+ rescore(k,i_tmp)=rescore_tmp
+ rescore2(k,i_tmp)=rescore2_tmp
+ else
+ idomain(k,irec)=1
+ read (ientin,*,end=1401) rescore_tmp
+
+c rescore(k,irec)=rescore_tmp+1.0d0 ! to avoid 0 values
+ rescore(k,irec)=0.5d0*(rescore_tmp+0.5d0) ! alt transf to reduce scores
+c write(iout,*) "rescore(",k,irec,") =",rescore(k,irec)
+ endif
+ enddo
+ 1401 continue
+ close (ientin)
+ if (waga_dist.ne.0.0d0) then
+ ii=0
+ do i = nnt,nct-2
+ do j=i+2,nct
+
+ x12=c(1,i)-c(1,j)
+ y12=c(2,i)-c(2,j)
+ z12=c(3,i)-c(3,j)
+ distal=dsqrt(x12*x12+y12*y12+z12*z12)
+c write (iout,*) k,i,j,distal,dist2_cut
+
+ if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0
+ & .and. distal.le.dist2_cut ) then
+
+ ii=ii+1
+ ii_in_use(ii)=1
+ l_homo(k,ii)=.true.
+
+c write (iout,*) "k",k
+c write (iout,*) "i",i," j",j," constr_homology",
+c & constr_homology
+ ires_homo(ii)=i
+ jres_homo(ii)=j
+ odl(k,ii)=distal
+ if (read2sigma) then
+ sigma_odl(k,ii)=0
+ do ik=i,j
+ sigma_odl(k,ii)=sigma_odl(k,ii)+rescore2(k,ik)
+ enddo
+ sigma_odl(k,ii)=sigma_odl(k,ii)/(j-i+1)
+ if (odl(k,ii).gt.dist_cut) sigma_odl(k,ii) =
+ & sigma_odl(k,ii)*dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0)
+ else
+ if (odl(k,ii).le.dist_cut) then
+ sigma_odl(k,ii)=rescore(k,i)+rescore(k,j)
+ else
+#ifdef OLDSIGMA
+ sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))*
+ & dexp(0.5d0*(odl(k,ii)/dist_cut)**2)
+#else
+ sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))*
+ & dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0)
+#endif
+ endif
+ endif
+ sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii))
+ else
+ ii=ii+1
+ l_homo(k,ii)=.false.
+ endif
+ enddo
+ enddo
+ lim_odl=ii
+ endif
+c
+c Theta, dihedral and SC retraints
+c
+ if (waga_angle.gt.0.0d0) then
+c open (ientin,file=tpl_k_sigma_dih,status='old')
+c do irec=1,maxres-3 ! loop for reading sigma_dih
+c read (ientin,*,end=1402) i,j,ki,l,sigma_dih(k,i+nnt-1) ! j,ki,l what for?
+c if (i+nnt-1.gt.lim_dih) lim_dih=i+nnt-1 ! right?
+c sigma_dih(k,i+nnt-1)=sigma_dih(k,i+nnt-1)* ! not inverse because of use of res. similarity
+c & sigma_dih(k,i+nnt-1)
+c enddo
+c1402 continue
+c close (ientin)
+ do i = nnt+3,nct
+ if (idomain(k,i).eq.0) then
+ sigma_dih(k,i)=0.0
+ cycle
+ endif
+ dih(k,i)=phiref(i) ! right?
+c read (ientin,*) sigma_dih(k,i) ! original variant
+c write (iout,*) "dih(",k,i,") =",dih(k,i)
+c write(iout,*) "rescore(",k,i,") =",rescore(k,i),
+c & "rescore(",k,i-1,") =",rescore(k,i-1),
+c & "rescore(",k,i-2,") =",rescore(k,i-2),
+c & "rescore(",k,i-3,") =",rescore(k,i-3)
+
+ sigma_dih(k,i)=(rescore(k,i)+rescore(k,i-1)+
+ & rescore(k,i-2)+rescore(k,i-3))/4.0
+c if (read2sigma) sigma_dih(k,i)=sigma_dih(k,i)/4.0
+c write (iout,*) "Raw sigmas for dihedral angle restraints"
+c write (iout,'(i5,10(2f8.2,4x))') i,sigma_dih(k,i)
+c sigma_dih(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)*
+c rescore(k,i-2)*rescore(k,i-3) ! right expression ?
+c Instead of res sim other local measure of b/b str reliability possible
+ sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i))
+c sigma_dih(k,i)=sigma_dih(k,i)*sigma_dih(k,i)
+ enddo
+ lim_dih=nct-nnt-2
+ endif
+
+ if (waga_theta.gt.0.0d0) then
+c open (ientin,file=tpl_k_sigma_theta,status='old')
+c do irec=1,maxres-2 ! loop for reading sigma_theta, right bounds?
+c read (ientin,*,end=1403) i,j,ki,sigma_theta(k,i+nnt-1) ! j,ki what for?
+c sigma_theta(k,i+nnt-1)=sigma_theta(k,i+nnt-1)* ! not inverse because of use of res. similarity
+c & sigma_theta(k,i+nnt-1)
+c enddo
+c1403 continue
+c close (ientin)
+
+ do i = nnt+2,nct ! right? without parallel.
+c do i = i=1,nres ! alternative for bounds acc to readpdb?
+c do i=ithet_start,ithet_end ! with FG parallel.
+ if (idomain(k,i).eq.0) then
+ sigma_theta(k,i)=0.0
+ cycle
+ endif
+ thetatpl(k,i)=thetaref(i)
+c write (iout,*) "thetatpl(",k,i,") =",thetatpl(k,i)
+c write(iout,*) "rescore(",k,i,") =",rescore(k,i),
+c & "rescore(",k,i-1,") =",rescore(k,i-1),
+c & "rescore(",k,i-2,") =",rescore(k,i-2)
+c read (ientin,*) sigma_theta(k,i) ! 1st variant
+ sigma_theta(k,i)=(rescore(k,i)+rescore(k,i-1)+
+ & rescore(k,i-2))/3.0
+c if (read2sigma) sigma_theta(k,i)=sigma_theta(k,i)/3.0
+ sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i))
+
+c sigma_theta(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)*
+c rescore(k,i-2) ! right expression ?
+c sigma_theta(k,i)=sigma_theta(k,i)*sigma_theta(k,i)
+ enddo
+ endif
+ lim_theta=nct-nnt-1
+
+ if (waga_d.gt.0.0d0) then
+c open (ientin,file=tpl_k_sigma_d,status='old')
+c do irec=1,maxres-1 ! loop for reading sigma_theta, right bounds?
+c read (ientin,*,end=1404) i,j,sigma_d(k,i+nnt-1) ! j,ki what for?
+c sigma_d(k,i+nnt-1)=sigma_d(k,i+nnt-1)* ! not inverse because of use of res. similarity
+c & sigma_d(k,i+nnt-1)
+c enddo
+c1404 continue
+
+ do i = nnt,nct ! right? without parallel.
+c do i=2,nres-1 ! alternative for bounds acc to readpdb?
+c do i=loc_start,loc_end ! with FG parallel.
+ if (itype(i).eq.10) cycle
+ if (idomain(k,i).eq.0 ) then
+ sigma_d(k,i)=0.0
+ cycle
+ endif
+ xxtpl(k,i)=xxref(i)
+ yytpl(k,i)=yyref(i)
+ zztpl(k,i)=zzref(i)
+c write (iout,*) "xxtpl(",k,i,") =",xxtpl(k,i)
+c write (iout,*) "yytpl(",k,i,") =",yytpl(k,i)
+c write (iout,*) "zztpl(",k,i,") =",zztpl(k,i)
+c write(iout,*) "rescore(",k,i,") =",rescore(k,i)
+ sigma_d(k,i)=rescore(k,i) ! right expression ?
+ sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i))
+
+c sigma_d(k,i)=hmscore(k)*rescore(k,i) ! right expression ?
+c sigma_d(k,i)=sigma_d(k,i)*sigma_d(k,i)
+c read (ientin,*) sigma_d(k,i) ! 1st variant
+ if (i-nnt+1.gt.lim_xx) lim_xx=i-nnt+1 ! right?
+ enddo
+ lim_xx=nct-nnt+1
+ endif
+ enddo
+c
+c remove distance restraints not used in any model from the list
+c shift data in all arrays
+c
+ if (waga_dist.ne.0.0d0) then
+ ii=0
+ do i=nnt,nct-2
+ do j=i+2,nct
+ ii=ii+1
+ if (ii_in_use(ii).eq.0) then
+ do ki=ii,lim_odl-1
+ ires_homo(ki)=ires_homo(ki+1)
+ jres_homo(ki)=jres_homo(ki+1)
+ ii_in_use(ki)=ii_in_use(ki+1)
+ do k=1,constr_homology
+ odl(k,ki)=odl(k,ki+1)
+ sigma_odl(k,ki)=sigma_odl(k,ki+1)
+ l_homo(k,ki)=l_homo(k,ki+1)
+ enddo
+ enddo
+ ii=ii-1
+ lim_odl=lim_odl-1
+ endif
+ enddo
+ enddo
+ endif
+ if (constr_homology.gt.0) call homology_partition
+ if (constr_homology.gt.0) call init_int_table
+cd write (iout,*) "homology_partition: lim_theta= ",lim_theta,
+cd & "lim_xx=",lim_xx
+c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
+c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
+c
+c Print restraints
+c
+ if (.not.lprn) return
+cd write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
+ if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
+ write (iout,*) "Distance restraints from templates"
+ do ii=1,lim_odl
+ write(iout,'(3i5,100(2f8.2,1x,l1,4x))')
+ & ii,ires_homo(ii),jres_homo(ii),
+ & (odl(ki,ii),1.0d0/dsqrt(sigma_odl(ki,ii)),l_homo(ki,ii),
+ & ki=1,constr_homology)
+ enddo
+ write (iout,*) "Dihedral angle restraints from templates"
+ do i=nnt+3,lim_dih
+ write (iout,'(i5,100(2f8.2,4x))') i,(rad2deg*dih(ki,i),
+ & rad2deg/dsqrt(sigma_dih(ki,i)),ki=1,constr_homology)
+ enddo
+ write (iout,*) "Virtual-bond angle restraints from templates"
+ do i=nnt+2,lim_theta
+ write (iout,'(i5,100(2f8.2,4x))') i,(rad2deg*thetatpl(ki,i),
+ & rad2deg/dsqrt(sigma_theta(ki,i)),ki=1,constr_homology)
+ enddo
+ write (iout,*) "SC restraints from templates"
+ do i=nnt,lim_xx
+ write(iout,'(i5,100(4f8.2,4x))') i,
+ & (xxtpl(ki,i),yytpl(ki,i),zztpl(ki,i),
+ & 1.0d0/dsqrt(sigma_d(ki,i)),ki=1,constr_homology)
+ enddo
+ endif
+c -----------------------------------------------------------------
+ return
+ end
+c----------------------------------------------------------------------
open (isidep,file=sidename,status='old')
call mygetenv('SIDEP',sidepname)
open (isidep1,file=sidepname,status="old")
+ call mygetenv('LIPTRANPAR',liptranname)
+ open (iliptranpar,file=liptranname,status='old',action='read')
#ifndef OLDSCP
C
C 8/9/01 In the newest version SCp interaction constants are read from a file
include 'COMMON.SCCOR'
include 'COMMON.SCROT'
include 'COMMON.FREE'
+ include 'COMMON.CONTROL'
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
dimension blower(3,3,maxlob)
character*800 controlcard
character*16 key
integer iparm
double precision ip,mp
+ character*6 res1
C
C Body
C
write (iout,*) "iparm",iparm," myparm",myparm
c If reading not own parameters, skip assignment
+ call reada(controlcard,"D0CM",d0cm,3.78d0)
+ call reada(controlcard,"AKCM",akcm,15.1d0)
+ call reada(controlcard,"AKTH",akth,11.0d0)
+ call reada(controlcard,"AKCT",akct,12.0d0)
+ call reada(controlcard,"V1SS",v1ss,-1.08d0)
+ call reada(controlcard,"V2SS",v2ss,7.61d0)
+ call reada(controlcard,"V3SS",v3ss,13.7d0)
+ call reada(controlcard,"EBR",ebr,-5.50D0)
+ call reada(controlcard,"DTRISS",dtriss,1.0D0)
+ call reada(controlcard,"ATRISS",atriss,0.3D0)
+ call reada(controlcard,"BTRISS",btriss,0.02D0)
+ call reada(controlcard,"CTRISS",ctriss,1.0D0)
+ dyn_ss=(index(controlcard,'DYN_SS').gt.0)
+ write(iout,*) "ATRISS",atriss
+ write(iout,*) "BTRISS",btriss
+ write(iout,*) "CTRISS",ctriss
+ write(iout,*) "DTRISS",dtriss
+
+C do i=1,maxres
+C dyn_ss_mask(i)=.false.
+C enddo
+C ebr=-12.0D0
+c
+c Old arbitrary potential - commented out.
+c
+c dbr= 4.20D0
+c fbr= 3.30D0
+c
+c Constants of the disulfide-bond potential determined based on the RHF/6-31G**
+c energy surface of diethyl disulfide.
+c A. Liwo and U. Kozlowska, 11/24/03
+c
+ D0CM = 3.78d0
+ AKCM = 15.1d0
+ AKTH = 11.0d0
+ AKCT = 12.0d0
+ V1SS =-1.08d0
+ V2SS = 7.61d0
+ V3SS = 13.7d0
+
+ do i=1,maxres-1
+ do j=i+1,maxres
+ dyn_ssbond_ij(i,j)=1.0d300
+ enddo
+ enddo
+ call reada(controlcard,"HT",Ht,0.0D0)
+C if (dyn_ss) then
+C ss_depth=ebr/wsc-0.25*eps(1,1)
+C write(iout,*) HT,wsc,eps(1,1),'KURWA'
+C Ht=Ht/wsc-0.25*eps(1,1)
+
+C akcm=akcm*whpb/wsc
+C akth=akth*whpb/wsc
+C akct=akct*whpb/wsc
+C v1ss=v1ss*whpb/wsc
+C v2ss=v2ss*whpb/wsc
+C v3ss=v3ss*whpb/wsc
+C else
+C ss_depth=ebr/whpb-0.25*eps(1,1)*wsc/whpb
+C endif
if (iparm.eq.myparm .or. .not.separate_parset) then
c and Stokes' radii of the peptide group and side chains
c
#ifdef CRYST_BOND
- read (ibond,*) vbldp0,akp
+ read (ibond,*) vbldp0,vbldpdum,akp
do i=1,ntyp
nbondterm(i)=1
read (ibond,*) vbldsc0(1,i),aksc(1,i)
endif
enddo
#else
- read (ibond,*) ijunk,vbldp0,akp,rjunk
+ read (ibond,*) ijunk,vbldp0,vbldpdum,akp,rjunk
do i=1,ntyp
read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i),
& j=1,nbondterm(i))
C of the virtual-bond valence angles theta
C
do i=1,ntyp
- read (ithep,*) a0thet(i),(athet(j,i),j=1,2),(bthet(j,i),j=1,2)
+ read (ithep,*) a0thet(i),(athet(j,i,1,1),j=1,2),
+ & (bthet(j,i,1,1),j=1,2)
read (ithep,*) (polthet(j,i),j=0,3)
- read (ithep,*) (gthet(j,i),j=1,3)
- read (ithep,*) theta0(i),sig0(i),sigc0(i)
- sigc0(i)=sigc0(i)**2
+ read (ithep,*) (gthet(j,i),j=1,3)
+ read (ithep,*) 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
& ' 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,*) (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
+ write (iout,*) "tu dochodze"
+ 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)') res1,res2,res3
- read (ithep,*) aa0thet(i,j,k)
- read (ithep,*)(aathet(l,i,j,k),l=1,ntheterm)
+ enddo
+C write (iout,*) "KURWA1"
+ do iblock=1,2
+ do i=0,nthetyp
+ do j=-nthetyp,nthetyp
+ do k=-nthetyp,nthetyp
+ read (ithep,'(6a)') res1
+ write(iout,*) res1,i,j,k
+ read (ithep,*) aa0thet(i,j,k,iblock)
+ read (ithep,*)(aathet(l,i,j,k,iblock),l=1,ntheterm)
read (ithep,*)
- & ((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,*)
- & (((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
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 write(iout,*) "KURWA1.5"
+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
bsc(1,i)=0.0D0
read(irotam,*)(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,*) bsc(j,i)
read (irotam,*) (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
read (itorp,*) ntortyp
read (itorp,*) (itortyp(i),i=1,ntyp)
write (iout,*) 'ntortyp',ntortyp
- do i=1,ntortyp
- do j=1,ntortyp
- read (itorp,*) nterm(i,j),nlor(i,j)
+ do iblock=1,2
+ do i=-ntyp,-1
+ itortyp(i)=-itortyp(-i)
+ enddo
+c write (iout,*) 'ntortyp',ntortyp
+ do i=0,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ read (itorp,*) 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,*) 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,*) 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
- enddo
- do k=1,nlor(i,j)
- read (itorp,*) kk,vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j)
+ enddo
+ do k=1,nlor(i,j,iblock)
+ read (itorp,*) kk,vlor1(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
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)') 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
+ call MPI_Finalize(Ierror)
+#endif
stop "Error in double torsional parameter file"
endif
- read (itordp,*) ntermd_1(i,j,k),ntermd_2(i,j,k)
- read (itordp,*) (v1c(1,l,i,j,k),l=1,ntermd_1(i,j,k))
- read (itordp,*) (v1s(1,l,i,j,k),l=1,ntermd_1(i,j,k))
- read (itordp,*) (v1c(2,l,i,j,k),l=1,ntermd_1(i,j,k))
- read (itordp,*) (v1s(2,l,i,j,k),l=1,ntermd_1(i,j,k))
- read (itordp,*) ((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,*) 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,*) (v1c(1,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+ read (itordp,*) (v1s(1,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+ read (itordp,*) (v1c(2,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+ read (itordp,*) (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,*) ((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 interaction energy of the Gly, Ala, and Pro prototypes.
C
read (ifourier,*) nloctyp
- do i=1,nloctyp
+ do i=0,nloctyp-1
read (ifourier,*)
read (ifourier,*) (b(ii,i),ii=1,13)
if (lprint) then
endif
B1(1,i) = b(3,i)
B1(2,i) = b(5,i)
+ B1(1,-i) = b(3,i)
+ B1(2,-i) = -b(5,i)
+c b1(1,i)=0.0d0
+c b1(2,i)=0.0d0
B1tilde(1,i) = b(3,i)
- B1tilde(2,i) =-b(5,i)
+ B1tilde(2,i) =-b(5,i)
+ B1tilde(1,-i) =-b(3,i)
+ B1tilde(2,-i) =b(5,i)
+c b1tilde(1,i)=0.0d0
+c b1tilde(2,i)=0.0d0
B2(1,i) = b(2,i)
B2(2,i) = b(4,i)
+ B2(1,-i) =b(2,i)
+ B2(2,-i) =-b(4,i)
+
+c b2(1,i)=0.0d0
+c b2(2,i)=0.0d0
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,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,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,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,i)+b(11,i)
EE(2,2,i)=-b(10,i)+b(11,i)
EE(2,1,i)= b(12,i)-b(13,i)
EE(1,2,i)= b(12,i)+b(13,i)
+ EE(1,1,-i)= b(10,i)+b(11,i)
+ EE(2,2,-i)=-b(10,i)+b(11,i)
+ EE(2,1,-i)=-b(12,i)+b(13,i)
+ EE(1,2,-i)=-b(12,i)-b(13,i)
+
+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
if (lprint) then
do i=1,nloctyp
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
+ lprint=.true.
if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j),
& ael6(i,j),ael3(i,j)
+ lprint=.false.
enddo
enddo
C
endif
goto 50
C---------------------- GB or BP potential -----------------------------
- 30 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp),
- & (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip0(i),i=1,ntyp),
- & (alp(i),i=1,ntyp)
+ 30 do i=1,ntyp
+ read (isidep,*)(eps(i,j),j=i,ntyp)
+ enddo
+ read (isidep,*)(sigma0(i),i=1,ntyp)
+ read (isidep,*)(sigii(i),i=1,ntyp)
+ read (isidep,*)(chip(i),i=1,ntyp)
+ read (isidep,*)(alp(i),i=1,ntyp)
+ do i=1,ntyp
+ read (isidep,*)(epslip(i,j),j=i,ntyp)
+C write(iout,*) "WARNING!!",i,ntyp
+ write(iout,*) "epslip", i, (epslip(i,j),j=i,ntyp)
+C do j=1,ntyp
+C epslip(i,j)=epslip(i,j)+0.05d0
+C enddo
+ enddo
C For the GB potential convert sigma'**2 into chi'
if (ipot.eq.4) then
do i=1,ntyp
- chip(i)=(chip0(i)-1.0D0)/(chip0(i)+1.0D0)
+ chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0)
enddo
endif
if (lprint) then
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
do i=1,ntyp
do j=i,ntyp
epsij=eps(i,j)
+ epsijlip=epslip(i,j)
if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then
rrij=sigma(i,j)
else
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)
+ 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 constants of the disulfide bridge
C
- ebr=-5.50D0
+C ebr=-12.0D0
c
c Old arbitrary potential - commented out.
c
c energy surface of diethyl disulfide.
c A. Liwo and U. Kozlowska, 11/24/03
c
- D0CM = 3.78d0
- AKCM = 15.1d0
- AKTH = 11.0d0
- AKCT = 12.0d0
- V1SS =-1.08d0
- V2SS = 7.61d0
- V3SS = 13.7d0
+C D0CM = 3.78d0
+C AKCM = 15.1d0
+C AKTH = 11.0d0
+C AKCT = 12.0d0
+C V1SS =-1.08d0
+C V2SS = 7.61d0
+C V3SS = 13.7d0
+ write (iout,*) dyn_ss,'dyndyn'
+ if (dyn_ss) then
+ ss_depth=ebr/wsc-0.25*eps(1,1)
+C write(iout,*) akcm,whpb,wsc,'KURWA'
+ Ht=Ht/wsc-0.25*eps(1,1)
- if (lprint) then
+ akcm=akcm*whpb/wsc
+ akth=akth*whpb/wsc
+ akct=akct*whpb/wsc
+ v1ss=v1ss*whpb/wsc
+ v2ss=v2ss*whpb/wsc
+ v3ss=v3ss*whpb/wsc
+ else
+ ss_depth=ebr/whpb-0.25*eps(1,1)*wsc/whpb
+ endif
+
+C if (lprint) then
write (iout,'(/a)') "Disulfide bridge parameters:"
write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr
write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm
write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct
write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss,
& ' v3ss:',v3ss
- endif
+C endif
return
end
subroutine permut(isym)
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
+ include 'DIMENSIONS.FREE'
include 'COMMON.LOCAL'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
include 'DIMENSIONS.COMPAR'
+ include 'DIMENSIONS.FREE'
include 'COMMON.IOUNITS'
include 'COMMON.TIME1'
include 'COMMON.SBRIDGE'
subroutine promienie(*)
implicit none
include 'DIMENSIONS'
+ include 'DIMENSIONS.FREE'
include 'COMMON.CONTROL'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
enddo
close (isidep1)
do i=1,ntyp1
- if (i.eq.10 .or. i.eq.21) then
+ if (i.eq.10 .or. i.eq.ntyp1) then
dsc_inv(i)=0.0d0
else
dsc_inv(i)=1.0d0/dsc(i)
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
include 'DIMENSIONS.COMPAR'
+ include 'DIMENSIONS.FREE'
include 'COMMON.IOUNITS'
include 'COMMON.COMPAR'
include 'COMMON.CHAIN'
subroutine read_dist_constr
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
+ include 'DIMENSIONS.FREE'
#ifdef MPI
include 'mpif.h'
#endif
character*500 controlcard
logical lprn /.true./
write (iout,*) "Calling read_dist_constr"
- write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup
+C write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup
+C call flush(iout)
+ write(iout,*) "TU sie wywalam?"
+ call card_concat(controlcard,.false.)
+ write (iout,*) controlcard
call flush(iout)
- call card_concat(controlcard)
call readi(controlcard,"NFRAG",nfrag_,0)
call readi(controlcard,"NPAIR",npair_,0)
call readi(controlcard,"NDIST",ndist_,0)
endif
enddo
do i=1,ndist_
+ if (constr_dist.eq.11) then
+ read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i),
+ & ibecarb(i),forcon(nhpb+1),fordepth(nhpb+1)
+ fordepth(nhpb+1)=fordepth(nhpb+1)/forcon(nhpb+1)
+C write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
+C & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
+ else
read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1)
+ endif
if (forcon(nhpb+1).gt.0.0d0) then
nhpb=nhpb+1
- dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
+ if (ibecarb(i).gt.0) then
+ ihpb(i)=ihpb(i)+nres
+ jhpb(i)=jhpb(i)+nres
+ endif
+ if (dhpb(nhpb).eq.0.0d0)
+ & dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
+C dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
& nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
endif
+C endif
enddo
+ call hpb_partition
call flush(iout)
return
end
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
include 'DIMENSIONS.COMPAR'
+ include 'DIMENSIONS.FREE'
include 'COMMON.IOUNITS'
include 'COMMON.GEO'
include 'COMMON.VAR'
logical seq_comp
integer i,j,k,nres_pdb,iaux
double precision ddsc,dist
+ integer nnt_old,nct_old
integer ilen,kkk
external ilen
C
nres0=nres
+ nnt_old=nnt
+ nct_old=nct
write (iout,*) "pdbref",pdbref
if (pdbref) then
read(inp,'(a)') pdbfile
& 'Number of residues to be superposed:',nsup,
& ' (from residue',nstart_sup,' to residue',
& nend_sup,').'
+ nres=nres0
+ nnt=nnt_old
+ nct=nct_old
return
end
C geometry.
implicit none
include 'DIMENSIONS'
+ include 'DIMENSIONS.FREE'
include 'DIMENSIONS.ZSCOPT'
include 'COMMON.CONTROL'
include 'COMMON.LOCAL'
goto 10
else if (card(:3).eq.'TER') then
C End current chain
- ires_old=ires+1
- itype(ires_old)=21
+c ires_old=ires+1
+ ires_old=ires+2
+ itype(ires_old-1)=ntyp1
+ itype(ires_old)=ntyp1
ibeg=2
c write (iout,*) "Chain ended",ires,ishift,ires_old
call sccenter(ires,iii,sccor)
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
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
+
+ if (itype(i).eq.ntyp1) then
+ if (itype(i+1).eq.ntyp1) 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
+C if (unres_pdb) then
+C 2/15/2013 by Adam: corrected insertion of the last dummy residue
+C call refsys(i-3,i-2,i-1,e1,e2,e3,fail)
+C if (fail) then
+C e2(1)=0.0d0
+C e2(2)=1.0d0
+C e2(3)=0.0d0
+C endif !fail
+C do j=1,3
+C c(j,i)=c(j,i-1)-1.9d0*e2(j)
+C enddo
+C else !unres_pdb
+ do j=1,3
+ dcj=(c(j,i-2)-c(j,i-3))/2.0
+ c(j,i)=c(j,i-1)+dcj
+ c(j,nres+i)=c(j,i)
+ enddo
+C endif !unres_pdb
+ else !itype(i+1).eq.ntyp1
+C if (unres_pdb) then
+C 2/15/2013 by Adam: corrected insertion of the first dummy residue
+C call refsys(i+1,i+2,i+3,e1,e2,e3,fail)
+C if (fail) then
+C e2(1)=0.0d0
+C e2(2)=1.0d0
+C e2(3)=0.0d0
+C endif
+C do j=1,3
+C c(j,i)=c(j,i+1)-1.9d0*e2(j)
+C enddo
+C else !unres_pdb
+ do j=1,3
+ dcj=(c(j,i+3)-c(j,i+2))/2.0
+ c(j,i)=c(j,i+1)-dcj
+ c(j,nres+i)=c(j,i)
+ enddo
+C endif !unres_pdb
+ endif !itype(i+1).eq.ntyp1
+ endif !itype.eq.ntyp1
enddo
C Calculate the CM of the last side chain.
call sccenter(ires,iii,sccor)
nstart_sup=1
if (itype(nres).ne.10) then
nres=nres+1
- itype(nres)=21
+ itype(nres)=ntyp1
do j=1,3
- dcj=c(j,nres-2)-c(j,nres-3)
+ dcj=(c(j,nres-2)-c(j,nres-3))/2.0
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
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
& ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3),
& (c(j,nres+ires),j=1,3)
enddo
+ call int_from_cart1(.false.)
call int_from_cart(.true.,.false.)
+ call sc_loc_geom(.true.)
write (iout,*) "After int_from_cart"
call flush(iout)
do i=1,nres-1
c write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3),
c & vbld_inv(i+nres)
enddo
+ do i=1,nres
+ thetaref(i)=theta(i)
+ phiref(i)=phi(i)
+c
+ phi_ref(i)=phi(i)
+ theta_ref(i)=theta(i)
+ alph_ref(i)=alph(i)
+ omeg_ref(i)=omeg(i)
+ enddo
+
c call chainbuild
C Copy the coordinates to reference coordinates
c do i=1,2*nres
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).and.(i.ne.nres)) then
chain_length=lll-1
kkk=kkk+1
c write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
do j=1,3
cref(j,i,cou)=c(j,i)
cref(j,i+nres,cou)=c(j,i+nres)
- if ((i.le.nres).and.(symetr.gt.1)) then
+ if (i.le.nres) then
chain_rep(j,lll,kkk)=c(j,i)
chain_rep(j,lll+nres,kkk)=c(j,i+nres)
endif
enddo
enddo
- if (symetr.gt.1) then
+ if (chain_length.eq.0) chain_length=nres
+ write (iout,*) chain_length
do j=1,3
chain_rep(j,chain_length,symetr)=chain_rep(j,chain_length,1)
chain_rep(j,chain_length+nres,symetr)
&=chain_rep(j,chain_length+nres,1)
enddo
- endif
c diagnostic
c diagnostic
& ' Phi'
endif
endif
- do i=2,nres
+ do i=1,nres-1
iti=itype(i)
- write (iout,*) i,i-1,(c(j,i),j=1,3),(c(j,i-1),j=1,3),dist(i,i-1)
- if (itype(i-1).ne.21 .and. itype(i).ne.21 .and.
- & (dist(i,i-1).lt.2.0D0 .or. dist(i,i-1).gt.5.0D0)) then
+ 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
stop
endif
- theta(i+1)=alpha(i-1,i,i+1)
+ vbld(i+1)=dist(i,i+1)
+ vbld_inv(i+1)=1.0d0/vbld(i+1)
+ if (i.gt.1) theta(i+1)=alpha(i-1,i,i+1)
if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1)
enddo
- if (itype(1).eq.21) then
- do j=1,3
- c(j,1)=c(j,2)+(c(j,3)-c(j,4))
- enddo
- endif
- if (itype(nres).eq.21) then
- do j=1,3
- c(j,nres)=c(j,nres-1)+(c(j,nres-2)-c(j,nres-3))
- enddo
- endif
if (lside) then
do i=2,nres-1
do j=1,3
endif
return
end
+
+c-------------------------------------------------------------------------------
+ subroutine sc_loc_geom(lprn)
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.FREE'
+ include 'COMMON.LOCAL'
+ include 'COMMON.VAR'
+ include 'COMMON.CHAIN'
+ include 'COMMON.INTERACT'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.GEO'
+ include 'COMMON.NAMES'
+ include 'COMMON.CONTROL'
+ include 'COMMON.SETUP'
+ double precision x_prime(3),y_prime(3),z_prime(3)
+ logical lprn
+ do i=1,nres-1
+ do j=1,3
+ dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i))
+ enddo
+ enddo
+ do i=2,nres-1
+ 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
+ else
+ do j=1,3
+ dc_norm(j,i+nres)=0.0d0
+ enddo
+ endif
+ enddo
+ do i=2,nres-1
+ costtab(i+1) =dcos(theta(i+1))
+ sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
+ cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
+ sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
+ cosfac2=0.5d0/(1.0d0+costtab(i+1))
+ cosfac=dsqrt(cosfac2)
+ sinfac2=0.5d0/(1.0d0-costtab(i+1))
+ sinfac=dsqrt(sinfac2)
+ it=itype(i)
+ if (it.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
+c
+ do j=1,3
+ x_prime(j) = 0.00
+ y_prime(j) = 0.00
+ z_prime(j) = 0.00
+ enddo
+ do j = 1,3
+ x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
+ y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
+ enddo
+ call vecpr(x_prime,y_prime,z_prime)
+c
+C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
+C to local coordinate system. Store in xx, yy, zz.
+c
+ xx=0.0d0
+ yy=0.0d0
+ zz=0.0d0
+ do j = 1,3
+ xx = xx + x_prime(j)*dc_norm(j,i+nres)
+ yy = yy + y_prime(j)*dc_norm(j,i+nres)
+ zz = zz + z_prime(j)*dc_norm(j,i+nres)
+ enddo
+
+ xxref(i)=xx
+ yyref(i)=yy
+ zzref(i)=zz
+ else
+ xxref(i)=0.0d0
+ yyref(i)=0.0d0
+ zzref(i)=0.0d0
+ endif
+ enddo
+ if (lprn) then
+ do i=2,nres
+ iti=itype(i)
+ if(me.eq.king.or..not.out1file)
+ & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i),
+ & yyref(i),zzref(i)
+ enddo
+ endif
+ return
+ end
c---------------------------------------------------------------------------
subroutine sccenter(ires,nscat,sccor)
implicit none
include "COMMON.FREE"
include "COMMON.CONTROL"
include "COMMON.ENERGIES"
+ include "COMMON.SPLITELE"
+ include "COMMON.SBRIDGE"
character*800 controlcard
integer i,j,k,ii,n_ene_found
integer ind,itype1,itype2,itypf,itypsc,itypp
character*16 ucase
character*16 key
external ucase
-
+ double precision pi
call card_concat(controlcard,.true.)
call readi(controlcard,"N_ENE",n_ene,max_ene)
if (n_ene.gt.max_ene) then
call readi(controlcard,"RESCALE",rescale_mode,1)
check_conf=index(controlcard,"NO_CHECK_CONF").eq.0
call reada(controlcard,'DISTCHAINMAX',distchainmax,50.0d0)
+ 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
call readi(controlcard,'SYM',symetr,1)
write (iout,*) "DISTCHAINMAX",distchainmax
write (iout,*) "delta",delta
zscfile=index(controlcard,"ZSCFILE").gt.0
with_dihed_constr = index(controlcard,"WITH_DIHED_CONSTR").gt.0
write (iout,*) "with_dihed_constr ",with_dihed_constr
+ with_theta_constr = index(controlcard,"WITH_THETA_CONSTR").gt.0
+ write (iout,*) "with_theta_constr ",with_theta_constr
call readi(controlcard,'CONSTR_DIST',constr_dist,0)
+ write (iout,*) "with_dihed_constr ",with_dihed_constr,
+ & " CONSTR_DIST",constr_dist
+ call readi(controlcard,'CONSTR_HOMOL',constr_homology,0)
+ write (iout,*) "with_homology_constr ",with_dihed_constr,
+ & " CONSTR_HOMOLOGY",constr_homology
+ refstr = index(controlcard,'REFSTR').gt.0
+ pdbref = index(controlcard,'PDBREF').gt.0
+ dyn_ss=(index(controlcard,'DYN_SS').gt.0)
+C /06/28/2013 Adasko: dyn_ss is keyword allowing to break and create bond
+C disulfide bond. Note that in conterary to dynamics this in
+C CONTROLCARD. The bond are read in molread_zs.F
+ call flush(iout)
return
end
c------------------------------------------------------------------------------
call flush(iout)
enddo
+ write (iout,*) "HOMOL_NSET",homol_nset
enddo
if (hamil_rep) then
external ilen,iroof
double precision rmsdev,energia(0:max_ene),efree,eini,temp
double precision prop(maxQ)
- integer ntot_all(maxslice,0:maxprocs-1)
+ integer ntot_all(maxslice,0:maxprocs-1), maxslice_buff
integer iparm,ib,iib,ir,nprop,nthr,npars
double precision etot,time
integer ixdrf,iret
#ifdef MPI
c Check if everyone has the same number of conformations
- call MPI_Allgather(stot(1),maxslice,MPI_INTEGER,
+
+c call MPI_ALLgather(MPI_IN_PLACE,stot(1),MPI_DATATYPE_NULL,
+c & ntot_all(1,0),maxslice,MPI_INTEGER,MPI_Comm_World,IERROR)
+
+ maxslice_buff=maxslice
+
+ call MPI_Allgather(stot(1),maxslice_buff,MPI_INTEGER,
& ntot_all(1,0),maxslice,MPI_INTEGER,MPI_Comm_World,IERROR)
lerr=.false.
do i=0,nprocs-1
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
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
include 'DIMENSIONS.COMPAR'
+ include 'DIMENSIONS.FREE'
include 'COMMON.IOUNITS'
include 'COMMON.COMPAR'
include 'COMMON.CHAIN'
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
include 'DIMENSIONS.COMPAR'
+ include 'DIMENSIONS.FREE'
include 'COMMON.CONTROL'
include 'COMMON.IOUNITS'
include 'COMMON.COMPAR'
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
include 'DIMENSIONS.COMPAR'
+ include 'DIMENSIONS.FREE'
include 'COMMON.IOUNITS'
include 'COMMON.COMPAR'
include 'COMMON.CHAIN'
rminrms=10.0d10
rmsminsing=10d10
nperm=1
+C write (iout,*) "tu2", nres,nsup
+ noverlap=nres
+ if (nres.gt.nsup) noverlap=nsup
+ write (iout,*) "tu3,",noverlap
do i=1,symetr
nperm=nperm*i
enddo
do kkk=1,nperm
nnsup=0
- do i=1,nres
- if (itype(i).ne.21) then
+ do i=1,noverlap
+ if (itype(i).ne.ntyp1) then
nnsup=nnsup+1
do j=1,3
cc(j,nnsup)=c(j,i)
include 'DIMENSIONS'
include 'DIMENSIONS.ZSCOPT'
include 'DIMENSIONS.COMPAR'
+ include 'DIMENSIONS.FREE'
include 'COMMON.IOUNITS'
include 'COMMON.TIME1'
include 'COMMON.FRAG'
--- /dev/null
+c----------------------------------------------------------------------------
+ subroutine check_energies
+c implicit none
+
+c Includes
+ include 'DIMENSIONS'
+ include 'COMMON.CHAIN'
+ include 'COMMON.VAR'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.SBRIDGE'
+ include 'COMMON.LOCAL'
+ include 'COMMON.GEO'
+
+c External functions
+ double precision ran_number
+ external ran_number
+
+c Local variables
+ integer i,j,k,l,lmax,p,pmax
+ double precision rmin,rmax
+ double precision eij
+
+ double precision d
+ double precision wi,rij,tj,pj
+
+
+c return
+
+ i=5
+ j=14
+
+ d=dsc(1)
+ rmin=2.0D0
+ rmax=12.0D0
+
+ lmax=10000
+ pmax=1
+
+ do k=1,3
+ c(k,i)=0.0D0
+ c(k,j)=0.0D0
+ c(k,nres+i)=0.0D0
+ c(k,nres+j)=0.0D0
+ enddo
+
+ do l=1,lmax
+
+ct wi=ran_number(0.0D0,pi)
+c wi=ran_number(0.0D0,pi/6.0D0)
+c wi=0.0D0
+ct tj=ran_number(0.0D0,pi)
+ct pj=ran_number(0.0D0,pi)
+c pj=ran_number(0.0D0,pi/6.0D0)
+c pj=0.0D0
+
+ do p=1,pmax
+ct rij=ran_number(rmin,rmax)
+
+ c(1,j)=d*sin(pj)*cos(tj)
+ c(2,j)=d*sin(pj)*sin(tj)
+ c(3,j)=d*cos(pj)
+
+ c(3,nres+i)=-rij
+
+ c(1,i)=d*sin(wi)
+ c(3,i)=-rij-d*cos(wi)
+
+ do k=1,3
+ dc(k,nres+i)=c(k,nres+i)-c(k,i)
+ dc_norm(k,nres+i)=dc(k,nres+i)/d
+ dc(k,nres+j)=c(k,nres+j)-c(k,j)
+ dc_norm(k,nres+j)=dc(k,nres+j)/d
+ enddo
+
+ call dyn_ssbond_ene(i,j,eij)
+ enddo
+ enddo
+
+ call exit(1)
+
+ return
+ end
+
+C-----------------------------------------------------------------------------
+
+ subroutine dyn_ssbond_ene(resi,resj,eij)
+c implicit none
+
+c Includes
+ include 'DIMENSIONS'
+ include 'COMMON.SBRIDGE'
+ include 'COMMON.CHAIN'
+ include 'COMMON.DERIV'
+ include 'COMMON.LOCAL'
+ include 'COMMON.INTERACT'
+ include 'COMMON.VAR'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.CALC'
+#ifndef CLUST
+#ifndef WHAM
+C include 'COMMON.MD'
+#endif
+#endif
+
+c External functions
+ double precision h_base
+ external h_base
+
+c Input arguments
+ integer resi,resj
+
+c Output arguments
+ double precision eij
+
+c Local variables
+ logical havebond
+c integer itypi,itypj,k,l
+ double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
+ double precision sig0ij,ljd,sig,fac,e1,e2
+ double precision dcosom1(3),dcosom2(3),ed
+ double precision pom1,pom2
+ double precision ljA,ljB,ljXs
+ double precision d_ljB(1:3)
+ double precision ssA,ssB,ssC,ssXs
+ double precision ssxm,ljxm,ssm,ljm
+ double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
+ double precision f1,f2,h1,h2,hd1,hd2
+ double precision omega,delta_inv,deltasq_inv,fac1,fac2
+c-------FIRST METHOD
+ double precision xm,d_xm(1:3)
+c-------END FIRST METHOD
+c-------SECOND METHOD
+c$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
+c-------END SECOND METHOD
+
+c-------TESTING CODE
+ logical checkstop,transgrad
+ common /sschecks/ checkstop,transgrad
+
+ integer icheck,nicheck,jcheck,njcheck
+ double precision echeck(-1:1),deps,ssx0,ljx0
+c-------END TESTING CODE
+
+
+ i=resi
+ j=resj
+
+ itypi=itype(i)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+ dsci_inv=vbld_inv(i+nres)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
+ if ((zi.gt.bordlipbot)
+ &.and.(zi.lt.bordliptop)) then
+C the energy transfer exist
+ if (zi.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((zi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipi=1.0d0
+ ssgradlipi=0.0
+ endif
+ else
+ sslipi=0.0d0
+ ssgradlipi=0.0
+ endif
+ itypj=itype(j)
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.gt.bordlipbot)
+ &.and.(zj.lt.bordliptop)) then
+C the energy transfer exist
+ if (zj.lt.buflipbot) then
+C what fraction I am in
+ fracinbuf=1.0d0-
+ & ((zj-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zj.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipj=1.0d0
+ ssgradlipj=0.0
+ endif
+ else
+ sslipj=0.0d0
+ ssgradlipj=0.0
+ endif
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=xj-xi
+ yj=yj-yi
+ zj=zj-zi
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ dscj_inv=vbld_inv(j+nres)
+
+ chi1=chi(itypi,itypj)
+ chi2=chi(itypj,itypi)
+ chi12=chi1*chi2
+ chip1=chip(itypi)
+ chip2=chip(itypj)
+ chip12=chip1*chip2
+ alf1=alp(itypi)
+ alf2=alp(itypj)
+ alf12=0.5D0*(alf1+alf2)
+
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
+c The following are set in sc_angular
+c erij(1)=xj*rij
+c erij(2)=yj*rij
+c erij(3)=zj*rij
+c om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
+c om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
+c om12=dxi*dxj+dyi*dyj+dzi*dzj
+ call sc_angular
+ rij=1.0D0/rij ! Reset this so it makes sense
+
+ sig0ij=sigma(itypi,itypj)
+ sig=sig0ij*dsqrt(1.0D0/sigsq)
+
+ ljXs=sig-sig0ij
+ ljA=eps1*eps2rt**2*eps3rt**2
+ ljB=ljA*bb
+ ljA=ljA*aa
+ ljxm=ljXs+(-2.0D0*aa/bb)**(1.0D0/6.0D0)
+
+ ssXs=d0cm
+ deltat1=1.0d0-om1
+ deltat2=1.0d0+om2
+ deltat12=om2-om1+2.0d0
+ cosphi=om12-om1*om2
+ ssA=akcm
+ ssB=akct*deltat12
+ ssC=ss_depth
+ & +akth*(deltat1*deltat1+deltat2*deltat2)
+ & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
+ ssxm=ssXs-0.5D0*ssB/ssA
+
+c-------TESTING CODE
+c$$$c Some extra output
+c$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
+c$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
+c$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
+c$$$ if (ssx0.gt.0.0d0) then
+c$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
+c$$$ else
+c$$$ ssx0=ssxm
+c$$$ endif
+c$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+c$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
+c$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
+c$$$ return
+c-------END TESTING CODE
+
+c-------TESTING CODE
+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/aa
+ if (ssm.lt.ljm .and.
+ & dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
+ nicheck=1000
+ njcheck=1
+ deps=0.5d-7
+ else
+ checkstop=.false.
+ endif
+ endif
+ if (.not.checkstop) then
+ nicheck=0
+ njcheck=-1
+ endif
+
+ do icheck=0,nicheck
+ do jcheck=-1,njcheck
+ if (checkstop) rij=(ssxm-1.0d0)+
+ & ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
+c-------END TESTING CODE
+
+ if (rij.gt.ljxm) then
+ havebond=.false.
+ ljd=rij-ljXs
+ fac=(1.0D0/ljd)**expon
+ e1=fac*fac*aa
+ e2=fac*bb
+ eij=eps1*eps2rt*eps3rt*(e1+e2)
+C write(iout,*) eij,'TU?1'
+ eps2der=eij*eps3rt
+ eps3der=eij*eps2rt
+ eij=eij*eps2rt*eps3rt
+
+ sigder=-sig/sigsq
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ ed=-expon*(e1+eij)/ljd
+ sigder=ed*sigder
+ 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
+ & -2.0D0*alf12*eps3der+sigder*sigsq_om12
+ else if (rij.lt.ssxm) then
+ havebond=.true.
+ ssd=rij-ssXs
+ eij=ssA*ssd*ssd+ssB*ssd+ssC
+C write(iout,*) 'TU?2',ssc,ssd
+ ed=2*akcm*ssd+akct*deltat12
+ pom1=akct*ssd
+ pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
+ eom1=-2*akth*deltat1-pom1-om2*pom2
+ eom2= 2*akth*deltat2+pom1-om1*pom2
+ eom12=pom2
+ else
+ omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
+
+ d_ssxm(1)=0.5D0*akct/ssA
+ d_ssxm(2)=-d_ssxm(1)
+ d_ssxm(3)=0.0D0
+
+ d_ljxm(1)=sig0ij/sqrt(sigsq**3)
+ d_ljxm(2)=d_ljxm(1)*sigsq_om2
+ d_ljxm(3)=d_ljxm(1)*sigsq_om12
+ d_ljxm(1)=d_ljxm(1)*sigsq_om1
+
+c-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
+ xm=0.5d0*(ssxm+ljxm)
+ do k=1,3
+ d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
+ enddo
+ if (rij.lt.xm) then
+ havebond=.true.
+ ssm=ssC-0.25D0*ssB*ssB/ssA
+ d_ssm(1)=0.5D0*akct*ssB/ssA
+ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
+ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
+ d_ssm(3)=omega
+ f1=(rij-xm)/(ssxm-xm)
+ f2=(rij-ssxm)/(xm-ssxm)
+ h1=h_base(f1,hd1)
+ h2=h_base(f2,hd2)
+ eij=ssm*h1+Ht*h2
+C write(iout,*) eij,'TU?3'
+ delta_inv=1.0d0/(xm-ssxm)
+ deltasq_inv=delta_inv*delta_inv
+ fac=ssm*hd1-Ht*hd2
+ fac1=deltasq_inv*fac*(xm-rij)
+ fac2=deltasq_inv*fac*(rij-ssxm)
+ ed=delta_inv*(Ht*hd2-ssm*hd1)
+ 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/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)
+ d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
+ f1=(rij-ljxm)/(xm-ljxm)
+ f2=(rij-xm)/(ljxm-xm)
+ h1=h_base(f1,hd1)
+ h2=h_base(f2,hd2)
+ eij=Ht*h1+ljm*h2
+C write(iout,*) 'TU?4',ssA
+ delta_inv=1.0d0/(ljxm-xm)
+ deltasq_inv=delta_inv*delta_inv
+ fac=Ht*hd1-ljm*hd2
+ fac1=deltasq_inv*fac*(ljxm-rij)
+ fac2=deltasq_inv*fac*(rij-xm)
+ ed=delta_inv*(ljm*hd2-Ht*hd1)
+ 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)
+ endif
+c-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
+
+c-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
+c$$$ ssd=rij-ssXs
+c$$$ ljd=rij-ljXs
+c$$$ fac1=rij-ljxm
+c$$$ fac2=rij-ssxm
+c$$$
+c$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
+c$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
+c$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
+c$$$
+c$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
+c$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
+c$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
+c$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
+c$$$ d_ssm(3)=omega
+c$$$
+c$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
+c$$$ do k=1,3
+c$$$ d_ljm(k)=ljm*d_ljB(k)
+c$$$ enddo
+c$$$ ljm=ljm*ljB
+c$$$
+c$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
+c$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
+c$$$ d_ss(2)=akct*ssd
+c$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
+c$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
+c$$$ d_ss(3)=omega
+c$$$
+c$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
+c$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
+c$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
+c$$$ do k=1,3
+c$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
+c$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
+c$$$ enddo
+c$$$ ljf=ljm+ljf*ljB*fac1*fac1
+c$$$
+c$$$ f1=(rij-ljxm)/(ssxm-ljxm)
+c$$$ f2=(rij-ssxm)/(ljxm-ssxm)
+c$$$ h1=h_base(f1,hd1)
+c$$$ h2=h_base(f2,hd2)
+c$$$ eij=ss*h1+ljf*h2
+c$$$ delta_inv=1.0d0/(ljxm-ssxm)
+c$$$ deltasq_inv=delta_inv*delta_inv
+c$$$ fac=ljf*hd2-ss*hd1
+c$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
+c$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
+c$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
+c$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
+c$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
+c$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
+c$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
+c$$$
+c$$$ havebond=.false.
+c$$$ if (ed.gt.0.0d0) havebond=.true.
+c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
+
+ endif
+ write(iout,*) 'havebond',havebond
+ if (havebond) then
+#ifndef CLUST
+#ifndef WHAM
+c if (dyn_ssbond_ij(i,j).eq.1.0d300) then
+c write(iout,'(a15,f12.2,f8.1,2i5)')
+c & "SSBOND_E_FORM",totT,t_bath,i,j
+c endif
+#endif
+#endif
+ dyn_ssbond_ij(i,j)=eij
+ else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
+ dyn_ssbond_ij(i,j)=1.0d300
+#ifndef CLUST
+#ifndef WHAM
+c write(iout,'(a15,f12.2,f8.1,2i5)')
+c & "SSBOND_E_BREAK",totT,t_bath,i,j
+#endif
+#endif
+ endif
+
+c-------TESTING CODE
+ if (checkstop) then
+ if (jcheck.eq.0) write(iout,'(a,3f15.8,$)')
+ & "CHECKSTOP",rij,eij,ed
+ echeck(jcheck)=eij
+ endif
+ enddo
+ if (checkstop) then
+ write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
+ endif
+ enddo
+ if (checkstop) then
+ transgrad=.true.
+ checkstop=.false.
+ endif
+c-------END TESTING CODE
+
+ do k=1,3
+ dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
+ dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
+ enddo
+ do k=1,3
+ gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
+ enddo
+ do k=1,3
+ gvdwx(k,i)=gvdwx(k,i)-gg(k)
+ & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
+ & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ gvdwx(k,j)=gvdwx(k,j)+gg(k)
+ & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
+ & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ enddo
+cgrad do k=i,j-1
+cgrad do l=1,3
+cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
+cgrad enddo
+cgrad enddo
+
+ do l=1,3
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ enddo
+
+ return
+ end
+
+C-----------------------------------------------------------------------------
+
+ double precision function h_base(x,deriv)
+c A smooth function going 0->1 in range [0,1]
+c It should NOT be called outside range [0,1], it will not work there.
+ implicit none
+
+c Input arguments
+ double precision x
+
+c Output arguments
+ double precision deriv
+
+c Local variables
+ double precision xsq
+
+
+c Two parabolas put together. First derivative zero at extrema
+c$$$ if (x.lt.0.5D0) then
+c$$$ h_base=2.0D0*x*x
+c$$$ deriv=4.0D0*x
+c$$$ else
+c$$$ deriv=1.0D0-x
+c$$$ h_base=1.0D0-2.0D0*deriv*deriv
+c$$$ deriv=4.0D0*deriv
+c$$$ endif
+
+c Third degree polynomial. First derivative zero at extrema
+ h_base=x*x*(3.0d0-2.0d0*x)
+ deriv=6.0d0*x*(1.0d0-x)
+
+c Fifth degree polynomial. First and second derivatives zero at extrema
+c$$$ xsq=x*x
+c$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
+c$$$ deriv=x-1.0d0
+c$$$ deriv=deriv*deriv
+c$$$ deriv=30.0d0*xsq*deriv
+
+ return
+ end
+
+c----------------------------------------------------------------------------
+
+ subroutine dyn_set_nss
+c Adjust nss and other relevant variables based on dyn_ssbond_ij
+c implicit none
+
+c Includes
+ include 'DIMENSIONS'
+#ifdef MPI
+ include "mpif.h"
+#endif
+ include 'COMMON.SBRIDGE'
+ include 'COMMON.CHAIN'
+ include 'COMMON.IOUNITS'
+C include 'COMMON.SETUP'
+#ifndef CLUST
+#ifndef WHAM
+C include 'COMMON.MD'
+#endif
+#endif
+
+c Local variables
+ double precision emin
+ integer i,j,imin
+ integer diff,allflag(maxdim),allnss,
+ & allihpb(maxdim),alljhpb(maxdim),
+ & newnss,newihpb(maxdim),newjhpb(maxdim)
+ logical found
+ integer i_newnss(1024),displ(0:1024)
+ integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss
+
+ allnss=0
+ do i=1,nres-1
+ do j=i+1,nres
+ if (dyn_ssbond_ij(i,j).lt.1.0d300) then
+ allnss=allnss+1
+ allflag(allnss)=0
+ allihpb(allnss)=i
+ alljhpb(allnss)=j
+ endif
+ enddo
+ enddo
+
+cmc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
+
+ 1 emin=1.0d300
+ do i=1,allnss
+ if (allflag(i).eq.0 .and.
+ & dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
+ emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
+ imin=i
+ endif
+ enddo
+ if (emin.lt.1.0d300) then
+ allflag(imin)=1
+ do i=1,allnss
+ if (allflag(i).eq.0 .and.
+ & (allihpb(i).eq.allihpb(imin) .or.
+ & alljhpb(i).eq.allihpb(imin) .or.
+ & allihpb(i).eq.alljhpb(imin) .or.
+ & alljhpb(i).eq.alljhpb(imin))) then
+ allflag(i)=-1
+ endif
+ enddo
+ goto 1
+ endif
+
+cmc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
+
+ newnss=0
+ do i=1,allnss
+ if (allflag(i).eq.1) then
+ newnss=newnss+1
+ newihpb(newnss)=allihpb(i)
+ newjhpb(newnss)=alljhpb(i)
+ endif
+ enddo
+
+#ifdef MPI
+ if (nfgtasks.gt.1)then
+
+ call MPI_Reduce(newnss,g_newnss,1,
+ & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+ call MPI_Gather(newnss,1,MPI_INTEGER,
+ & i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_newnss(i-1)+displ(i-1)
+ enddo
+ call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,
+ & g_newihpb,i_newnss,displ,MPI_INTEGER,
+ & king,FG_COMM,IERR)
+ call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,
+ & g_newjhpb,i_newnss,displ,MPI_INTEGER,
+ & king,FG_COMM,IERR)
+ if(fg_rank.eq.0) then
+c print *,'g_newnss',g_newnss
+c print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
+c print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
+ newnss=g_newnss
+ do i=1,newnss
+ newihpb(i)=g_newihpb(i)
+ newjhpb(i)=g_newjhpb(i)
+ enddo
+ endif
+ endif
+#endif
+
+ diff=newnss-nss
+
+cmc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
+
+ do i=1,nss
+ found=.false.
+ do j=1,newnss
+ if (idssb(i).eq.newihpb(j) .and.
+ & jdssb(i).eq.newjhpb(j)) found=.true.
+ enddo
+#ifndef CLUST
+#ifndef WHAM
+c if (.not.found.and.fg_rank.eq.0)
+c & write(iout,'(a15,f12.2,f8.1,2i5)')
+c & "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
+#endif
+#endif
+ enddo
+
+ do i=1,newnss
+ found=.false.
+ do j=1,nss
+ if (newihpb(i).eq.idssb(j) .and.
+ & newjhpb(i).eq.jdssb(j)) found=.true.
+ enddo
+#ifndef CLUST
+#ifndef WHAM
+c if (.not.found.and.fg_rank.eq.0)
+c & write(iout,'(a15,f12.2,f8.1,2i5)')
+c & "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
+#endif
+#endif
+ enddo
+
+ nss=newnss
+ do i=1,nss
+ idssb(i)=newihpb(i)
+ jdssb(i)=newjhpb(i)
+ enddo
+
+ return
+ end
+
+c----------------------------------------------------------------------------
+
+#ifdef WHAM
+ subroutine read_ssHist
+ implicit none
+
+c Includes
+ include 'DIMENSIONS'
+ include "DIMENSIONS.FREE"
+ include 'COMMON.FREE'
+
+c Local variables
+ integer i,j
+ character*80 controlcard
+
+ do i=1,dyn_nssHist
+ call card_concat(controlcard,.true.)
+ read(controlcard,*)
+ & dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
+ enddo
+
+ return
+ end
+#endif
+
+c----------------------------------------------------------------------------
+
+
+C-----------------------------------------------------------------------------
+C-----------------------------------------------------------------------------
+C-----------------------------------------------------------------------------
+C-----------------------------------------------------------------------------
+C-----------------------------------------------------------------------------
+C-----------------------------------------------------------------------------
+C-----------------------------------------------------------------------------
+
+c$$$c-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine ss_relax(i_in,j_in)
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.INTERACT'
+c$$$
+c$$$c Input arguments
+c$$$ integer i_in,j_in
+c$$$
+c$$$c Local variables
+c$$$ integer i,iretcode,nfun_sc
+c$$$ logical scfail
+c$$$ double precision var(maxvar),e_sc,etot
+c$$$
+c$$$
+c$$$ mask_r=.true.
+c$$$ do i=nnt,nct
+c$$$ mask_side(i)=0
+c$$$ enddo
+c$$$ mask_side(i_in)=1
+c$$$ mask_side(j_in)=1
+c$$$
+c$$$c Minimize the two selected side-chains
+c$$$ call overlap_sc(scfail) ! Better not fail!
+c$$$ call minimize_sc(e_sc,var,iretcode,nfun_sc)
+c$$$
+c$$$ mask_r=.false.
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$c-------------------------------------------------------------
+c$$$
+c$$$ subroutine minimize_sc(etot_sc,iretcode,nfun)
+c$$$c Minimize side-chains only, starting from geom but without modifying
+c$$$c bond lengths.
+c$$$c If mask_r is already set, only the selected side-chains are minimized,
+c$$$c otherwise all side-chains are minimized keeping the backbone frozen.
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.GEO'
+c$$$ include 'COMMON.MINIM'
+c$$$ integer icall
+c$$$ common /srutu/ icall
+c$$$
+c$$$c Output arguments
+c$$$ double precision etot_sc
+c$$$ integer iretcode,nfun
+c$$$
+c$$$c External functions/subroutines
+c$$$ external func_sc,grad_sc,fdum
+c$$$
+c$$$c Local variables
+c$$$ integer liv,lv
+c$$$ parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
+c$$$ integer iv(liv)
+c$$$ double precision rdum(1)
+c$$$ double precision d(maxvar),v(1:lv),x(maxvar),xx(maxvar)
+c$$$ integer idum(1)
+c$$$ integer i,nvar_restr
+c$$$
+c$$$
+c$$$cmc start_minim=.true.
+c$$$ call deflt(2,iv,liv,lv,v)
+c$$$* 12 means fresh start, dont call deflt
+c$$$ iv(1)=12
+c$$$* max num of fun calls
+c$$$ if (maxfun.eq.0) maxfun=500
+c$$$ iv(17)=maxfun
+c$$$* max num of iterations
+c$$$ if (maxmin.eq.0) maxmin=1000
+c$$$ iv(18)=maxmin
+c$$$* controls output
+c$$$ iv(19)=1
+c$$$* selects output unit
+c$$$ iv(21)=0
+c$$$c iv(21)=iout ! DEBUG
+c$$$c iv(21)=8 ! DEBUG
+c$$$* 1 means to print out result
+c$$$ iv(22)=0
+c$$$c iv(22)=1 ! DEBUG
+c$$$* 1 means to print out summary stats
+c$$$ iv(23)=0
+c$$$c iv(23)=1 ! DEBUG
+c$$$* 1 means to print initial x and d
+c$$$ iv(24)=0
+c$$$c iv(24)=1 ! DEBUG
+c$$$* min val for v(radfac) default is 0.1
+c$$$ v(24)=0.1D0
+c$$$* max val for v(radfac) default is 4.0
+c$$$ v(25)=2.0D0
+c$$$c v(25)=4.0D0
+c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
+c$$$* the sumsl default is 0.1
+c$$$ v(26)=0.1D0
+c$$$* false conv if (act fnctn decrease) .lt. v(34)
+c$$$* the sumsl default is 100*machep
+c$$$ v(34)=v(34)/100.0D0
+c$$$* absolute convergence
+c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4
+c$$$ v(31)=tolf
+c$$$* relative convergence
+c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-1
+c$$$ v(32)=rtolf
+c$$$* controls initial step size
+c$$$ v(35)=1.0D-1
+c$$$* large vals of d correspond to small components of step
+c$$$ do i=1,nphi
+c$$$ d(i)=1.0D-1
+c$$$ enddo
+c$$$ do i=nphi+1,nvar
+c$$$ d(i)=1.0D-1
+c$$$ enddo
+c$$$
+c$$$ call geom_to_var(nvar,x)
+c$$$ IF (mask_r) THEN
+c$$$ do i=1,nres ! Just in case...
+c$$$ mask_phi(i)=0
+c$$$ mask_theta(i)=0
+c$$$ enddo
+c$$$ call x2xx(x,xx,nvar_restr)
+c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc,
+c$$$ & iv,liv,lv,v,idum,rdum,fdum)
+c$$$ call xx2x(x,xx)
+c$$$ ELSE
+c$$$c When minimizing ALL side-chains, etotal_sc is a little
+c$$$c faster if we don't set mask_r
+c$$$ do i=1,nres
+c$$$ mask_phi(i)=0
+c$$$ mask_theta(i)=0
+c$$$ mask_side(i)=1
+c$$$ enddo
+c$$$ call x2xx(x,xx,nvar_restr)
+c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc,
+c$$$ & iv,liv,lv,v,idum,rdum,fdum)
+c$$$ call xx2x(x,xx)
+c$$$ ENDIF
+c$$$ call var_to_geom(nvar,x)
+c$$$ call chainbuild_sc
+c$$$ etot_sc=v(10)
+c$$$ iretcode=iv(1)
+c$$$ nfun=iv(6)
+c$$$ return
+c$$$ end
+c$$$
+c$$$C--------------------------------------------------------------------------
+c$$$
+c$$$ subroutine chainbuild_sc
+c$$$ implicit none
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.INTERACT'
+c$$$
+c$$$c Local variables
+c$$$ integer i
+c$$$
+c$$$
+c$$$ do i=nnt,nct
+c$$$ if (.not.mask_r .or. mask_side(i).eq.1) then
+c$$$ call locate_side_chain(i)
+c$$$ endif
+c$$$ enddo
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$C--------------------------------------------------------------------------
+c$$$
+c$$$ subroutine func_sc(n,x,nf,f,uiparm,urparm,ufparm)
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.MINIM'
+c$$$ include 'COMMON.IOUNITS'
+c$$$
+c$$$c Input arguments
+c$$$ integer n
+c$$$ double precision x(maxvar)
+c$$$ double precision ufparm
+c$$$ external ufparm
+c$$$
+c$$$c Input/Output arguments
+c$$$ integer nf
+c$$$ integer uiparm(1)
+c$$$ double precision urparm(1)
+c$$$
+c$$$c Output arguments
+c$$$ double precision f
+c$$$
+c$$$c Local variables
+c$$$ double precision energia(0:n_ene)
+c$$$#ifdef OSF
+c$$$c Variables used to intercept NaNs
+c$$$ double precision x_sum
+c$$$ integer i_NAN
+c$$$#endif
+c$$$
+c$$$
+c$$$ nfl=nf
+c$$$ icg=mod(nf,2)+1
+c$$$
+c$$$#ifdef OSF
+c$$$c Intercept NaNs in the coordinates, before calling etotal_sc
+c$$$ x_sum=0.D0
+c$$$ do i_NAN=1,n
+c$$$ x_sum=x_sum+x(i_NAN)
+c$$$ enddo
+c$$$c Calculate the energy only if the coordinates are ok
+c$$$ if ((.not.(x_sum.lt.0.D0)) .and. (.not.(x_sum.ge.0.D0))) then
+c$$$ write(iout,*)" *** func_restr_sc : Found NaN in coordinates"
+c$$$ f=1.0D+77
+c$$$ nf=0
+c$$$ else
+c$$$#endif
+c$$$
+c$$$ call var_to_geom_restr(n,x)
+c$$$ call zerograd
+c$$$ call chainbuild_sc
+c$$$ call etotal_sc(energia(0))
+c$$$ f=energia(0)
+c$$$ if (energia(1).eq.1.0D20 .or. energia(0).eq.1.0D99) nf=0
+c$$$
+c$$$#ifdef OSF
+c$$$ endif
+c$$$#endif
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$c-------------------------------------------------------
+c$$$
+c$$$ subroutine grad_sc(n,x,nf,g,uiparm,urparm,ufparm)
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.INTERACT'
+c$$$ include 'COMMON.MINIM'
+c$$$
+c$$$c Input arguments
+c$$$ integer n
+c$$$ double precision x(maxvar)
+c$$$ double precision ufparm
+c$$$ external ufparm
+c$$$
+c$$$c Input/Output arguments
+c$$$ integer nf
+c$$$ integer uiparm(1)
+c$$$ double precision urparm(1)
+c$$$
+c$$$c Output arguments
+c$$$ double precision g(maxvar)
+c$$$
+c$$$c Local variables
+c$$$ double precision f,gphii,gthetai,galphai,gomegai
+c$$$ integer ig,ind,i,j,k,igall,ij
+c$$$
+c$$$
+c$$$ icg=mod(nf,2)+1
+c$$$ if (nf-nfl+1) 20,30,40
+c$$$ 20 call func_sc(n,x,nf,f,uiparm,urparm,ufparm)
+c$$$c write (iout,*) 'grad 20'
+c$$$ if (nf.eq.0) return
+c$$$ goto 40
+c$$$ 30 call var_to_geom_restr(n,x)
+c$$$ call chainbuild_sc
+c$$$C
+c$$$C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
+c$$$C
+c$$$ 40 call cartder
+c$$$C
+c$$$C Convert the Cartesian gradient into internal-coordinate gradient.
+c$$$C
+c$$$
+c$$$ ig=0
+c$$$ ind=nres-2
+c$$$ do i=2,nres-2
+c$$$ IF (mask_phi(i+2).eq.1) THEN
+c$$$ gphii=0.0D0
+c$$$ do j=i+1,nres-1
+c$$$ ind=ind+1
+c$$$ do k=1,3
+c$$$ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
+c$$$ gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
+c$$$ enddo
+c$$$ enddo
+c$$$ ig=ig+1
+c$$$ g(ig)=gphii
+c$$$ ELSE
+c$$$ ind=ind+nres-1-i
+c$$$ ENDIF
+c$$$ enddo
+c$$$
+c$$$
+c$$$ ind=0
+c$$$ do i=1,nres-2
+c$$$ IF (mask_theta(i+2).eq.1) THEN
+c$$$ ig=ig+1
+c$$$ gthetai=0.0D0
+c$$$ do j=i+1,nres-1
+c$$$ ind=ind+1
+c$$$ do k=1,3
+c$$$ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
+c$$$ gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
+c$$$ enddo
+c$$$ enddo
+c$$$ g(ig)=gthetai
+c$$$ ELSE
+c$$$ ind=ind+nres-1-i
+c$$$ ENDIF
+c$$$ enddo
+c$$$
+c$$$ do i=2,nres-1
+c$$$ if (itype(i).ne.10) then
+c$$$ IF (mask_side(i).eq.1) THEN
+c$$$ ig=ig+1
+c$$$ galphai=0.0D0
+c$$$ do k=1,3
+c$$$ galphai=galphai+dxds(k,i)*gradx(k,i,icg)
+c$$$ enddo
+c$$$ g(ig)=galphai
+c$$$ ENDIF
+c$$$ endif
+c$$$ enddo
+c$$$
+c$$$
+c$$$ do i=2,nres-1
+c$$$ if (itype(i).ne.10) then
+c$$$ IF (mask_side(i).eq.1) THEN
+c$$$ ig=ig+1
+c$$$ gomegai=0.0D0
+c$$$ do k=1,3
+c$$$ gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
+c$$$ enddo
+c$$$ g(ig)=gomegai
+c$$$ ENDIF
+c$$$ endif
+c$$$ enddo
+c$$$
+c$$$C
+c$$$C Add the components corresponding to local energy terms.
+c$$$C
+c$$$
+c$$$ ig=0
+c$$$ igall=0
+c$$$ do i=4,nres
+c$$$ igall=igall+1
+c$$$ if (mask_phi(i).eq.1) then
+c$$$ ig=ig+1
+c$$$ g(ig)=g(ig)+gloc(igall,icg)
+c$$$ endif
+c$$$ enddo
+c$$$
+c$$$ do i=3,nres
+c$$$ igall=igall+1
+c$$$ if (mask_theta(i).eq.1) then
+c$$$ ig=ig+1
+c$$$ g(ig)=g(ig)+gloc(igall,icg)
+c$$$ endif
+c$$$ enddo
+c$$$
+c$$$ do ij=1,2
+c$$$ do i=2,nres-1
+c$$$ if (itype(i).ne.10) then
+c$$$ igall=igall+1
+c$$$ if (mask_side(i).eq.1) then
+c$$$ ig=ig+1
+c$$$ g(ig)=g(ig)+gloc(igall,icg)
+c$$$ endif
+c$$$ endif
+c$$$ enddo
+c$$$ enddo
+c$$$
+c$$$cd do i=1,ig
+c$$$cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i)
+c$$$cd enddo
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$C-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine etotal_sc(energy_sc)
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.INTERACT'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.FFIELD'
+c$$$
+c$$$c Output arguments
+c$$$ double precision energy_sc(0:n_ene)
+c$$$
+c$$$c Local variables
+c$$$ double precision evdw,escloc
+c$$$ integer i,j
+c$$$
+c$$$
+c$$$ do i=1,n_ene
+c$$$ energy_sc(i)=0.0D0
+c$$$ enddo
+c$$$
+c$$$ if (mask_r) then
+c$$$ call egb_sc(evdw)
+c$$$ call esc_sc(escloc)
+c$$$ else
+c$$$ call egb(evdw)
+c$$$ call esc(escloc)
+c$$$ endif
+c$$$
+c$$$ if (evdw.eq.1.0D20) then
+c$$$ energy_sc(0)=evdw
+c$$$ else
+c$$$ energy_sc(0)=wsc*evdw+wscloc*escloc
+c$$$ endif
+c$$$ energy_sc(1)=evdw
+c$$$ energy_sc(12)=escloc
+c$$$
+c$$$C
+c$$$C Sum up the components of the Cartesian gradient.
+c$$$C
+c$$$ do i=1,nct
+c$$$ do j=1,3
+c$$$ gradx(j,i,icg)=wsc*gvdwx(j,i)
+c$$$ enddo
+c$$$ enddo
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$C-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine egb_sc(evdw)
+c$$$C
+c$$$C This subroutine calculates the interaction energy of nonbonded side chains
+c$$$C assuming the Gay-Berne potential of interaction.
+c$$$C
+c$$$ implicit real*8 (a-h,o-z)
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.GEO'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.LOCAL'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.NAMES'
+c$$$ include 'COMMON.INTERACT'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.CALC'
+c$$$ include 'COMMON.CONTROL'
+c$$$ logical lprn
+c$$$ evdw=0.0D0
+c$$$ energy_dec=.false.
+c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
+c$$$ evdw=0.0D0
+c$$$ lprn=.false.
+c$$$c if (icall.eq.0) lprn=.false.
+c$$$ ind=0
+c$$$ do i=iatsc_s,iatsc_e
+c$$$ itypi=itype(i)
+c$$$ itypi1=itype(i+1)
+c$$$ xi=c(1,nres+i)
+c$$$ yi=c(2,nres+i)
+c$$$ zi=c(3,nres+i)
+c$$$ dxi=dc_norm(1,nres+i)
+c$$$ dyi=dc_norm(2,nres+i)
+c$$$ dzi=dc_norm(3,nres+i)
+c$$$c dsci_inv=dsc_inv(itypi)
+c$$$ dsci_inv=vbld_inv(i+nres)
+c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
+c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
+c$$$C
+c$$$C Calculate SC interaction energy.
+c$$$C
+c$$$ do iint=1,nint_gr(i)
+c$$$ do j=istart(i,iint),iend(i,iint)
+c$$$ IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN
+c$$$ ind=ind+1
+c$$$ itypj=itype(j)
+c$$$c dscj_inv=dsc_inv(itypj)
+c$$$ dscj_inv=vbld_inv(j+nres)
+c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
+c$$$c & 1.0d0/vbld(j+nres)
+c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
+c$$$ sig0ij=sigma(itypi,itypj)
+c$$$ chi1=chi(itypi,itypj)
+c$$$ chi2=chi(itypj,itypi)
+c$$$ chi12=chi1*chi2
+c$$$ chip1=chip(itypi)
+c$$$ chip2=chip(itypj)
+c$$$ chip12=chip1*chip2
+c$$$ alf1=alp(itypi)
+c$$$ alf2=alp(itypj)
+c$$$ alf12=0.5D0*(alf1+alf2)
+c$$$C For diagnostics only!!!
+c$$$c chi1=0.0D0
+c$$$c chi2=0.0D0
+c$$$c chi12=0.0D0
+c$$$c chip1=0.0D0
+c$$$c chip2=0.0D0
+c$$$c chip12=0.0D0
+c$$$c alf1=0.0D0
+c$$$c alf2=0.0D0
+c$$$c alf12=0.0D0
+c$$$ xj=c(1,nres+j)-xi
+c$$$ yj=c(2,nres+j)-yi
+c$$$ zj=c(3,nres+j)-zi
+c$$$ dxj=dc_norm(1,nres+j)
+c$$$ dyj=dc_norm(2,nres+j)
+c$$$ dzj=dc_norm(3,nres+j)
+c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
+c$$$c write (iout,*) "j",j," dc_norm",
+c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
+c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+c$$$ rij=dsqrt(rrij)
+c$$$C Calculate angle-dependent terms of energy and contributions to their
+c$$$C derivatives.
+c$$$ call sc_angular
+c$$$ sigsq=1.0D0/sigsq
+c$$$ sig=sig0ij*dsqrt(sigsq)
+c$$$ rij_shift=1.0D0/rij-sig+sig0ij
+c$$$c for diagnostics; uncomment
+c$$$c rij_shift=1.2*sig0ij
+c$$$C I hate to put IF's in the loops, but here don't have another choice!!!!
+c$$$ if (rij_shift.le.0.0D0) then
+c$$$ evdw=1.0D20
+c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+c$$$cd & restyp(itypi),i,restyp(itypj),j,
+c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
+c$$$ return
+c$$$ endif
+c$$$ sigder=-sig*sigsq
+c$$$c---------------------------------------------------------------
+c$$$ rij_shift=1.0D0/rij_shift
+c$$$ fac=rij_shift**expon
+c$$$ e1=fac*fac*aa(itypi,itypj)
+c$$$ e2=fac*bb(itypi,itypj)
+c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2)
+c$$$ eps2der=evdwij*eps3rt
+c$$$ eps3der=evdwij*eps2rt
+c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
+c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
+c$$$ evdwij=evdwij*eps2rt*eps3rt
+c$$$ evdw=evdw+evdwij
+c$$$ if (lprn) then
+c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+c$$$ & restyp(itypi),i,restyp(itypj),j,
+c$$$ & epsi,sigm,chi1,chi2,chip1,chip2,
+c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
+c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
+c$$$ & evdwij
+c$$$ endif
+c$$$
+c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)')
+c$$$ & 'evdw',i,j,evdwij
+c$$$
+c$$$C Calculate gradient components.
+c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2
+c$$$ fac=-expon*(e1+evdwij)*rij_shift
+c$$$ sigder=fac*sigder
+c$$$ fac=rij*fac
+c$$$c fac=0.0d0
+c$$$C Calculate the radial part of the gradient
+c$$$ gg(1)=xj*fac
+c$$$ gg(2)=yj*fac
+c$$$ gg(3)=zj*fac
+c$$$C Calculate angular part of the gradient.
+c$$$ call sc_grad
+c$$$ ENDIF
+c$$$ enddo ! j
+c$$$ enddo ! iint
+c$$$ enddo ! i
+c$$$ energy_dec=.false.
+c$$$ return
+c$$$ end
+c$$$
+c$$$c-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine esc_sc(escloc)
+c$$$C Calculate the local energy of a side chain and its derivatives in the
+c$$$C corresponding virtual-bond valence angles THETA and the spherical angles
+c$$$C ALPHA and OMEGA.
+c$$$ implicit real*8 (a-h,o-z)
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.GEO'
+c$$$ include 'COMMON.LOCAL'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.INTERACT'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.NAMES'
+c$$$ include 'COMMON.FFIELD'
+c$$$ include 'COMMON.CONTROL'
+c$$$ double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
+c$$$ & ddersc0(3),ddummy(3),xtemp(3),temp(3)
+c$$$ common /sccalc/ time11,time12,time112,theti,it,nlobit
+c$$$ delta=0.02d0*pi
+c$$$ escloc=0.0D0
+c$$$c write (iout,'(a)') 'ESC'
+c$$$ do i=loc_start,loc_end
+c$$$ IF (mask_side(i).eq.1) THEN
+c$$$ it=itype(i)
+c$$$ if (it.eq.10) goto 1
+c$$$ nlobit=nlob(it)
+c$$$c print *,'i=',i,' it=',it,' nlobit=',nlobit
+c$$$c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
+c$$$ theti=theta(i+1)-pipol
+c$$$ x(1)=dtan(theti)
+c$$$ x(2)=alph(i)
+c$$$ x(3)=omeg(i)
+c$$$
+c$$$ if (x(2).gt.pi-delta) then
+c$$$ xtemp(1)=x(1)
+c$$$ xtemp(2)=pi-delta
+c$$$ xtemp(3)=x(3)
+c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
+c$$$ xtemp(2)=pi
+c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
+c$$$ call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
+c$$$ & escloci,dersc(2))
+c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
+c$$$ & ddersc0(1),dersc(1))
+c$$$ call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
+c$$$ & ddersc0(3),dersc(3))
+c$$$ xtemp(2)=pi-delta
+c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
+c$$$ xtemp(2)=pi
+c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
+c$$$ call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
+c$$$ & dersc0(2),esclocbi,dersc02)
+c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
+c$$$ & dersc12,dersc01)
+c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd)
+c$$$ dersc0(1)=dersc01
+c$$$ dersc0(2)=dersc02
+c$$$ dersc0(3)=0.0d0
+c$$$ do k=1,3
+c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
+c$$$ enddo
+c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
+c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
+c$$$c & esclocbi,ss,ssd
+c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi
+c$$$c escloci=esclocbi
+c$$$c write (iout,*) escloci
+c$$$ else if (x(2).lt.delta) then
+c$$$ xtemp(1)=x(1)
+c$$$ xtemp(2)=delta
+c$$$ xtemp(3)=x(3)
+c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
+c$$$ xtemp(2)=0.0d0
+c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
+c$$$ call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
+c$$$ & escloci,dersc(2))
+c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
+c$$$ & ddersc0(1),dersc(1))
+c$$$ call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
+c$$$ & ddersc0(3),dersc(3))
+c$$$ xtemp(2)=delta
+c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
+c$$$ xtemp(2)=0.0d0
+c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
+c$$$ call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
+c$$$ & dersc0(2),esclocbi,dersc02)
+c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
+c$$$ & dersc12,dersc01)
+c$$$ dersc0(1)=dersc01
+c$$$ dersc0(2)=dersc02
+c$$$ dersc0(3)=0.0d0
+c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd)
+c$$$ do k=1,3
+c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
+c$$$ enddo
+c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
+c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
+c$$$c & esclocbi,ss,ssd
+c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi
+c$$$c write (iout,*) escloci
+c$$$ else
+c$$$ call enesc(x,escloci,dersc,ddummy,.false.)
+c$$$ endif
+c$$$
+c$$$ escloc=escloc+escloci
+c$$$ if (energy_dec) write (iout,'(a6,i,0pf7.3)')
+c$$$ & 'escloc',i,escloci
+c$$$c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
+c$$$
+c$$$ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
+c$$$ & wscloc*dersc(1)
+c$$$ gloc(ialph(i,1),icg)=wscloc*dersc(2)
+c$$$ gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
+c$$$ 1 continue
+c$$$ ENDIF
+c$$$ enddo
+c$$$ return
+c$$$ end
+c$$$
+c$$$C-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine egb_ij(i_sc,j_sc,evdw)
+c$$$C
+c$$$C This subroutine calculates the interaction energy of nonbonded side chains
+c$$$C assuming the Gay-Berne potential of interaction.
+c$$$C
+c$$$ implicit real*8 (a-h,o-z)
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.GEO'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.LOCAL'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.NAMES'
+c$$$ include 'COMMON.INTERACT'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.CALC'
+c$$$ include 'COMMON.CONTROL'
+c$$$ logical lprn
+c$$$ evdw=0.0D0
+c$$$ energy_dec=.false.
+c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
+c$$$ evdw=0.0D0
+c$$$ lprn=.false.
+c$$$ ind=0
+c$$$c$$$ do i=iatsc_s,iatsc_e
+c$$$ i=i_sc
+c$$$ itypi=itype(i)
+c$$$ itypi1=itype(i+1)
+c$$$ xi=c(1,nres+i)
+c$$$ yi=c(2,nres+i)
+c$$$ zi=c(3,nres+i)
+c$$$ dxi=dc_norm(1,nres+i)
+c$$$ dyi=dc_norm(2,nres+i)
+c$$$ dzi=dc_norm(3,nres+i)
+c$$$c dsci_inv=dsc_inv(itypi)
+c$$$ dsci_inv=vbld_inv(i+nres)
+c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
+c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
+c$$$C
+c$$$C Calculate SC interaction energy.
+c$$$C
+c$$$c$$$ do iint=1,nint_gr(i)
+c$$$c$$$ do j=istart(i,iint),iend(i,iint)
+c$$$ j=j_sc
+c$$$ ind=ind+1
+c$$$ itypj=itype(j)
+c$$$c dscj_inv=dsc_inv(itypj)
+c$$$ dscj_inv=vbld_inv(j+nres)
+c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
+c$$$c & 1.0d0/vbld(j+nres)
+c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
+c$$$ sig0ij=sigma(itypi,itypj)
+c$$$ chi1=chi(itypi,itypj)
+c$$$ chi2=chi(itypj,itypi)
+c$$$ chi12=chi1*chi2
+c$$$ chip1=chip(itypi)
+c$$$ chip2=chip(itypj)
+c$$$ chip12=chip1*chip2
+c$$$ alf1=alp(itypi)
+c$$$ alf2=alp(itypj)
+c$$$ alf12=0.5D0*(alf1+alf2)
+c$$$C For diagnostics only!!!
+c$$$c chi1=0.0D0
+c$$$c chi2=0.0D0
+c$$$c chi12=0.0D0
+c$$$c chip1=0.0D0
+c$$$c chip2=0.0D0
+c$$$c chip12=0.0D0
+c$$$c alf1=0.0D0
+c$$$c alf2=0.0D0
+c$$$c alf12=0.0D0
+c$$$ xj=c(1,nres+j)-xi
+c$$$ yj=c(2,nres+j)-yi
+c$$$ zj=c(3,nres+j)-zi
+c$$$ dxj=dc_norm(1,nres+j)
+c$$$ dyj=dc_norm(2,nres+j)
+c$$$ dzj=dc_norm(3,nres+j)
+c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
+c$$$c write (iout,*) "j",j," dc_norm",
+c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
+c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+c$$$ rij=dsqrt(rrij)
+c$$$C Calculate angle-dependent terms of energy and contributions to their
+c$$$C derivatives.
+c$$$ call sc_angular
+c$$$ sigsq=1.0D0/sigsq
+c$$$ sig=sig0ij*dsqrt(sigsq)
+c$$$ rij_shift=1.0D0/rij-sig+sig0ij
+c$$$c for diagnostics; uncomment
+c$$$c rij_shift=1.2*sig0ij
+c$$$C I hate to put IF's in the loops, but here don't have another choice!!!!
+c$$$ if (rij_shift.le.0.0D0) then
+c$$$ evdw=1.0D20
+c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+c$$$cd & restyp(itypi),i,restyp(itypj),j,
+c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
+c$$$ return
+c$$$ endif
+c$$$ sigder=-sig*sigsq
+c$$$c---------------------------------------------------------------
+c$$$ rij_shift=1.0D0/rij_shift
+c$$$ fac=rij_shift**expon
+c$$$ e1=fac*fac*aa(itypi,itypj)
+c$$$ e2=fac*bb(itypi,itypj)
+c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2)
+c$$$ eps2der=evdwij*eps3rt
+c$$$ eps3der=evdwij*eps2rt
+c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
+c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
+c$$$ evdwij=evdwij*eps2rt*eps3rt
+c$$$ evdw=evdw+evdwij
+c$$$ if (lprn) then
+c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+c$$$ & restyp(itypi),i,restyp(itypj),j,
+c$$$ & epsi,sigm,chi1,chi2,chip1,chip2,
+c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
+c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
+c$$$ & evdwij
+c$$$ endif
+c$$$
+c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)')
+c$$$ & 'evdw',i,j,evdwij
+c$$$
+c$$$C Calculate gradient components.
+c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2
+c$$$ fac=-expon*(e1+evdwij)*rij_shift
+c$$$ sigder=fac*sigder
+c$$$ fac=rij*fac
+c$$$c fac=0.0d0
+c$$$C Calculate the radial part of the gradient
+c$$$ gg(1)=xj*fac
+c$$$ gg(2)=yj*fac
+c$$$ gg(3)=zj*fac
+c$$$C Calculate angular part of the gradient.
+c$$$ call sc_grad
+c$$$c$$$ enddo ! j
+c$$$c$$$ enddo ! iint
+c$$$c$$$ enddo ! i
+c$$$ energy_dec=.false.
+c$$$ return
+c$$$ end
+c$$$
+c$$$C-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine perturb_side_chain(i,angle)
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.GEO'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.LOCAL'
+c$$$ include 'COMMON.IOUNITS'
+c$$$
+c$$$c External functions
+c$$$ external ran_number
+c$$$ double precision ran_number
+c$$$
+c$$$c Input arguments
+c$$$ integer i
+c$$$ double precision angle ! In degrees
+c$$$
+c$$$c Local variables
+c$$$ integer i_sc
+c$$$ double precision rad_ang,rand_v(3),length,cost,sint
+c$$$
+c$$$
+c$$$ i_sc=i+nres
+c$$$ rad_ang=angle*deg2rad
+c$$$
+c$$$ length=0.0
+c$$$ do while (length.lt.0.01)
+c$$$ rand_v(1)=ran_number(0.01D0,1.0D0)
+c$$$ rand_v(2)=ran_number(0.01D0,1.0D0)
+c$$$ rand_v(3)=ran_number(0.01D0,1.0D0)
+c$$$ length=rand_v(1)*rand_v(1)+rand_v(2)*rand_v(2)+
+c$$$ + rand_v(3)*rand_v(3)
+c$$$ length=sqrt(length)
+c$$$ rand_v(1)=rand_v(1)/length
+c$$$ rand_v(2)=rand_v(2)/length
+c$$$ rand_v(3)=rand_v(3)/length
+c$$$ cost=rand_v(1)*dc_norm(1,i_sc)+rand_v(2)*dc_norm(2,i_sc)+
+c$$$ + rand_v(3)*dc_norm(3,i_sc)
+c$$$ length=1.0D0-cost*cost
+c$$$ if (length.lt.0.0D0) length=0.0D0
+c$$$ length=sqrt(length)
+c$$$ rand_v(1)=rand_v(1)-cost*dc_norm(1,i_sc)
+c$$$ rand_v(2)=rand_v(2)-cost*dc_norm(2,i_sc)
+c$$$ rand_v(3)=rand_v(3)-cost*dc_norm(3,i_sc)
+c$$$ enddo
+c$$$ rand_v(1)=rand_v(1)/length
+c$$$ rand_v(2)=rand_v(2)/length
+c$$$ rand_v(3)=rand_v(3)/length
+c$$$
+c$$$ cost=dcos(rad_ang)
+c$$$ sint=dsin(rad_ang)
+c$$$ dc(1,i_sc)=vbld(i_sc)*(dc_norm(1,i_sc)*cost+rand_v(1)*sint)
+c$$$ dc(2,i_sc)=vbld(i_sc)*(dc_norm(2,i_sc)*cost+rand_v(2)*sint)
+c$$$ dc(3,i_sc)=vbld(i_sc)*(dc_norm(3,i_sc)*cost+rand_v(3)*sint)
+c$$$ dc_norm(1,i_sc)=dc(1,i_sc)*vbld_inv(i_sc)
+c$$$ dc_norm(2,i_sc)=dc(2,i_sc)*vbld_inv(i_sc)
+c$$$ dc_norm(3,i_sc)=dc(3,i_sc)*vbld_inv(i_sc)
+c$$$ c(1,i_sc)=c(1,i)+dc(1,i_sc)
+c$$$ c(2,i_sc)=c(2,i)+dc(2,i_sc)
+c$$$ c(3,i_sc)=c(3,i)+dc(3,i_sc)
+c$$$
+c$$$ call chainbuild_cart
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$c----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine ss_relax3(i_in,j_in)
+c$$$ implicit none
+c$$$
+c$$$c Includes
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.INTERACT'
+c$$$
+c$$$c External functions
+c$$$ external ran_number
+c$$$ double precision ran_number
+c$$$
+c$$$c Input arguments
+c$$$ integer i_in,j_in
+c$$$
+c$$$c Local variables
+c$$$ double precision energy_sc(0:n_ene),etot
+c$$$ double precision org_dc(3),org_dc_norm(3),org_c(3)
+c$$$ double precision ang_pert,rand_fact,exp_fact,beta
+c$$$ integer n,i_pert,i
+c$$$ logical notdone
+c$$$
+c$$$
+c$$$ beta=1.0D0
+c$$$
+c$$$ mask_r=.true.
+c$$$ do i=nnt,nct
+c$$$ mask_side(i)=0
+c$$$ enddo
+c$$$ mask_side(i_in)=1
+c$$$ mask_side(j_in)=1
+c$$$
+c$$$ call etotal_sc(energy_sc)
+c$$$ etot=energy_sc(0)
+c$$$c write(iout,'(a,3d15.5)')" SS_MC_START ",energy_sc(0),
+c$$$c + energy_sc(1),energy_sc(12)
+c$$$
+c$$$ notdone=.true.
+c$$$ n=0
+c$$$ do while (notdone)
+c$$$ if (mod(n,2).eq.0) then
+c$$$ i_pert=i_in
+c$$$ else
+c$$$ i_pert=j_in
+c$$$ endif
+c$$$ n=n+1
+c$$$
+c$$$ do i=1,3
+c$$$ org_dc(i)=dc(i,i_pert+nres)
+c$$$ org_dc_norm(i)=dc_norm(i,i_pert+nres)
+c$$$ org_c(i)=c(i,i_pert+nres)
+c$$$ enddo
+c$$$ ang_pert=ran_number(0.0D0,3.0D0)
+c$$$ call perturb_side_chain(i_pert,ang_pert)
+c$$$ call etotal_sc(energy_sc)
+c$$$ exp_fact=exp(beta*(etot-energy_sc(0)))
+c$$$ rand_fact=ran_number(0.0D0,1.0D0)
+c$$$ if (rand_fact.lt.exp_fact) then
+c$$$c write(iout,'(a,3d15.5)')" SS_MC_ACCEPT ",energy_sc(0),
+c$$$c + energy_sc(1),energy_sc(12)
+c$$$ etot=energy_sc(0)
+c$$$ else
+c$$$c write(iout,'(a,3d15.5)')" SS_MC_REJECT ",energy_sc(0),
+c$$$c + energy_sc(1),energy_sc(12)
+c$$$ do i=1,3
+c$$$ dc(i,i_pert+nres)=org_dc(i)
+c$$$ dc_norm(i,i_pert+nres)=org_dc_norm(i)
+c$$$ c(i,i_pert+nres)=org_c(i)
+c$$$ enddo
+c$$$ endif
+c$$$
+c$$$ if (n.eq.10000.or.etot.lt.30.0D0) notdone=.false.
+c$$$ enddo
+c$$$
+c$$$ mask_r=.false.
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$c----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine ss_relax2(etot,iretcode,nfun,i_in,j_in)
+c$$$ implicit none
+c$$$ include 'DIMENSIONS'
+c$$$ integer liv,lv
+c$$$ parameter (liv=60,lv=(77+maxres6*(maxres6+17)/2))
+c$$$*********************************************************************
+c$$$* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for *
+c$$$* the calling subprogram. *
+c$$$* when d(i)=1.0, then v(35) is the length of the initial step, *
+c$$$* calculated in the usual pythagorean way. *
+c$$$* absolute convergence occurs when the function is within v(31) of *
+c$$$* zero. unless you know the minimum value in advance, abs convg *
+c$$$* is probably not useful. *
+c$$$* relative convergence is when the model predicts that the function *
+c$$$* will decrease by less than v(32)*abs(fun). *
+c$$$*********************************************************************
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.GEO'
+c$$$ include 'COMMON.MINIM'
+c$$$ include 'COMMON.CHAIN'
+c$$$
+c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist
+c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar),
+c$$$ + orig_ss_dist(maxres2,maxres2)
+c$$$
+c$$$ double precision etot
+c$$$ integer iretcode,nfun,i_in,j_in
+c$$$
+c$$$ external dist
+c$$$ double precision dist
+c$$$ external ss_func,fdum
+c$$$ double precision ss_func,fdum
+c$$$
+c$$$ integer iv(liv),uiparm(2)
+c$$$ double precision v(lv),x(maxres6),d(maxres6),rdum
+c$$$ integer i,j,k
+c$$$
+c$$$
+c$$$ call deflt(2,iv,liv,lv,v)
+c$$$* 12 means fresh start, dont call deflt
+c$$$ iv(1)=12
+c$$$* max num of fun calls
+c$$$ if (maxfun.eq.0) maxfun=500
+c$$$ iv(17)=maxfun
+c$$$* max num of iterations
+c$$$ if (maxmin.eq.0) maxmin=1000
+c$$$ iv(18)=maxmin
+c$$$* controls output
+c$$$ iv(19)=2
+c$$$* selects output unit
+c$$$c iv(21)=iout
+c$$$ iv(21)=0
+c$$$* 1 means to print out result
+c$$$ iv(22)=0
+c$$$* 1 means to print out summary stats
+c$$$ iv(23)=0
+c$$$* 1 means to print initial x and d
+c$$$ iv(24)=0
+c$$$* min val for v(radfac) default is 0.1
+c$$$ v(24)=0.1D0
+c$$$* max val for v(radfac) default is 4.0
+c$$$ v(25)=2.0D0
+c$$$c v(25)=4.0D0
+c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
+c$$$* the sumsl default is 0.1
+c$$$ v(26)=0.1D0
+c$$$* false conv if (act fnctn decrease) .lt. v(34)
+c$$$* the sumsl default is 100*machep
+c$$$ v(34)=v(34)/100.0D0
+c$$$* absolute convergence
+c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4
+c$$$ v(31)=tolf
+c$$$ v(31)=1.0D-1
+c$$$* relative convergence
+c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-4
+c$$$ v(32)=rtolf
+c$$$ v(32)=1.0D-1
+c$$$* controls initial step size
+c$$$ v(35)=1.0D-1
+c$$$* large vals of d correspond to small components of step
+c$$$ do i=1,6*nres
+c$$$ d(i)=1.0D0
+c$$$ enddo
+c$$$
+c$$$ do i=0,2*nres
+c$$$ do j=1,3
+c$$$ orig_ss_dc(j,i)=dc(j,i)
+c$$$ enddo
+c$$$ enddo
+c$$$ call geom_to_var(nvar,orig_ss_var)
+c$$$
+c$$$ do i=1,nres
+c$$$ do j=i,nres
+c$$$ orig_ss_dist(j,i)=dist(j,i)
+c$$$ orig_ss_dist(j+nres,i)=dist(j+nres,i)
+c$$$ orig_ss_dist(j,i+nres)=dist(j,i+nres)
+c$$$ orig_ss_dist(j+nres,i+nres)=dist(j+nres,i+nres)
+c$$$ enddo
+c$$$ enddo
+c$$$
+c$$$ k=0
+c$$$ do i=1,nres-1
+c$$$ do j=1,3
+c$$$ k=k+1
+c$$$ x(k)=dc(j,i)
+c$$$ enddo
+c$$$ enddo
+c$$$ do i=2,nres-1
+c$$$ if (ialph(i,1).gt.0) then
+c$$$ do j=1,3
+c$$$ k=k+1
+c$$$ x(k)=dc(j,i+nres)
+c$$$ enddo
+c$$$ endif
+c$$$ enddo
+c$$$
+c$$$ uiparm(1)=i_in
+c$$$ uiparm(2)=j_in
+c$$$ call smsno(k,d,x,ss_func,iv,liv,lv,v,uiparm,rdum,fdum)
+c$$$ etot=v(10)
+c$$$ iretcode=iv(1)
+c$$$ nfun=iv(6)+iv(30)
+c$$$
+c$$$ k=0
+c$$$ do i=1,nres-1
+c$$$ do j=1,3
+c$$$ k=k+1
+c$$$ dc(j,i)=x(k)
+c$$$ enddo
+c$$$ enddo
+c$$$ do i=2,nres-1
+c$$$ if (ialph(i,1).gt.0) then
+c$$$ do j=1,3
+c$$$ k=k+1
+c$$$ dc(j,i+nres)=x(k)
+c$$$ enddo
+c$$$ endif
+c$$$ enddo
+c$$$ call chainbuild_cart
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$C-----------------------------------------------------------------------------
+c$$$
+c$$$ subroutine ss_func(n,x,nf,f,uiparm,urparm,ufparm)
+c$$$ implicit none
+c$$$ include 'DIMENSIONS'
+c$$$ include 'COMMON.DERIV'
+c$$$ include 'COMMON.IOUNITS'
+c$$$ include 'COMMON.VAR'
+c$$$ include 'COMMON.CHAIN'
+c$$$ include 'COMMON.INTERACT'
+c$$$ include 'COMMON.SBRIDGE'
+c$$$
+c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist
+c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar),
+c$$$ + orig_ss_dist(maxres2,maxres2)
+c$$$
+c$$$ integer n
+c$$$ double precision x(maxres6)
+c$$$ integer nf
+c$$$ double precision f
+c$$$ integer uiparm(2)
+c$$$ real*8 urparm(1)
+c$$$ external ufparm
+c$$$ double precision ufparm
+c$$$
+c$$$ external dist
+c$$$ double precision dist
+c$$$
+c$$$ integer i,j,k,ss_i,ss_j
+c$$$ double precision tempf,var(maxvar)
+c$$$
+c$$$
+c$$$ ss_i=uiparm(1)
+c$$$ ss_j=uiparm(2)
+c$$$ f=0.0D0
+c$$$
+c$$$ k=0
+c$$$ do i=1,nres-1
+c$$$ do j=1,3
+c$$$ k=k+1
+c$$$ dc(j,i)=x(k)
+c$$$ enddo
+c$$$ enddo
+c$$$ do i=2,nres-1
+c$$$ if (ialph(i,1).gt.0) then
+c$$$ do j=1,3
+c$$$ k=k+1
+c$$$ dc(j,i+nres)=x(k)
+c$$$ enddo
+c$$$ endif
+c$$$ enddo
+c$$$ call chainbuild_cart
+c$$$
+c$$$ call geom_to_var(nvar,var)
+c$$$
+c$$$c Constraints on all angles
+c$$$ do i=1,nvar
+c$$$ tempf=var(i)-orig_ss_var(i)
+c$$$ f=f+tempf*tempf
+c$$$ enddo
+c$$$
+c$$$c Constraints on all distances
+c$$$ do i=1,nres-1
+c$$$ if (i.gt.1) then
+c$$$ tempf=dist(i+nres,i)-orig_ss_dist(i+nres,i)
+c$$$ f=f+tempf*tempf
+c$$$ endif
+c$$$ do j=i+1,nres
+c$$$ tempf=dist(j,i)-orig_ss_dist(j,i)
+c$$$ if (tempf.lt.0.0D0 .or. j.eq.i+1) f=f+tempf*tempf
+c$$$ tempf=dist(j+nres,i)-orig_ss_dist(j+nres,i)
+c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf
+c$$$ tempf=dist(j,i+nres)-orig_ss_dist(j,i+nres)
+c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf
+c$$$ tempf=dist(j+nres,i+nres)-orig_ss_dist(j+nres,i+nres)
+c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf
+c$$$ enddo
+c$$$ enddo
+c$$$
+c$$$c Constraints for the relevant CYS-CYS
+c$$$ tempf=dist(nres+ss_i,nres+ss_j)-8.0D0
+c$$$ f=f+tempf*tempf
+c$$$CCCCCCCCCCCCCCCCC ADD SOME ANGULAR STUFF
+c$$$
+c$$$c$$$ if (nf.ne.nfl) then
+c$$$c$$$ write(iout,'(a,i10,2d15.5)')"IN DIST_FUNC (NF,F,DIST)",nf,
+c$$$c$$$ + f,dist(5+nres,14+nres)
+c$$$c$$$ endif
+c$$$
+c$$$ nfl=nf
+c$$$
+c$$$ return
+c$$$ end
+c$$$
+c$$$C-----------------------------------------------------------------------------
+c$$$C-----------------------------------------------------------------------------
+ subroutine triple_ssbond_ene(resi,resj,resk,eij)
+ include 'DIMENSIONS'
+ include 'COMMON.SBRIDGE'
+ include 'COMMON.CHAIN'
+ include 'COMMON.DERIV'
+ include 'COMMON.LOCAL'
+ include 'COMMON.INTERACT'
+ include 'COMMON.VAR'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.CALC'
+#ifndef CLUST
+#ifndef WHAM
+C include 'COMMON.MD'
+#endif
+#endif
+
+c External functions
+ double precision h_base
+ external h_base
+
+c Input arguments
+ integer resi,resj,resk
+
+c Output arguments
+ double precision eij,eij1,eij2,eij3
+
+c Local variables
+ logical havebond
+c integer itypi,itypj,k,l
+ double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
+ double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
+ double precision xik,yik,zik,xjk,yjk,zjk
+ double precision sig0ij,ljd,sig,fac,e1,e2
+ double precision dcosom1(3),dcosom2(3),ed
+ double precision pom1,pom2
+ double precision ljA,ljB,ljXs
+ double precision d_ljB(1:3)
+ double precision ssA,ssB,ssC,ssXs
+ double precision ssxm,ljxm,ssm,ljm
+ double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
+
+ i=resi
+ j=resj
+ k=resk
+C write(iout,*) resi,resj,resk
+ itypi=itype(i)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+ dsci_inv=vbld_inv(i+nres)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+
+ itypj=itype(j)
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ dscj_inv=vbld_inv(j+nres)
+ itypk=itype(k)
+ xk=c(1,nres+k)
+ yk=c(2,nres+k)
+ zk=c(3,nres+k)
+
+ dxk=dc_norm(1,nres+k)
+ dyk=dc_norm(2,nres+k)
+ dzk=dc_norm(3,nres+k)
+ dscj_inv=vbld_inv(k+nres)
+ xij=xj-xi
+ xik=xk-xi
+ xjk=xk-xj
+ yij=yj-yi
+ yik=yk-yi
+ yjk=yk-yj
+ zij=zj-zi
+ zik=zk-zi
+ zjk=zk-zj
+ rrij=(xij*xij+yij*yij+zij*zij)
+ rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
+ rrik=(xik*xik+yik*yik+zik*zik)
+ rik=dsqrt(rrik)
+ rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
+ rjk=dsqrt(rrjk)
+C there are three combination of distances for each trisulfide bonds
+C The first case the ith atom is the center
+C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
+C distance y is second distance the a,b,c,d are parameters derived for
+C this problem d parameter was set as a penalty currenlty set to 1.
+ eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**2+ctriss)
+C second case jth atom is center
+ eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**2+ctriss)
+C the third case kth atom is the center
+ eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**2+ctriss)
+C eij2=0.0
+C eij3=0.0
+C eij1=0.0
+ eij=eij1+eij2+eij3
+C write(iout,*)i,j,k,eij
+C The energy penalty calculated now time for the gradient part
+C derivative over rij
+ fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+2.0*btriss*(rij+rik))
+ &-eij2**2/dtriss*(2.0*atriss*(rij-rjk)+2.0*btriss*(rij+rjk))
+ gg(1)=xij*fac/rij
+ gg(2)=yij*fac/rij
+ gg(3)=zij*fac/rij
+ do m=1,3
+ gvdwx(m,i)=gvdwx(m,i)-gg(m)
+ gvdwx(m,j)=gvdwx(m,j)+gg(m)
+ enddo
+ do l=1,3
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ enddo
+C now derivative over rik
+ fac=-eij1**2/dtriss*(-2.0*atriss*(rij-rik)+2.0*btriss*(rij+rik))
+ &-eij3**2/dtriss*(2.0*atriss*(rik-rjk)+2.0*btriss*(rik+rjk))
+ gg(1)=xik*fac/rik
+ gg(2)=yik*fac/rik
+ gg(3)=zik*fac/rik
+ do m=1,3
+ gvdwx(m,i)=gvdwx(m,i)-gg(m)
+ gvdwx(m,k)=gvdwx(m,k)+gg(m)
+ enddo
+ do l=1,3
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,k)=gvdwc(l,k)+gg(l)
+ enddo
+C now derivative over rjk
+ fac=-eij2**2/dtriss*(-2.0*atriss*(rij-rjk)+2.0*btriss*(rij+rjk))-
+ &eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+2.0*btriss*(rik+rjk))
+ gg(1)=xjk*fac/rjk
+ gg(2)=yjk*fac/rjk
+ gg(3)=zjk*fac/rjk
+ do m=1,3
+ gvdwx(m,j)=gvdwx(m,j)-gg(m)
+ gvdwx(m,k)=gvdwx(m,k)+gg(m)
+ enddo
+ do l=1,3
+ gvdwc(l,j)=gvdwc(l,j)-gg(l)
+ gvdwc(l,k)=gvdwc(l,k)+gg(l)
+ enddo
+ return
+ end
include 'COMMON.SCROT'
include 'COMMON.SCCOR'
include 'COMMON.ALLPARM'
- integer i,j,k,l,m,mm,iparm
+ integer i,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii
c Store weights
ww_all(1,iparm)=wsc
ww_all(16,iparm)=wvdwpp
ww_all(17,iparm)=wbond
ww_all(19,iparm)=wsccor
+ ww_all(22,iparm)=wliptran
c Store bond parameters
vbldp0_all(iparm)=vbldp0
akp_all(iparm)=akp
enddo
c Store bond angle parameters
#ifdef CRYST_THETA
- do i=1,ntyp
+ do i=-ntyp,ntyp
a0thet_all(i,iparm)=a0thet(i)
+ do ichir1=-1,1
+ do ichir2=-1,1
do j=1,2
- athet_all(j,i,iparm)=athet(j,i)
- bthet_all(j,i,iparm)=bthet(j,i)
+ athet_all(j,i,ichir1,ichir2,iparm)=athet(j,i,ichir1,ichir2)
+ bthet_all(j,i,ichir1,ichir2,iparm)=bthet(j,i,ichir1,ichir2)
+ enddo
+ enddo
enddo
do j=0,3
polthet_all(j,i,iparm)=polthet(j,i)
nsingle_all(iparm)=nsingle
ndouble_all(iparm)=ndouble
nntheterm_all(iparm)=nntheterm
- do i=1,ntyp1
+ do i=-ntyp,ntyp
ithetyp_all(i,iparm)=ithetyp(i)
enddo
- do i=1,maxthetyp1
- do j=1,maxthetyp1
- do k=1,maxthetyp1
- aa0thet_all(i,j,k,iparm)=aa0thet(i,j,k)
+ do iblock=1,2
+ do i=-maxthetyp1,maxthetyp1
+ do j=-maxthetyp1,maxthetyp1
+ do k=-maxthetyp1,maxthetyp1
+ aa0thet_all(i,j,k,iblock,iparm)=aa0thet(i,j,k,iblock)
do l=1,ntheterm
- aathet_all(l,i,j,k,iparm)=aathet(l,i,j,k)
+ aathet_all(l,i,j,k,iblock,iparm)=aathet(l,i,j,k,iblock)
enddo
do l=1,ntheterm2
do m=1,nsingle
- bbthet_all(m,l,i,j,k,iparm)=bbthet(m,l,i,j,k)
- ccthet_all(m,l,i,j,k,iparm)=ccthet(m,l,i,j,k)
- ddthet_all(m,l,i,j,k,iparm)=ddthet(m,l,i,j,k)
- eethet_all(m,l,i,j,k,iparm)=eethet(m,l,i,j,k)
+ bbthet_all(m,l,i,j,k,iblock,iparm)=
+ & bbthet(m,l,i,j,k,iblock)
+ ccthet_all(m,l,i,j,k,iblock,iparm)=
+ &ccthet(m,l,i,j,k,iblock)
+ ddthet_all(m,l,i,j,k,iblock,iparm)=
+ &ddthet(m,l,i,j,k,iblock)
+ eethet_all(m,l,i,j,k,iblock,iparm)=
+ &eethet(m,l,i,j,k,iblock)
enddo
enddo
do l=1,ntheterm3
do m=1,ndouble
do mm=1,ndouble
- ffthet_all(mm,m,l,i,j,k,iparm)=ffthet(mm,m,l,i,j,k)
- ggthet_all(mm,m,l,i,j,k,iparm)=ggthet(mm,m,l,i,j,k)
+ if (iblock.eq.1) then
+ ffthet_all1(mm,m,l,i,j,k,iparm)=
+ & ffthet(mm,m,l,i,j,k,iblock)
+ ggthet_all1(mm,m,l,i,j,k,iparm)=
+ &ggthet(mm,m,l,i,j,k,iblock)
+ else
+ ffthet_all2(mm,m,l,i,j,k,iparm)=
+ & ffthet(mm,m,l,i,j,k,iblock)
+ ggthet_all2(mm,m,l,i,j,k,iparm)=
+ &ggthet(mm,m,l,i,j,k,iblock)
+ endif
enddo
enddo
enddo
enddo
enddo
enddo
+ enddo
#endif
#ifdef CRYST_SC
c Store the sidechain rotamer parameters
- do i=1,ntyp
- nlob_all(i,iparm)=nlob(i)
- do j=1,nlob(i)
- bsc_all(j,i,iparm)=bsc(j,i)
+ do i=-ntyp,ntyp
+ iii=iabs(i)
+cc write (iout,*) i,"storeparm1"
+ if (i.eq.0) cycle
+ nlob_all(iii,iparm)=nlob(iii)
+ do j=1,nlob(iii)
+ bsc_all(j,iii,iparm)=bsc(j,iii)
do k=1,3
censc_all(k,j,i,iparm)=censc(k,j,i)
enddo
enddo
#endif
c Store the torsional parameters
- do i=1,ntortyp
- do j=1,ntortyp
- v0_all(i,j,iparm)=v0(i,j)
- nterm_all(i,j,iparm)=nterm(i,j)
- nlor_all(i,j,iparm)=nlor(i,j)
- do k=1,nterm(i,j)
- v1_all(k,i,j,iparm)=v1(k,i,j)
- v2_all(k,i,j,iparm)=v2(i,i,j)
+ do iblock=1,2
+ do i=-ntortyp+1,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ v0_all(i,j,iblock,iparm)=v0(i,j,iblock)
+ nterm_all(i,j,iblock,iparm)=nterm(i,j,iblock)
+ nlor_all(i,j,iblock,iparm)=nlor(i,j,iblock)
+ do k=1,nterm(i,j,iblock)
+ v1_all(k,i,j,iblock,iparm)=v1(k,i,j,iblock)
+ v2_all(k,i,j,iblock,iparm)=v2(k,i,j,iblock)
enddo
- do k=1,nlor(i,j)
+ do k=1,nlor(i,j,iblock)
vlor1_all(k,i,j,iparm)=vlor1(k,i,j)
vlor2_all(k,i,j,iparm)=vlor2(k,i,j)
vlor3_all(k,i,j,iparm)=vlor3(k,i,j)
enddo
enddo
+ enddo
enddo
c Store the double torsional parameters
- do i=1,ntortyp
- do j=1,ntortyp
- do k=1,ntortyp
- ntermd1_all(i,j,k,iparm)=ntermd_1(i,j,k)
- ntermd2_all(i,j,k,iparm)=ntermd_2(i,j,k)
- do l=1,ntermd_1(i,j,k)
- v1c_all(1,l,i,j,k,iparm)=v1c(1,l,i,j,k)
- v1c_all(2,l,i,j,k,iparm)=v1c(2,l,i,j,k)
- v2c_all(1,l,i,j,k,iparm)=v2c(1,l,i,j,k)
- v2c_all(2,l,i,j,k,iparm)=v2c(2,l,i,j,k)
+ do iblock=1,2
+ do i=-ntortyp+1,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ do k=-ntortyp+1,ntortyp-1
+ ntermd1_all(i,j,k,iblock,iparm)=ntermd_1(i,j,k,iblock)
+ ntermd2_all(i,j,k,iblock,iparm)=ntermd_2(i,j,k,iblock)
+ do l=1,ntermd_1(i,j,k,iblock)
+ v1c_all(1,l,i,j,k,iblock,iparm)=v1c(1,l,i,j,k,iblock)
+ v1c_all(2,l,i,j,k,iblock,iparm)=v1c(2,l,i,j,k,iblock)
+ v2c_all(1,l,i,j,k,iblock,iparm)=v2c(1,l,i,j,k,iblock)
+ v2c_all(2,l,i,j,k,iblock,iparm)=v2c(2,l,i,j,k,iblock)
enddo
- do l=1,ntermd_2(i,j,k)
- do m=1,ntermd_2(i,j,k)
- v2s_all(l,m,i,j,k,iparm)=v2s(l,m,i,j,k)
+ do l=1,ntermd_2(i,j,k,iblock)
+ do m=1,ntermd_2(i,j,k,iblock)
+ v2s_all(l,m,i,j,k,iblock,iparm)=v2s(l,m,i,j,k,iblock)
enddo
enddo
enddo
enddo
enddo
+ enddo
c Store parameters of the cumulants
- do i=1,nloctyp
+ do i=-nloctyp,nloctyp
do j=1,2
b1_all(j,i,iparm)=b1(j,i)
b1tilde_all(j,i,iparm)=b1tilde(j,i)
c Store sidechain parameters
do i=1,ntyp
do j=1,ntyp
- aa_all(j,i,iparm)=aa(j,i)
- bb_all(j,i,iparm)=bb(j,i)
+ aa_aq_all(j,i,iparm)=aa_aq(j,i)
+ bb_aq_all(j,i,iparm)=bb_aq(j,i)
+ aa_lip_all(j,i,iparm)=aa_lip(j,i)
+ bb_lip_all(j,i,iparm)=bb_lip(j,i)
r0_all(j,i,iparm)=r0(j,i)
sigma_all(j,i,iparm)=sigma(j,i)
chi_all(j,i,iparm)=chi(j,i)
augm_all(j,i,iparm)=augm(j,i)
eps_all(j,i,iparm)=eps(j,i)
+ epslip_all(j,i,iparm)=epslip(j,i)
enddo
enddo
do i=1,ntyp
include 'COMMON.SCROT'
include 'COMMON.SCCOR'
include 'COMMON.ALLPARM'
- integer i,j,k,l,m,mm,iparm
+ integer i,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii
c Restore weights
wsc=ww_all(1,iparm)
wvdwpp=ww_all(16,iparm)
wbond=ww_all(17,iparm)
wsccor=ww_all(19,iparm)
+ wliptran=ww_all(22,iparm)
c Restore bond parameters
vbldp0=vbldp0_all(iparm)
akp=akp_all(iparm)
enddo
c Restore bond angle parameters
#ifdef CRYST_THETA
- do i=1,ntyp
+ do i=-ntyp,ntyp
a0thet(i)=a0thet_all(i,iparm)
+ do ichir1=-1,1
+ do ichir2=-1,1
do j=1,2
- athet(j,i)=athet_all(j,i,iparm)
- bthet(j,i)=bthet_all(j,i,iparm)
+ athet(j,i,ichir1,ichir2)=athet_all(j,i,ichir1,ichir2,iparm)
+ bthet(j,i,ichir1,ichir2)=bthet_all(j,i,ichir1,ichir2,iparm)
+ enddo
+ enddo
enddo
do j=0,3
polthet(j,i)=polthet_all(j,i,iparm)
nsingle=nsingle_all(iparm)
ndouble=ndouble_all(iparm)
nntheterm=nntheterm_all(iparm)
- do i=1,ntyp1
+ do i=-ntyp,ntyp
ithetyp(i)=ithetyp_all(i,iparm)
enddo
- do i=1,maxthetyp1
- do j=1,maxthetyp1
- do k=1,maxthetyp1
- aa0thet(i,j,k)=aa0thet_all(i,j,k,iparm)
+ do iblock=1,2
+ do i=-maxthetyp1,maxthetyp1
+ do j=-maxthetyp1,maxthetyp1
+ do k=-maxthetyp1,maxthetyp1
+ aa0thet(i,j,k,iblock)=aa0thet_all(i,j,k,iblock,iparm)
do l=1,ntheterm
- aathet(l,i,j,k)=aathet_all(l,i,j,k,iparm)
+ aathet(l,i,j,k,iblock)=aathet_all(l,i,j,k,iblock,iparm)
enddo
do l=1,ntheterm2
do m=1,nsingle
- bbthet(m,l,i,j,k)=bbthet_all(m,l,i,j,k,iparm)
- ccthet(m,l,i,j,k)=ccthet_all(m,l,i,j,k,iparm)
- ddthet(m,l,i,j,k)=ddthet_all(m,l,i,j,k,iparm)
- eethet(m,l,i,j,k)=eethet_all(m,l,i,j,k,iparm)
+ bbthet(m,l,i,j,k,iblock)=
+ &bbthet_all(m,l,i,j,k,iblock,iparm)
+ ccthet(m,l,i,j,k,iblock)=
+ &ccthet_all(m,l,i,j,k,iblock,iparm)
+ ddthet(m,l,i,j,k,iblock)=
+ &ddthet_all(m,l,i,j,k,iblock,iparm)
+ eethet(m,l,i,j,k,iblock)=
+ &eethet_all(m,l,i,j,k,iblock,iparm)
enddo
enddo
do l=1,ntheterm3
do m=1,ndouble
do mm=1,ndouble
- ffthet(mm,m,l,i,j,k)=ffthet_all(mm,m,l,i,j,k,iparm)
- ggthet(mm,m,l,i,j,k)=ggthet_all(mm,m,l,i,j,k,iparm)
+ if (iblock.eq.1) then
+ ffthet(mm,m,l,i,j,k,iblock)=
+ &ffthet_all1(mm,m,l,i,j,k,iparm)
+ ggthet(mm,m,l,i,j,k,iblock)=
+ &ggthet_all1(mm,m,l,i,j,k,iparm)
+ else
+ ffthet(mm,m,l,i,j,k,iblock)=
+ &ffthet_all2(mm,m,l,i,j,k,iparm)
+ ggthet(mm,m,l,i,j,k,iblock)=
+ &ggthet_all2(mm,m,l,i,j,k,iparm)
+ endif
enddo
enddo
enddo
enddo
enddo
enddo
+ enddo
#endif
c Restore the sidechain rotamer parameters
#ifdef CRYST_SC
- do i=1,ntyp
- nlob(i)=nlob_all(i,iparm)
- do j=1,nlob(i)
- bsc(j,i)=bsc_all(j,i,iparm)
+ do i=-ntyp,ntyp
+ if (i.eq.0) cycle
+ iii=iabs(i)
+ nlob(iii)=nlob_all(iii,iparm)
+ do j=1,nlob(iii)
+ bsc(j,iii)=bsc_all(j,iii,iparm)
do k=1,3
censc(k,j,i)=censc_all(k,j,i,iparm)
enddo
enddo
#endif
c Restore the torsional parameters
- do i=1,ntortyp
- do j=1,ntortyp
- v0(i,j)=v0_all(i,j,iparm)
- nterm(i,j)=nterm_all(i,j,iparm)
- nlor(i,j)=nlor_all(i,j,iparm)
- do k=1,nterm(i,j)
- v1(k,i,j)=v1_all(k,i,j,iparm)
- v2(i,i,j)=v2_all(k,i,j,iparm)
+ do iblock=1,2
+ do i=-ntortyp+1,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ v0(i,j,iblock)=v0_all(i,j,iblock,iparm)
+ nterm(i,j,iblock)=nterm_all(i,j,iblock,iparm)
+ nlor(i,j,iblock)=nlor_all(i,j,iblock,iparm)
+ do k=1,nterm(i,j,iblock)
+ v1(k,i,j,iblock)=v1_all(k,i,j,iblock,iparm)
+ v2(k,i,j,iblock)=v2_all(k,i,j,iblock,iparm)
enddo
- do k=1,nlor(i,j)
+ do k=1,nlor(i,j,iblock)
vlor1(k,i,j)=vlor1_all(k,i,j,iparm)
vlor2(k,i,j)=vlor2_all(k,i,j,iparm)
vlor3(k,i,j)=vlor3_all(k,i,j,iparm)
enddo
enddo
enddo
+ enddo
c Restore the double torsional parameters
- do i=1,ntortyp
- do j=1,ntortyp
- do k=1,ntortyp
- ntermd_1(i,j,k)=ntermd1_all(i,j,k,iparm)
- ntermd_2(i,j,k)=ntermd2_all(i,j,k,iparm)
- do l=1,ntermd_1(i,j,k)
- v1c(1,l,i,j,k)=v1c_all(1,l,i,j,k,iparm)
- v1c(2,l,i,j,k)=v1c_all(2,l,i,j,k,iparm)
- v2c(1,l,i,j,k)=v2c_all(1,l,i,j,k,iparm)
- v2c(2,l,i,j,k)=v2c_all(2,l,i,j,k,iparm)
+ do iblock=1,2
+ do i=-ntortyp+1,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ do k=-ntortyp+1,ntortyp-1
+ ntermd_1(i,j,k,iblock)=ntermd1_all(i,j,k,iblock,iparm)
+ ntermd_2(i,j,k,iblock)=ntermd2_all(i,j,k,iblock,iparm)
+ do l=1,ntermd_1(i,j,k,iblock)
+ v1c(1,l,i,j,k,iblock)=v1c_all(1,l,i,j,k,iblock,iparm)
+ v1c(2,l,i,j,k,iblock)=v1c_all(2,l,i,j,k,iblock,iparm)
+ v2c(1,l,i,j,k,iblock)=v2c_all(1,l,i,j,k,iblock,iparm)
+ v2c(2,l,i,j,k,iblock)=v2c_all(2,l,i,j,k,iblock,iparm)
enddo
- do l=1,ntermd_2(i,j,k)
- do m=1,ntermd_2(i,j,k)
- v2s(l,m,i,j,k)=v2s_all(l,m,i,j,k,iparm)
+ do l=1,ntermd_2(i,j,k,iblock)
+ do m=1,ntermd_2(i,j,k,iblock)
+ v2s(l,m,i,j,k,iblock)=v2s_all(l,m,i,j,k,iblock,iparm)
enddo
enddo
enddo
enddo
enddo
+ enddo
c Restore parameters of the cumulants
- do i=1,nloctyp
+ do i=-nloctyp,nloctyp
do j=1,2
b1(j,i)=b1_all(j,i,iparm)
b1tilde(j,i)=b1tilde_all(j,i,iparm)
c Restore sidechain parameters
do i=1,ntyp
do j=1,ntyp
- aa(j,i)=aa_all(j,i,iparm)
- bb(j,i)=bb_all(j,i,iparm)
+ aa_aq(j,i)=aa_aq_all(j,i,iparm)
+ bb_aq(j,i)=bb_aq_all(j,i,iparm)
+ aa_lip(j,i)=aa_lip_all(j,i,iparm)
+ bb_lip(j,i)=bb_lip_all(j,i,iparm)
r0(j,i)=r0_all(j,i,iparm)
sigma(j,i)=sigma_all(j,i,iparm)
chi(j,i)=chi_all(j,i,iparm)
augm(j,i)=augm_all(j,i,iparm)
eps(j,i)=eps_all(j,i,iparm)
+ epslip(j,i)=epslip_all(j,i,iparm)
enddo
enddo
do i=1,ntyp
double precision energia(0:max_ene)
#ifdef MPI
integer tmax_t,upindE_p
- double precision fi_p(MaxR,MaxT_h,Max_Parm)
+ double precision fi_p(MaxR,MaxT_h,Max_Parm),
+ & fi_p_min(MaxR,MaxT_h,Max_Parm)
double precision sumW_p(0:nGridT,Max_Parm),
& sumE_p(0:nGridT,Max_Parm),sumEsq_p(0:nGridT,Max_Parm),
& sumQ_p(MaxQ1,0:nGridT,Max_Parm),
& hfin_ent_p(0:MaxHdim),histE_p(0:maxindE),sumH,
& hrmsrgy_p(0:MaxBinRgy,0:MaxBinRms,maxT_h)
double precision rgymin_t,rmsmin_t,rgymax_t,rmsmax_t
- double precision potEmin_t,entmin_p,entmax_p
+ double precision potEmin_t,entmin_p,entmax_p,
+ & potEmin_t_all(maxT_h,Max_Parm)
integer histent_p(0:2000)
logical lprint /.true./
#endif
& sumEprim(0:NGridT,Max_Parm),sumEbis(0:NGridT,Max_Parm),betaT,
& weight,econstr
double precision fi(MaxR,maxT_h,Max_Parm),
+ & fi_min(MaxR,maxT_h,Max_Parm),
& dd,dd1,dd2,hh,dmin,denom,finorm,avefi,pom,
& hfin(0:MaxHdim,maxT_h),histE(0:maxindE),
& hrmsrgy(0:MaxBinRgy,0:MaxBinRms,maxT_h),
- & potEmin,ent,
- & hfin_ent(0:MaxHdim),vmax,aux
+ & potEmin,ent,potEmin_all(maxT_h,Max_Parm),potEmin_min,
+ & hfin_ent(0:MaxHdim),vmax,aux,entfac_min
double precision fT(6),fTprim(6),fTbis(6),quot,quotl1,quotl,kfacl,
& eprim,ebis,temper,kfac/2.4d0/,T0/300.0d0/,startGridT/200.0d0/,
& eplus,eminus,logfac,tanhT,tt
double precision etot,evdw,evdw_t,evdw2,ees,evdw1,ebe,etors,
& escloc,ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3,
- & eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor
+ & eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor,
+ & ehomology_constr
+
integer ind_point(maxpoint),upindE,indE
character*16 plik
character*128 nazwa
integer ilen
external ilen
-
write(licz2,'(bz,i2.2)') islice
nbin1 = 1.0d0/delta
write (iout,'(//80(1h-)/"Solving WHAM equations for slice",
dmin=0.0d0
tmax=0
potEmin=1.0d10
+ do i=1,nParmset
+ do j=1,nT_h(i)
+ potEmin_all(j,i)=1.0d10
+ enddo
+ enddo
rgymin=1.0d10
rmsmin=1.0d10
rgymax=0.0d0
do t=0,MaxN
htot(t)=0
enddo
+C#define DEBUG
#ifdef MPI
do i=1,scount(me1)
#else
do i=1,ntot(islice)
#endif
- do j=1,nParmSet
- if (potE(i,j).le.potEmin) potEmin=potE(i,j)
- enddo
+C do j=1,nParmSet
+C if (potE(i,j).le.potEmin) potEmin=potE(i,j)
+C enddo
if (q(nQ+1,i).lt.rmsmin) rmsmin=q(nQ+1,i)
if (q(nQ+1,i).gt.rmsmax) rmsmax=q(nQ+1,i)
if (q(nQ+2,i).lt.rgymin) rgymin=q(nQ+2,i)
call MPI_AllReduce(tmax,tmax_t,1,MPI_INTEGER,MPI_MAX,
& WHAM_COMM,IERROR)
tmax=tmax_t
- call MPI_AllReduce(potEmin,potEmin_t,1,MPI_DOUBLE_PRECISION,
- & MPI_MIN,WHAM_COMM,IERROR)
+C call MPI_AllReduce(potEmin,potEmin_t,1,MPI_DOUBLE_PRECISION,
+C & MPI_MIN,WHAM_COMM,IERROR)
call MPI_AllReduce(rmsmin,rmsmin_t,1,MPI_DOUBLE_PRECISION,
& MPI_MIN,WHAM_COMM,IERROR)
call MPI_AllReduce(rmsmax,rmsmax_t,1,MPI_DOUBLE_PRECISION,
& MPI_MIN,WHAM_COMM,IERROR)
call MPI_AllReduce(rgymax,rgymax_t,1,MPI_DOUBLE_PRECISION,
& MPI_MAX,WHAM_COMM,IERROR)
- potEmin=potEmin_t/2
+C potEmin=potEmin_t/2
+
rgymin=rgymin_t
rgymax=rgymax_t
rmsmin=rmsmin_t
do iparm=1,nParmSet
#ifdef DEBUG
write (iout,'(2i5,21f8.2)') i,iparm,
- & (enetb(k,i,iparm),k=1,21)
+ & (enetb(k,i,iparm),k=1,22)
#endif
call restore_parm(iparm)
#ifdef DEBUG
estr=enetb(18,i,iparm)
esccor=enetb(19,i,iparm)
edihcnstr=enetb(20,i,iparm)
+ ehomology_constr=enetb(22,i,iparm)
#ifdef DEBUG
write (iout,'(3i5,6f5.2,14f12.3)') i,ib,iparm,(ft(l),l=1,6),
& evdw+evdw_t,evdw2,ees,evdw1,ecorr,eel_loc,estr,ebe,escloc,
call enerprint(energia(0),fT)
endif
#endif
+#ifdef DEBUG
+ write (iout,*) "homol_nset",homol_nset,nR(ib,iparm)
+#endif
+ if (homol_nset.gt.1) then
+
+ do kk=1,nR(ib,iparm)
+ Econstr=waga_homology(kk)*ehomology_constr
+ v(i,kk,ib,iparm)=
+ & -beta_h(ib,iparm)*(etot+Econstr)
+#ifdef DEBUG
+ write (iout,'(4i5,4e15.5)') i,kk,ib,iparm,
+ & etot,Econstr,v(i,kk,ib,iparm)
+#endif
+ enddo ! kk
+
+ else
+
+ etot=etot+ehomology_constr
do kk=1,nR(ib,iparm)
Econstr=0.0d0
do j=1,nQ
& *(dd-q0(j,kk,ib,iparm))**2
enddo
v(i,kk,ib,iparm)=
- & -beta_h(ib,iparm)*(etot-potEmin+Econstr)
+ & -beta_h(ib,iparm)*(etot+Econstr)
#ifdef DEBUG
write (iout,'(4i5,4e15.5)') i,kk,ib,iparm,
& etot,potEmin,etot-potEmin,v(i,kk,ib,iparm)
#endif
enddo ! kk
+
+ endif
enddo ! ib
enddo ! iparm
enddo ! i
! Compute new free-energy values corresponding to the righ-hand side of the
! equation and their derivatives.
write (iout,*) "------------------------fi"
+ entfac_min=1.0d10
#ifdef MPI
do t=1,scount(me1)
#else
enddo
enddo
entfac(t)=-dlog(denom)-vmax
+ if (entfac(t).lt.entfac_min) entfac_min=entfac(t)
#ifdef DEBUG
write (iout,*) t,"vmax",vmax," denom",denom,"entfac",entfac(t)
#endif
enddo
+
+ do iparm=1,nParmSet
+ do iib=1,nT_h(iparm)
+ do ii=1,nR(iib,iparm)
+#ifdef MPI
+ fi_p_min(ii,iib,iparm)=-1.0d10
+ do t=1,scount(me)
+ aux=v(t,ii,iib,iparm)+entfac(t)
+ if (aux.gt.fi_p_min(ii,iib,iparm))
+ & fi_p_min(ii,iib,iparm)=aux
+ enddo
+#else
+ do t=1,ntot(islice)
+ aux=v(t,ii,iib,iparm)+entfac(t)
+ if (aux.gt.fi_min(ii,iib,iparm))
+ & fi_min(ii,iib,iparm)=aux
+ enddo
+#endif
+ enddo ! ii
+ enddo ! iib
+ enddo ! iparm
+#ifdef MPI
+#ifdef DEBUG
+ write (iout,*) "fi_min before AllReduce"
+ do i=1,nParmSet
+ do j=1,nT_h(i)
+ write (iout,*) (i,j,k,fi_p_min(k,j,i),k=1,nR(j,i))
+ enddo
+ enddo
+#endif
+ call MPI_AllReduce(fi_p_min,fi_min,MaxR*MaxT_h*nParmSet,
+ & MPI_DOUBLE_PRECISION,MPI_MAX,WHAM_COMM,IERROR)
+#ifdef DEBUG
+ write (iout,*) "fi_min after AllReduce"
+ do i=1,nParmSet
+ do j=1,nT_h(i)
+ write (iout,*) (i,j,k,fi_min(k,j,i),k=1,nR(j,i))
+ enddo
+ enddo
+#endif
+#endif
do iparm=1,nParmSet
do iib=1,nT_h(iparm)
do ii=1,nR(iib,iparm)
fi_p(ii,iib,iparm)=0.0d0
do t=1,scount(me)
fi_p(ii,iib,iparm)=fi_p(ii,iib,iparm)
- & +dexp(v(t,ii,iib,iparm)+entfac(t))
+ & +dexp(v(t,ii,iib,iparm)+entfac(t)-fi_min(ii,iib,iparm))
#ifdef DEBUG
- write (iout,'(4i5,3e15.5)') t,ii,iib,iparm,
- & v(t,ii,iib,iparm),entfac(t),fi_p(ii,iib,iparm)
+ write (iout,'(4i5,4e15.5)') t,ii,iib,iparm,
+ & v(t,ii,iib,iparm),entfac(t),fi_min(ii,iib,iparm),
+ & fi_p(ii,iib,iparm)
#endif
enddo
#else
fi(ii,iib,iparm)=0.0d0
do t=1,ntot(islice)
fi(ii,iib,iparm)=fi(ii,iib,iparm)
- & +dexp(v(t,ii,iib,iparm)+entfac(t))
+ & +dexp(v(t,ii,iib,iparm)+entfac(t)-fi_min(ii,iib,iparm))
enddo
#endif
enddo ! ii
enddo
enddo
#endif
+#ifdef DEBUG
write (iout,*) "REDUCE size",maxR,MaxT_h,nParmSet,
& maxR*MaxT_h*nParmSet
write (iout,*) "MPI_COMM_WORLD",MPI_COMM_WORLD,
& " WHAM_COMM",WHAM_COMM
+#endif
call MPI_Reduce(fi_p(1,1,1),fi(1,1,1),maxR*MaxT_h*nParmSet,
& MPI_DOUBLE_PRECISION,
& MPI_SUM,Master,WHAM_COMM,IERROR)
do iparm=1,nParmSet
do ib=1,nT_h(iparm)
do i=1,nR(ib,iparm)
- fi(i,ib,iparm)=-dlog(fi(i,ib,iparm))
+ fi(i,ib,iparm)=-dlog(fi(i,ib,iparm))-fi_min(i,ib,iparm)
avefi=avefi+fi(i,ib,iparm)
enddo
enddo
20 continue
! Now, put together the histograms from all simulations, in order to get the
! unbiased total histogram.
+
+C Determine the minimum free energies
+#ifdef MPI
+ do i=1,scount(me1)
+#else
+ do i=1,ntot(islice)
+#endif
+c write (9,'(3i5,f10.5)') i,(iparm,potE(i,iparm),iparm=1,nParmSet)
+ do iparm=1,nParmSet
+#ifdef DEBUG
+ write (iout,'(2i5,21f8.2)') i,iparm,
+ & (enetb(k,i,iparm),k=1,22)
+#endif
+ call restore_parm(iparm)
+#ifdef DEBUG
+ write (iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc,
+ & wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc,
+ & wtor_d,wsccor,wbond
+#endif
+ do ib=1,nT_h(iparm)
+ if (rescale_mode.eq.1) then
+ quot=1.0d0/(beta_h(ib,iparm)*1.987D-3*T0)
+ quotl=1.0d0
+ kfacl=1.0d0
+ do l=1,5
+ quotl1=quotl
+ quotl=quotl*quot
+ kfacl=kfacl*kfac
+ fT(l)=kfacl/(kfacl-1.0d0+quotl)
+ enddo
+#if defined(FUNCTH)
+ tt = 1.0d0/(beta_h(ib,iparm)*1.987D-3)
+ ft(6)=(320.0d0+80.0d0*dtanh((tt-320.0d0)/80.0d0))/320.0d0
+#elif defined(FUNCT)
+ ft(6)=1.0d0/(beta_h(ib,iparm)*1.987D-3*T0)
+#else
+ ft(6)=1.0d0
+#endif
+ else if (rescale_mode.eq.2) then
+ quot=1.0d0/(T0*beta_h(ib,iparm)*1.987D-3)
+ quotl=1.0d0
+ do l=1,5
+ quotl=quotl*quot
+ fT(l)=1.12692801104297249644d0/
+ & dlog(dexp(quotl)+dexp(-quotl))
+ enddo
+#if defined(FUNCTH)
+ tt = 1.0d0/(beta_h(ib,iparm)*1.987D-3)
+ ft(6)=(320.0d0+80.0d0*dtanh((tt-320.0d0)/80.0d0))/320.0d0
+#elif defined(FUNCT)
+ ft(6)=1.0d0/(beta_h(ib,iparm)*1.987D-3*T0)
+#else
+ ft(6)=1.0d0
+#endif
+c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft
+ else if (rescale_mode.eq.0) then
+ do l=1,6
+ fT(l)=1.0d0
+ enddo
+ else
+ write (iout,*) "Error in WHAM_CALC: wrong RESCALE_MODE",
+ & rescale_mode
+ call flush(iout)
+ return1
+ endif
+ evdw=enetb(21,i,iparm)
+ evdw_t=enetb(1,i,iparm)
+#ifdef SCP14
+ evdw2_14=enetb(17,i,iparm)
+ evdw2=enetb(2,i,iparm)+evdw2_14
+#else
+ evdw2=enetb(2,i,iparm)
+ evdw2_14=0.0d0
+#endif
+#ifdef SPLITELE
+ ees=enetb(3,i,iparm)
+ evdw1=enetb(16,i,iparm)
+#else
+ ees=enetb(3,i,iparm)
+ evdw1=0.0d0
+#endif
+ ecorr=enetb(4,i,iparm)
+ ecorr5=enetb(5,i,iparm)
+ ecorr6=enetb(6,i,iparm)
+ eel_loc=enetb(7,i,iparm)
+ eello_turn3=enetb(8,i,iparm)
+ eello_turn4=enetb(9,i,iparm)
+ eturn6=enetb(10,i,iparm)
+ ebe=enetb(11,i,iparm)
+ escloc=enetb(12,i,iparm)
+ etors=enetb(13,i,iparm)
+ etors_d=enetb(14,i,iparm)
+ ehpb=enetb(15,i,iparm)
+ estr=enetb(18,i,iparm)
+ esccor=enetb(19,i,iparm)
+ edihcnstr=enetb(20,i,iparm)
+ ehomology_constr=enetb(22,i,iparm)
+#ifdef SPLITELE
+ etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees
+ & +wvdwpp*evdw1
+ & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc
+ & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5
+ & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4
+ & +ft(2)*wturn3*eello_turn3
+ & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc
+ & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor
+ & +wbond*estr+ehomology_constr
+#else
+ etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2
+ & +ft(1)*welec*(ees+evdw1)
+ & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc
+ & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5
+ & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4
+ & +ft(2)*wturn3*eello_turn3
+ & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr
+ & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor
+ & +wbond*estr+ehomology_constr
+
+#endif
+ etot=etot-entfac(i)/beta_h(ib,iparm)
+ if(etot.lt.potEmin_all(ib,iparm)) potEmin_all(ib,iparm)=etot
+
+ enddo ! ib
+ enddo ! iparm
+ enddo ! i
+#ifdef DEBUG
+ write (iout,*) "The potEmin array before reduction"
+ do i=1,nParmSet
+ write (iout,*) "Parameter set",i
+ do j=1,nT_h(i)
+ write (iout,*) j,PotEmin_all(j,i)
+ enddo
+ enddo
+ write (iout,*) "potEmin_min",potEmin_min
+#endif
+#ifdef MPI
+C Determine the minimum energes for all parameter sets and temperatures
+ call MPI_AllReduce(potEmin_all(1,1),potEmin_t_all(1,1),
+ & maxT_h*nParmSet,MPI_DOUBLE_PRECISION,MPI_MIN,WHAM_COMM,IERROR)
+ do i=1,nParmSet
+ do j=1,nT_h(i)
+ potEmin_all(j,i)=potEmin_t_all(j,i)
+ enddo
+ enddo
+#endif
+ potEmin_min=potEmin_all(1,1)
+ do i=1,nParmSet
+ do j=1,nT_h(i)
+ if (potEmin_all(j,i).lt.potEmin_min)
+ & potEmin_min=potEmin_all(j,i)
+ enddo
+ enddo
+#ifdef DEBUG
+ write (iout,*) "The potEmin array"
+ do i=1,nParmSet
+ write (iout,*) "Parameter set",i
+ do j=1,nT_h(i)
+ write (iout,*) j,1.0d0/(1.987d-3*beta_h(j,i)),
+ & PotEmin_all(j,i)
+ enddo
+ enddo
+ write (iout,*) "potEmin_min",potEmin_min
+#endif
+
+
+! Now, put together the histograms from all simulations, in order to get the
+! unbiased total histogram.
#ifdef MPI
do t=0,tmax
hfin_ent_p(t)=0.0d0
estr=enetb(18,t,iparm)
esccor=enetb(19,t,iparm)
edihcnstr=enetb(20,t,iparm)
- edihcnstr=0.0d0
+ ehomology_constr=enetb(22,t,iparm)
+ if (homol_nset.gt.1)
+ & ehomology_constr=waga_homology(ihset)*ehomology_constr
do k=0,nGridT
betaT=startGridT+k*delta_T
temper=betaT
c write (iout,*) "ftprim",ftprim
c write (iout,*) "ftbis",ftbis
betaT=1.0d0/(1.987D-3*betaT)
+ if (betaT.ge.beta_h(1,iparm)) then
+ potEmin=potEmin_all(1,iparm)+
+ & (potEmin_all(1,iparm)-potEmin_all(2,iparm))/
+ & (1.0/beta_h(1,iparm)-1.0/beta_h(2,iparm))*
+ & (1.0/betaT-1.0/beta_h(1,iparm))
+#ifdef DEBUG
+ write(iout,*) "first",temper,potEmin
+#endif
+ else if (betaT.le.beta_h(nT_h(iparm),iparm)) then
+ potEmin=potEmin_all(nT_h(iparm),iparm)+
+ &(potEmin_all(nT_h(iparm),iparm)-potEmin_all(nT_h(iparm)-1,iparm))/
+ &(1.0/beta_h(nT_h(iparm),iparm)-1.0/beta_h(nT_h(iparm)-1,iparm))*
+ &(1.0/betaT-1.0/beta_h(nt_h(iparm),iparm))
+#ifdef DEBUG
+ write (iout,*) "last",temper,potEmin
+#endif
+ else
+ do l=1,nT_h(iparm)-1
+ if (betaT.le.beta_h(l,iparm) .and.
+ & betaT.gt.beta_h(l+1,iparm)) then
+ potEmin=potEmin_all(l,iparm)
+#ifdef DEBUG
+ write (iout,*) "l",l,
+ & betaT,1.0d0/(1.987D-3*beta_h(l,iparm)),
+ & 1.0d0/(1.987D-3*beta_h(l+1,iparm)),temper,potEmin
+#endif
+ exit
+ endif
+ enddo
+ endif
#ifdef SPLITELE
etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees
& +wvdwpp*evdw1
& +ft(2)*wturn3*eello_turn3
& +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc
& +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor
- & +wbond*estr
+ & +wbond*estr+ehomology_constr
eprim=ftprim(6)*evdw_t+ftprim(1)*welec*ees
& +ftprim(1)*wtor*etors+
& ftprim(3)*wcorr*ecorr+ftprim(4)*wcorr5*ecorr5+
& +ft(2)*wturn3*eello_turn3
& +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr
& +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor
- & +wbond*estr
+ & +wbond*estr+ehomology_constr
eprim=ftprim(6)*evdw_t+ftprim(1)*welec*(ees+evdw1)
& +ftprim(1)*wtor*etors+
& ftprim(3)*wcorr*ecorr+ftprim(4)*wcorr5*ecorr5+
& ftbis(5)*wcorr6*ecorr6+ftbis(3)*wturn4*eello_turn4+
& ftbis(2)*wturn3*eello_turn3+ftbis(5)*wturn6*eturn6+
& ftbis(2)*wel_loc*eel_loc+ftbis(2)*wtor_d*etors_d+
- & ftprim(1)*wsccor*esccor
+ & ftbis(1)*wsccor*esccor
+
+ endif
+
#endif
weight=dexp(-betaT*(etot-potEmin)+entfac(t))
#ifdef DEBUG
endif
#ifdef MPI
do ib=1,nT_h(iparm)
+ potEmin=potEmin_all(ib,iparm)
expfac=dexp(-beta_h(ib,iparm)*(etot-potEmin)+entfac(t))
hfin_p(ind,ib)=hfin_p(ind,ib)+
& dexp(-beta_h(ib,iparm)*(etot-potEmin)+entfac(t))
enddo
#else
do ib=1,nT_h(iparm)
+ potEmin=potEmin_all(ib,iparm)
expfac=dexp(-beta_h(ib,iparm)*(etot-potEmin)+entfac(t))
hfin(ind,ib)=hfin(ind,ib)+
& dexp(-beta_h(ib,iparm)*(etot-potEmin)+entfac(t))
write (iout,'(a,i3)') "Parameter set",iparm
endif
do i=0,NGridT
+ betaT=1.0d0/(1.987D-3*(startGridT+i*delta_T))
+ if (betaT.ge.beta_h(1,iparm)) then
+ potEmin=potEmin_all(1,iparm)
+ else if (betaT.lt.beta_h(nT_h(iparm),iparm)) then
+ potEmin=potEmin_all(nT_h(iparm),iparm)
+ else
+ do l=1,nT_h(iparm)-1
+ if (betaT.le.beta_h(l,iparm) .and.
+ & betaT.gt.beta_h(l+1,iparm)) then
+ potEmin=potEmin_all(l,iparm)
+ exit
+ endif
+ enddo
+ endif
+
sumE(i,iparm)=sumE(i,iparm)/sumW(i,iparm)
sumEbis(i,iparm)=(startGridT+i*delta_T)*sumEbis(i,iparm)/
& sumW(i,iparm)
call flush(iout)
call molread(*10)
call flush(iout)
+ if (constr_dist.gt.0) call read_dist_constr
#ifdef MPI
write (iout,*) "Calling proc_groups"
call proc_groups
call read_ref_structure(*10)
call proc_cont
call fragment_list
- if (constr_dist.gt.0) call read_dist_constr
endif
+C if (constr_dist.gt.0) call read_dist_constr
write (iout,*) "Begin read_database"
call flush(iout)
call read_database(*10)
projects / unres.git / commitdiff