From 6e3ddc18f32640ddb87822a737b3e0bd9cf6c82c Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Fri, 22 May 2020 23:12:14 +0200 Subject: [PATCH 01/16] Adam's corrections --- source/cluster/wham/src-HCD/energy_p_new.F | 22 ++++++---- source/unres/src-HCD-5D/MREMD.F | 61 ++++++++++++++-------------- source/unres/src-HCD-5D/readrtns_CSA.F | 51 ++++++++++++----------- source/wham/src-HCD/DIMENSIONS | 2 +- source/wham/src-HCD/energy_p_new.F | 23 +++++++---- source/wham/src-HCD/read_constr_homology.F | 7 +++- source/wham/src-HCD/readpdb.F | 9 ++-- 7 files changed, 96 insertions(+), 79 deletions(-) diff --git a/source/cluster/wham/src-HCD/energy_p_new.F b/source/cluster/wham/src-HCD/energy_p_new.F index 27e944b..95898b4 100644 --- a/source/cluster/wham/src-HCD/energy_p_new.F +++ b/source/cluster/wham/src-HCD/energy_p_new.F @@ -10203,16 +10203,20 @@ c 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) + if (nexl.gt.0) then + min_odl=0.0d0 + else + 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 + enddo + endif c write (iout,* )"min_odl",min_odl #ifdef DEBUG write (iout,*) "ij dij",i,j,dij diff --git a/source/unres/src-HCD-5D/MREMD.F b/source/unres/src-HCD-5D/MREMD.F index 38db8a8..9191402 100644 --- a/source/unres/src-HCD-5D/MREMD.F +++ b/source/unres/src-HCD-5D/MREMD.F @@ -62,6 +62,7 @@ cold integer nup(0:maxprocs),ndown(0:maxprocs) & ene_i_iex,xxx,tmp,econstr_temp_iex,econstr_temp_i integer iran_num double precision ran_number + integer i_econstr/20/ cdeb imin_itime_old=0 ntwx_cache=0 @@ -186,8 +187,9 @@ cd write (*,*) me," After broadcast: file_exist",file_exist do i=nnt,nct if (itype(i).ne.ntyp1) stdforcsc(i)=stdfsc(iabs(itype(i))) & *dsqrt(gamsc(iabs(itype(i)))) - enddo + enddo endif + endif if(me.eq.king) then @@ -250,20 +252,20 @@ cd write (*,*) me," After broadcast: file_exist",file_exist write (iout,'(a6,i4,a1,100i4)') "ndowna",il,":", & (ndowna(i,il),i=1,ndowna(0,il)) enddo + stdfp=dsqrt(2*Rb*t_bath/d_time) do i=1,ntyp stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) enddo if (lang.gt.0 .and. .not.surfarea) then - do i=nnt,nct-1 - stdforcp(i)=stdfp*dsqrt(gamp) - enddo + do i=nnt,nct-1 + stdforcp(i)=stdfp*dsqrt(gamp) + enddo do i=nnt,nct if (itype(i).ne.ntyp1) stdforcsc(i)=stdfsc(iabs(itype(i))) & *dsqrt(gamsc(iabs(itype(i)))) - enddo - endif - + enddo + endif ELSE IF (.not.(rest.and.file_exist)) THEN do il=1,remd_m(1) ifirst(il)=il @@ -319,7 +321,7 @@ cd print *,'ttt',me,remd_tlist,(remd_t(i),i=1,nrep) iset=i2set(me) if(me.eq.king.or..not.out1file) & write(iout,*) me,"iset=",iset,"t_bath=",t_bath - call flush(iout) +c call flush(iout) endif c stdfp=dsqrt(2*Rb*t_bath/d_time) @@ -721,7 +723,7 @@ ctime call flush(iout) write(iout,*) "MIN ii_write=",ii_write endif endif - call flush(iout) +c call flush(iout) endif if (synflag) then c Update the time safety limiy @@ -855,7 +857,7 @@ cd end time05=MPI_WTIME() if (me.eq.king .or. .not. out1file) then write(iout,*) 'REMD writing traj time=',time05-time04 - call flush(iout) +c call flush(iout) endif @@ -1089,12 +1091,12 @@ cd write(iout,*) "i_dir=",i_dir iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) c 9/1/17 AL: Correction; otherwise the restraint energies are mis-assigned c on failed replica exchange attempt - econstr_temp_i=remd_ene(20,i) - econstr_temp_iex=remd_ene(20,iex) + econstr_temp_i=remd_ene(i_econstr,i) + econstr_temp_iex=remd_ene(i_econstr,iex) c 9/11/17 AL: Adaptive sampling (temperature dependent restraints potentials) if (adaptive) then - remd_ene(20,i)=remd_ene(n_ene+5,i) - remd_ene(20,iex)=remd_ene(n_ene+6,iex) + remd_ene(i_econstr,i)=remd_ene(n_ene+5,i) + remd_ene(i_econstr,iex)=remd_ene(n_ene+6,iex) endif elseif(i_dir.eq.2 .and. mset(i_iset+1).gt.0)then @@ -1103,10 +1105,10 @@ c 9/11/17 AL: Adaptive sampling (temperature dependent restraints potentials) i_iset1=i_iset+1 i_mset1=iran_num(1,mset(i_iset1)) iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - econstr_temp_i=remd_ene(20,i) - econstr_temp_iex=remd_ene(20,iex) - remd_ene(20,i)=remd_ene(n_ene+3,i) - remd_ene(20,iex)=remd_ene(n_ene+4,iex) + econstr_temp_i=remd_ene(i_econstr,i) + econstr_temp_iex=remd_ene(i_econstr,iex) + remd_ene(i_econstr,i)=remd_ene(n_ene+3,i) + remd_ene(i_econstr,iex)=remd_ene(n_ene+4,iex) elseif(remd_m(i_temp+1).gt.0.and.mset(i_iset+1).gt.0)then @@ -1115,14 +1117,14 @@ c 9/11/17 AL: Adaptive sampling (temperature dependent restraints potentials) i_iset1=i_iset+1 i_mset1=iran_num(1,mset(i_iset1)) iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - econstr_temp_i=remd_ene(20,i) - econstr_temp_iex=remd_ene(20,iex) + econstr_temp_i=remd_ene(i_econstr,i) + econstr_temp_iex=remd_ene(i_econstr,iex) if (adaptive) then - remd_ene(20,i)=remd_ene(n_ene+7,i) - remd_ene(20,iex)=remd_ene(n_ene+8,iex) + remd_ene(i_econstr,i)=remd_ene(n_ene+7,i) + remd_ene(i_econstr,iex)=remd_ene(n_ene+8,iex) else - remd_ene(20,i)=remd_ene(n_ene+3,i) - remd_ene(20,iex)=remd_ene(n_ene+4,iex) + remd_ene(i_econstr,i)=remd_ene(n_ene+3,i) + remd_ene(i_econstr,iex)=remd_ene(n_ene+4,iex) endif else goto 444 @@ -1222,8 +1224,8 @@ cd write(iout,'(2i4,a6,2f12.5)') i,iex,' delta',delta,xxx else remd_ene(0,iex)=ene_iex_iex remd_ene(0,i)=ene_i_i - remd_ene(20,iex)=econstr_temp_iex - remd_ene(20,i)=econstr_temp_i + remd_ene(i_econstr,iex)=econstr_temp_iex + remd_ene(i_econstr,i)=econstr_temp_i endif cd do il=1,nset @@ -1259,7 +1261,7 @@ c------------------------------------- enddo endif - call flush(iout) +c call flush(iout) cd write (iout,'(a6,100i4)') "ifirst", cd & (ifirst(i),i=1,remd_m(1)) @@ -1305,7 +1307,6 @@ co & " rescaling weights with temperature",t_bath do i=1,ntyp stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) enddo - c Compute the standard deviations of stochastic forces for Langevin dynamics c if the friction coefficients do not depend on surface area if (lang.gt.0 .and. .not.surfarea) then @@ -1317,11 +1318,11 @@ c if the friction coefficients do not depend on surface area & *dsqrt(gamsc(iabs(itype(i)))) enddo endif -cde write(iout,*) 'REMD after',me,t_bath +cde write(iout,*) 'REMD after',me,t_bath time08=MPI_WTIME() if (me.eq.king .or. .not. out1file) then write(iout,*) 'REMD exchange time=',time08-time00 - call flush(iout) +c call flush(iout) endif endif enddo diff --git a/source/unres/src-HCD-5D/readrtns_CSA.F b/source/unres/src-HCD-5D/readrtns_CSA.F index c51e45e..16c0f37 100644 --- a/source/unres/src-HCD-5D/readrtns_CSA.F +++ b/source/unres/src-HCD-5D/readrtns_CSA.F @@ -2979,10 +2979,11 @@ c & sigma_odl_temp(maxres,maxres,max_template) character*24 model_ki_dist, model_ki_angle character*500 controlcard integer ki,i,ii,j,k,l,ii_in_use(maxdim),i_tmp,idomain_tmp,irec, - & ik,iistart,iishift + & ik,iistart integer ilen external ilen - logical liiflag + logical liiflag,lfirst + integer i01,i10 c c FP - Nov. 2014 Temporary specifications for new vars c @@ -3314,6 +3315,7 @@ c write (iout,*) "waga_dist",waga_dist," nnt",nnt," nct",nct if (waga_dist.ne.0.0d0) then ii=0 liiflag=.true. + lfirst=.true. do i=nnt,nct-2 do j=i+2,nct ii=ii+1 @@ -3321,34 +3323,35 @@ c if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0 c & .and. distal.le.dist2_cut ) then c write (iout,*) "i",i," j",j," ii",ii c call flush(iout) - if (ii_in_use(ii).eq.0.and.liiflag) then + if (ii_in_use(ii).eq.0.and.liiflag.or. + & ii_in_use(ii).eq.1.and.liiflag.and.ii.eq.lim_odl) then liiflag=.false. - iistart=ii + i10=ii + if (lfirst) then + lfirst=.false. + iistart=ii + else + if(i10.eq.lim_odl) i10=i10+1 + do ki=0,i10-i01-1 + ires_homo(iistart+ki)=ires_homo(ki+i01) + jres_homo(iistart+ki)=jres_homo(ki+i01) + ii_in_use(iistart+ki)=ii_in_use(ki+i01) + do k=1,constr_homology + odl(k,iistart+ki)=odl(k,ki+i01) + sigma_odl(k,iistart+ki)=sigma_odl(k,ki+i01) + l_homo(k,iistart+ki)=l_homo(k,ki+i01) + enddo + enddo + iistart=iistart+i10-i01 + endif endif - if (ii_in_use(ii).ne.0.and..not.liiflag.or. - & .not.liiflag.and.ii.eq.lim_odl) then - if (ii.eq.lim_odl) then - iishift=ii-iistart+1 - else - iishift=ii-iistart - endif + if (ii_in_use(ii).ne.0.and..not.liiflag) then + i01=ii liiflag=.true. - do ki=iistart,lim_odl-iishift - ires_homo(ki)=ires_homo(ki+iishift) - jres_homo(ki)=jres_homo(ki+iishift) - ii_in_use(ki)=ii_in_use(ki+iishift) - do k=1,constr_homology - odl(k,ki)=odl(k,ki+iishift) - sigma_odl(k,ki)=sigma_odl(k,ki+iishift) - l_homo(k,ki)=l_homo(k,ki+iishift) - enddo - enddo - ii=ii-iishift - lim_odl=lim_odl-iishift -c endif endif enddo enddo + lim_odl=iistart-1 endif c write (iout,*) "Removing distances completed" c call flush(iout) diff --git a/source/wham/src-HCD/DIMENSIONS b/source/wham/src-HCD/DIMENSIONS index 4bc527f..4d690f3 100644 --- a/source/wham/src-HCD/DIMENSIONS +++ b/source/wham/src-HCD/DIMENSIONS @@ -24,7 +24,7 @@ c Max. number of chains parameter (maxchain=6) C Max number of symetries integer maxsym,maxperm - parameter (maxsym=maxchain,maxperm=1200) + parameter (maxsym=maxchain,maxperm=720) C Max. number of variables integer maxvar parameter (maxvar=4*maxres) diff --git a/source/wham/src-HCD/energy_p_new.F b/source/wham/src-HCD/energy_p_new.F index bd69774..efba869 100644 --- a/source/wham/src-HCD/energy_p_new.F +++ b/source/wham/src-HCD/energy_p_new.F @@ -159,6 +159,7 @@ c write (iout,*) "Calling multibody_hbond" call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) endif #endif +c write (iout,*) "nsaxs",nsaxs c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr if (nsaxs.gt.0 .and. saxs_mode.eq.0) then call e_saxs(Esaxs_constr) @@ -4609,16 +4610,20 @@ c 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) + if (nexl.gt.0) then + min_odl=0.0d0 + else + 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 + enddo + endif c write (iout,* )"min_odl",min_odl #ifdef DEBUG write (iout,*) "ij dij",i,j,dij diff --git a/source/wham/src-HCD/read_constr_homology.F b/source/wham/src-HCD/read_constr_homology.F index dece50f..0af2bdb 100644 --- a/source/wham/src-HCD/read_constr_homology.F +++ b/source/wham/src-HCD/read_constr_homology.F @@ -165,6 +165,7 @@ c call readpdb write (iout,*) "read_constr_homology: after reading pdb file" call flush(iout) #endif + c c Distance restraints c @@ -553,14 +554,18 @@ c Distance restraints c c ... --> odl(k,ii) C Copy the coordinates from reference coordinates (?) +c write (iout,*) "k",k do i=1,2*nres do j=1,3 c(j,i)=chomo(j,i,k) -c write (iout,*) "c(",j,i,") =",c(j,i) +c write (iout,*) "c(",j,i,") =",c(j,i) enddo enddo +c call cartprint +c write (iout,*) "read_klapaucjusz: calling int_from_cart" call int_from_cart(.true.,.false.) call sc_loc_geom(.false.) +c write (iout,*) "en" do i=1,nres thetaref(i)=theta(i) phiref(i)=phi(i) diff --git a/source/wham/src-HCD/readpdb.F b/source/wham/src-HCD/readpdb.F index 83c63ab..55dcc04 100644 --- a/source/wham/src-HCD/readpdb.F +++ b/source/wham/src-HCD/readpdb.F @@ -27,10 +27,9 @@ C geometry. ibeg=1 ishift1=0 sccalc=.false. - ires=0 do read (ipdbin,'(a80)',end=10) card -c write (iout,'(a)') card +! write (iout,'(a)') card if (card(:5).eq.'HELIX') then nhfrag=nhfrag+1 lsecondary=.true. @@ -59,7 +58,7 @@ c write (iout,'(a)') card iterter(ires_old)=1 ishift1=ishift1+1 ibeg=2 - write (iout,*) "Chain ended",ires,ishift,ires_old +! write (iout,*) "Chain ended",ires,ishift,ires_old if (unres_pdb) then do j=1,3 dc(j,ires)=sccor(j,iii) @@ -120,7 +119,7 @@ c write (iout,*) "BEG ires",ires ! Start a new chain ishift=-ires_old+ires-1 !!!!! ishift1=ishift1-1 !!!!! - write (iout,*) "New chain started",ires,ishift,ishift1,"!" +! write (iout,*) "New chain started",ires,ishift,ishift1,"!" ires=ires-ishift+ishift1 ires_old=ires ibeg=0 @@ -326,7 +325,7 @@ c 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.ntyp1 .and. itype(i).ne.ntyp1 .and. & (dist(i,i-1).lt.1.0D0 .or. dist(i,i-1).gt.6.0D0)) then write (iout,'(a,i4)') 'Bad Cartesians for residue',i - stop +c stop endif vbld(i)=dist(i-1,i) vbld_inv(i)=1.0d0/vbld(i) -- 1.7.9.5 From dd7bdb2c09f0c456056e31ef2eedb894d1f0e92c Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Fri, 22 May 2020 23:29:09 +0200 Subject: [PATCH 02/16] cluster & wham update --- source/cluster/wham/src-HCD/COMMON.CHAIN | 5 +- source/cluster/wham/src-HCD/energy_p_new.F | 1 + source/cluster/wham/src-HCD/read_constr_homology.F | 105 +++++++++++------- source/cluster/wham/src-HCD/readpdb.F | 23 ++-- source/wham/src-HCD/COMMON.CHAIN | 5 +- source/wham/src-HCD/energy_p_new.F | 1 - source/wham/src-HCD/read_constr_homology.F | 115 +++++++++++++------- source/wham/src-HCD/readpdb.F | 6 +- 8 files changed, 168 insertions(+), 93 deletions(-) diff --git a/source/cluster/wham/src-HCD/COMMON.CHAIN b/source/cluster/wham/src-HCD/COMMON.CHAIN index 9de64dd..2b481a5 100644 --- a/source/cluster/wham/src-HCD/COMMON.CHAIN +++ b/source/cluster/wham/src-HCD/COMMON.CHAIN @@ -1,6 +1,6 @@ integer nres,nres0,nsup,nstart_sup,nend_sup,nstart_seq, & nchain,chain_border,chain_length,ireschain,npermchain, - & tabpermchain,ishift_pdb,iz_sc + & tabpermchain,ishift_pdb,iz_sc,nres_chomo double precision c,cref,crefjlee,cref_pdb,dc,xloc,xrot,dc_norm, & t,r,prod,rt,chomo common /chain/ c(3,maxres2+2),dc(3,maxres2),xloc(3,maxres), @@ -18,4 +18,5 @@ & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick common /box/ boxxsize,boxysize,boxzsize,enecut,sscut,sss,sssgrad, & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick - common /chomo_models/ chomo(3,maxres2+2,max_template) + common /chomo_models/ chomo(3,maxres2+2,max_template), + & nres_chomo(max_template) diff --git a/source/cluster/wham/src-HCD/energy_p_new.F b/source/cluster/wham/src-HCD/energy_p_new.F index 95898b4..5d07d5d 100644 --- a/source/cluster/wham/src-HCD/energy_p_new.F +++ b/source/cluster/wham/src-HCD/energy_p_new.F @@ -10217,6 +10217,7 @@ c min_odl=minval(distancek) & min_odl=distancek(kk) enddo endif + c write (iout,* )"min_odl",min_odl #ifdef DEBUG write (iout,*) "ij dij",i,j,dij diff --git a/source/cluster/wham/src-HCD/read_constr_homology.F b/source/cluster/wham/src-HCD/read_constr_homology.F index b188deb..6ae3ef4 100644 --- a/source/cluster/wham/src-HCD/read_constr_homology.F +++ b/source/cluster/wham/src-HCD/read_constr_homology.F @@ -1,5 +1,5 @@ subroutine read_constr_homology - + implicit none include 'DIMENSIONS' #ifdef MPI include 'mpif.h' @@ -27,16 +27,19 @@ 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 ki,i,ii,ik,j,k,l,ii_in_use(maxdim),i_tmp,idomain_tmp, + & lim_theta,lim_xx,irec,iistart,iishift,i10,i01 + double precision distal integer idomain(max_template,maxres) - logical lprn /.true./ + logical lfirst integer ilen external ilen logical liiflag + integer nres_temp c c FP - Nov. 2014 Temporary specifications for new vars c - double precision rescore_tmp,x12,y12,z12,rescore2_tmp + double precision rescore_tmp,x12,y12,z12,rescore2_tmp, & rescore3_tmp double precision, dimension (max_template,maxres) :: rescore double precision, dimension (max_template,maxres) :: rescore2 @@ -142,6 +145,7 @@ c tpl_k_rescore="template"//kic2//".sco" unres_pdb=.false. + nres_temp=nres if (read2sigma) then call readpdb_template(k) close(ipdbin) @@ -149,15 +153,16 @@ c call readpdb(out_template_coord) close(ipdbin) endif + nres_chomo(k)=nres + nres=nres_temp -c 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 + do i=1,nres_chomo(k) write (iout,'(i5,3f8.3,5x,3f8.3)') i,(crefjlee(j,i),j=1,3), & (crefjlee(j,i+nres),j=1,3) enddo @@ -170,7 +175,7 @@ c Distance restraints c c ... --> odl(k,ii) C Copy the coordinates from reference coordinates (?) - do i=1,2*nres + do i=1,2*nres_chomo(k) do j=1,3 c(j,i)=cref(j,i) c write (iout,*) "c(",j,i,") =",c(j,i) @@ -259,6 +264,8 @@ c & constr_homology enddo lim_odl=ii endif +c write (iout,*) "Distance restraints set" +c call flush(iout) c c Theta, dihedral and SC retraints c @@ -294,11 +301,13 @@ c sigma_dih(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)* c rescore(k,i-2)*rescore(k,i-3) ! right expression ? c Instead of res sim other local measure of b/b str reliability possible if (sigma_dih(k,i).ne.0) - & sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i)) + & sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i)) c sigma_dih(k,i)=sigma_dih(k,i)*sigma_dih(k,i) enddo lim_dih=nct-nnt-2 endif +c write (iout,*) "Dihedral angle restraints set" +c call flush(iout) if (waga_theta.gt.0.0d0) then c open (ientin,file=tpl_k_sigma_theta,status='old') @@ -334,6 +343,8 @@ c rescore(k,i-2) ! right expression ? c sigma_theta(k,i)=sigma_theta(k,i)*sigma_theta(k,i) enddo endif +c write (iout,*) "Angle restraints set" +c call flush(iout) if (waga_d.gt.0.0d0) then c open (ientin,file=tpl_k_sigma_d,status='old') @@ -359,7 +370,6 @@ 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) -c sigma_d(k,i)=rescore(k,i) ! right expression ? sigma_d(k,i)=rescore3(k,i) ! right expression ? if (sigma_d(k,i).ne.0) & sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i)) @@ -370,57 +380,70 @@ c read (ientin,*) sigma_d(k,i) ! 1st variant enddo endif enddo +c write (iout,*) "SC restraints set" +c call flush(iout) c c remove distance restraints not used in any model from the list c shift data in all arrays c +c write (iout,*) "waga_dist",waga_dist," nnt",nnt," nct",nct if (waga_dist.ne.0.0d0) then ii=0 liiflag=.true. + lfirst=.true. do i=nnt,nct-2 do j=i+2,nct ii=ii+1 - if (ii_in_use(ii).eq.0.and.liiflag) then +c if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0 +c & .and. distal.le.dist2_cut ) then +c write (iout,*) "i",i," j",j," ii",ii +c call flush(iout) + if (ii_in_use(ii).eq.0.and.liiflag.or. + & ii_in_use(ii).eq.1.and.liiflag.and.ii.eq.lim_odl) then liiflag=.false. - iistart=ii + i10=ii + if (lfirst) then + lfirst=.false. + iistart=ii + else + if(i10.eq.lim_odl) i10=i10+1 + do ki=0,i10-i01-1 + ires_homo(iistart+ki)=ires_homo(ki+i01) + jres_homo(iistart+ki)=jres_homo(ki+i01) + ii_in_use(iistart+ki)=ii_in_use(ki+i01) + do k=1,constr_homology + odl(k,iistart+ki)=odl(k,ki+i01) + sigma_odl(k,iistart+ki)=sigma_odl(k,ki+i01) + l_homo(k,iistart+ki)=l_homo(k,ki+i01) + enddo + enddo + iistart=iistart+i10-i01 + endif endif - if (ii_in_use(ii).ne.0.and..not.liiflag.or. - & .not.liiflag.and.ii.eq.lim_odl) then - if (ii.eq.lim_odl) then - iishift=ii-iistart+1 - else - iishift=ii-iistart - endif + if (ii_in_use(ii).ne.0.and..not.liiflag) then + i01=ii liiflag=.true. - do ki=iistart,lim_odl-iishift - ires_homo(ki)=ires_homo(ki+iishift) - jres_homo(ki)=jres_homo(ki+iishift) - ii_in_use(ki)=ii_in_use(ki+iishift) - do k=1,constr_homology - odl(k,ki)=odl(k,ki+iishift) - sigma_odl(k,ki)=sigma_odl(k,ki+iishift) - l_homo(k,ki)=l_homo(k,ki+iishift) - enddo - enddo - ii=ii-iishift - lim_odl=lim_odl-iishift endif enddo enddo + lim_odl=iistart-1 endif - - endif ! .not. klapaucjusz +c write (iout,*) "Removing distances completed" +c call flush(iout) + endif ! .not. klapaucjusz if (constr_homology.gt.0) call homology_partition +c write (iout,*) "After homology_partition" +c call flush(iout) if (constr_homology.gt.0) call init_int_table -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 write (iout,*) "After init_int_table" +c call flush(iout) +c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end +c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end c c Print restraints c - if (.not.lprn) return + if (.not.out_template_restr) return cd write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d c if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then write (iout,*) "Distance restraints from templates" @@ -477,7 +500,9 @@ c---------------------------------------------------------------------- character*500 controlcard integer ki, i, j, k, l, ii_in_use(maxdim),i_tmp,idomain_tmp integer idomain(max_template,maxres) + integer nres_temp logical lprn /.true./ + logical lfirst integer ilen external ilen logical liiflag @@ -513,7 +538,10 @@ c Read pdb files stop 34 continue unres_pdb=.false. + nres_temp=nres call readpdb_template(k) + nres_chomo(k)=nres + nres=nres_temp c do i=1,2*nres c do j=1,3 c chomo(j,i,k)=c(j,i) @@ -552,6 +580,8 @@ c Distance restraints c c ... --> odl(k,ii) C Copy the coordinates from reference coordinates (?) + nres_temp=nres + nres=nres_chomo(k) do i=1,2*nres do j=1,3 c(j,i)=chomo(j,i,k) @@ -564,6 +594,7 @@ c write (iout,*) "c(",j,i,") =",c(j,i) thetaref(i)=theta(i) phiref(i)=phi(i) enddo + nres=nres_temp if (waga_dist.ne.0.0d0) then ii=0 do i = nnt,nct-2 diff --git a/source/cluster/wham/src-HCD/readpdb.F b/source/cluster/wham/src-HCD/readpdb.F index a7bb52b..58c63e4 100644 --- a/source/cluster/wham/src-HCD/readpdb.F +++ b/source/cluster/wham/src-HCD/readpdb.F @@ -98,7 +98,7 @@ c write (2,'(a)') card ! write (iout,*) "Calculating sidechain center iii",iii if (unres_pdb) then do j=1,3 - dc(j,ires+nres)=sccor(j,iii) + dc(j,ires_old)=sccor(j,iii) enddo else call sccenter(ires_old,iii,sccor) @@ -347,17 +347,20 @@ c character*5 atom & ' Gamma' endif endif - do i=1,nres-1 + do i=2,nres iti=itype(i) - if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then +c 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.ntyp1 .and. itype(i).ne.ntyp1 .and. + & (dist(i,i-1).lt.1.0D0 .or. dist(i,i-1).gt.6.0D0)) then write (iout,'(a,i4)') 'Bad Cartesians for residue',i -ctest stop +c stop endif - 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) + vbld(i)=dist(i-1,i) + vbld_inv(i)=1.0d0/vbld(i) + 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 + c if (unres_pdb) then c if (itype(1).eq.ntyp1) then c theta(3)=90.0d0*deg2rad @@ -806,7 +809,7 @@ C 2/15/2013 by Adam: corrected insertion of the first dummy residue endif endif C Calculate internal coordinates. - if (lprn) then + if (out_template_coord) then write (iout,'(/a)') & "Cartesian coordinates of the reference structure" write (iout,'(a,3(3x,a5),5x,3(3x,a5))') @@ -818,6 +821,7 @@ C Calculate internal coordinates. enddo endif C Calculate internal coordinates. +#ifdef DEBUG write (iout,'(a)') & "Backbone and SC coordinates as read from the PDB" do ires=1,nres @@ -825,7 +829,8 @@ C Calculate internal coordinates. & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3), & (c(j,nres+ires),j=1,3) enddo - call int_from_cart(.true.,.false.) +#endif + call int_from_cart(.true.,out_template_coord) call sc_loc_geom(.false.) do i=1,nres thetaref(i)=theta(i) diff --git a/source/wham/src-HCD/COMMON.CHAIN b/source/wham/src-HCD/COMMON.CHAIN index dfffc78..7b79a58 100644 --- a/source/wham/src-HCD/COMMON.CHAIN +++ b/source/wham/src-HCD/COMMON.CHAIN @@ -1,6 +1,6 @@ integer nres,nres0,nsup,nstart_sup,nend_sup,nstart_seq, & ishift_pdb,chain_length,chain_border,chain_border1,ichanres, - & tabpermchain,nchain ,npermchain,ireschain,iz_sc + & tabpermchain,nchain ,npermchain,ireschain,iz_sc,nres_chomo double precision c,cref,crefjlee,dc,xloc,xrot,dc_norm,t,r,prod,rt, & rmssing,anatemp,chomo common /chain/ c(3,maxres2+2),dc(3,maxres2),xloc(3,maxres), @@ -18,4 +18,5 @@ & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick common /box/ boxxsize,boxysize,boxzsize,enecut,sscut,sss,sssgrad, & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick - common /chomo_models/ chomo(3,maxres2+2,max_template) + common /chomo_models/ chomo(3,maxres2+2,max_template), + & nres_chomo(max_template) diff --git a/source/wham/src-HCD/energy_p_new.F b/source/wham/src-HCD/energy_p_new.F index efba869..6105156 100644 --- a/source/wham/src-HCD/energy_p_new.F +++ b/source/wham/src-HCD/energy_p_new.F @@ -159,7 +159,6 @@ c write (iout,*) "Calling multibody_hbond" call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) endif #endif -c write (iout,*) "nsaxs",nsaxs c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr if (nsaxs.gt.0 .and. saxs_mode.eq.0) then call e_saxs(Esaxs_constr) diff --git a/source/wham/src-HCD/read_constr_homology.F b/source/wham/src-HCD/read_constr_homology.F index 0af2bdb..fa81b80 100644 --- a/source/wham/src-HCD/read_constr_homology.F +++ b/source/wham/src-HCD/read_constr_homology.F @@ -1,5 +1,6 @@ subroutine read_constr_homology + implicit none include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include 'DIMENSIONS.FREE' @@ -29,12 +30,15 @@ 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 ki,i,ii,ik,j,k,l,ii_in_use(maxdim),i_tmp,idomain_tmp, + & lim_theta,lim_xx,irec,iistart,iishift,i10,i01 + double precision distal integer idomain(max_template,maxres) - logical lprn /.true./ + logical lfirst integer ilen external ilen logical liiflag + integer nres_temp c c FP - Nov. 2014 Temporary specifications for new vars c @@ -143,6 +147,7 @@ c tpl_k_rescore="template"//kic2//".sco" unres_pdb=.false. + nres_temp=nres if (read2sigma) then call readpdb_template(k) close(ipdbin) @@ -150,15 +155,16 @@ c call readpdb close(ipdbin) endif + nres_chomo(k)=nres + nres=nres_temp -c call readpdb - do i=1,2*nres + do i=1,2*nres_chomo(k) do j=1,3 crefjlee(j,i)=c(j,i) enddo enddo #ifdef DEBUG - do i=1,nres + do i=1,nres_chmo(k) write (iout,'(i5,3f8.3,5x,3f8.3)') i,(crefjlee(j,i),j=1,3), & (crefjlee(j,i+nres),j=1,3) enddo @@ -171,7 +177,7 @@ c Distance restraints c c ... --> odl(k,ii) C Copy the coordinates from reference coordinates (?) - do i=1,2*nres + do i=1,2*nres_chomo(k) do j=1,3 c(j,i)=cref(j,i) c write (iout,*) "c(",j,i,") =",c(j,i) @@ -260,6 +266,8 @@ c & constr_homology enddo lim_odl=ii endif +c write (iout,*) "Distance restraints set" +c call flush(iout) c c Theta, dihedral and SC retraints c @@ -295,11 +303,13 @@ c sigma_dih(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)* c rescore(k,i-2)*rescore(k,i-3) ! right expression ? c Instead of res sim other local measure of b/b str reliability possible if (sigma_dih(k,i).ne.0) - & sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i)) + & sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i)) c sigma_dih(k,i)=sigma_dih(k,i)*sigma_dih(k,i) enddo lim_dih=nct-nnt-2 endif +c write (iout,*) "Dihedral angle restraints set" +c call flush(iout) if (waga_theta.gt.0.0d0) then c open (ientin,file=tpl_k_sigma_theta,status='old') @@ -335,6 +345,8 @@ c rescore(k,i-2) ! right expression ? c sigma_theta(k,i)=sigma_theta(k,i)*sigma_theta(k,i) enddo endif +c write (iout,*) "Angle restraints set" +c call flush(iout) if (waga_d.gt.0.0d0) then c open (ientin,file=tpl_k_sigma_d,status='old') @@ -360,7 +372,6 @@ 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) -c sigma_d(k,i)=rescore(k,i) ! right expression ? sigma_d(k,i)=rescore3(k,i) ! right expression ? if (sigma_d(k,i).ne.0) & sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i)) @@ -371,57 +382,70 @@ c read (ientin,*) sigma_d(k,i) ! 1st variant enddo endif enddo +c write (iout,*) "SC restraints set" +c call flush(iout) c c remove distance restraints not used in any model from the list c shift data in all arrays c +c write (iout,*) "waga_dist",waga_dist," nnt",nnt," nct",nct if (waga_dist.ne.0.0d0) then ii=0 liiflag=.true. + lfirst=.true. do i=nnt,nct-2 do j=i+2,nct ii=ii+1 - if (ii_in_use(ii).eq.0.and.liiflag) then +c if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0 +c & .and. distal.le.dist2_cut ) then +c write (iout,*) "i",i," j",j," ii",ii +c call flush(iout) + if (ii_in_use(ii).eq.0.and.liiflag.or. + & ii_in_use(ii).eq.1.and.liiflag.and.ii.eq.lim_odl) then liiflag=.false. - iistart=ii + i10=ii + if (lfirst) then + lfirst=.false. + iistart=ii + else + if(i10.eq.lim_odl) i10=i10+1 + do ki=0,i10-i01-1 + ires_homo(iistart+ki)=ires_homo(ki+i01) + jres_homo(iistart+ki)=jres_homo(ki+i01) + ii_in_use(iistart+ki)=ii_in_use(ki+i01) + do k=1,constr_homology + odl(k,iistart+ki)=odl(k,ki+i01) + sigma_odl(k,iistart+ki)=sigma_odl(k,ki+i01) + l_homo(k,iistart+ki)=l_homo(k,ki+i01) + enddo + enddo + iistart=iistart+i10-i01 + endif endif - if (ii_in_use(ii).ne.0.and..not.liiflag.or. - & .not.liiflag.and.ii.eq.lim_odl) then - if (ii.eq.lim_odl) then - iishift=ii-iistart+1 - else - iishift=ii-iistart - endif + if (ii_in_use(ii).ne.0.and..not.liiflag) then + i01=ii liiflag=.true. - do ki=iistart,lim_odl-iishift - ires_homo(ki)=ires_homo(ki+iishift) - jres_homo(ki)=jres_homo(ki+iishift) - ii_in_use(ki)=ii_in_use(ki+iishift) - do k=1,constr_homology - odl(k,ki)=odl(k,ki+iishift) - sigma_odl(k,ki)=sigma_odl(k,ki+iishift) - l_homo(k,ki)=l_homo(k,ki+iishift) - enddo - enddo - ii=ii-iishift - lim_odl=lim_odl-iishift endif enddo enddo + lim_odl=iistart-1 endif - - endif ! .not. klapaucjusz +c write (iout,*) "Removing distances completed" +c call flush(iout) + endif ! .not. klapaucjusz if (constr_homology.gt.0) call homology_partition +c write (iout,*) "After homology_partition" +c call flush(iout) if (constr_homology.gt.0) call init_int_table -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 write (iout,*) "After init_int_table" +c call flush(iout) +c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end +c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end c c Print restraints c - if (.not.lprn) return + if (.not.out_template_restr) return cd write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d c if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then write (iout,*) "Distance restraints from templates" @@ -455,7 +479,7 @@ c ----------------------------------------------------------------- end c---------------------------------------------------------------------- subroutine read_klapaucjusz - + implicit none include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include 'DIMENSIONS.FREE' @@ -478,8 +502,11 @@ c---------------------------------------------------------------------- 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 i,ii,ik,ki,j,k,l,ll,ii_in_use(maxdim),i_tmp,idomain_tmp, + & nclust,iistart,iishift,lim_xx + integer nres_temp integer idomain(max_template,maxres) + double precision distal logical lprn /.true./ integer ilen external ilen @@ -499,6 +526,7 @@ c call getenv("FRAGFILE",fragfile) open(ientin,file=fragfile,status="old",err=10) read(ientin,*) constr_homology,nclust + lim_xx=0 l_homo = .false. sigma_theta=0.0 sigma_d=0.0 @@ -515,7 +543,10 @@ c Read pdb files stop 34 continue unres_pdb=.false. + nres_temp=nres call readpdb_template(k) + nres_chomo(k)=nres + nres=nres_temp c do i=1,2*nres c do j=1,3 c chomo(j,i,k)=c(j,i) @@ -536,6 +567,7 @@ c c Loop over clusters c do l=1,nclust +c write (iout,*) "CLUSTER",l," members:",ninclust(l) do ll = 1,ninclust(l) k = inclust(ll,l) @@ -555,14 +587,18 @@ c c ... --> odl(k,ii) C Copy the coordinates from reference coordinates (?) c write (iout,*) "k",k + nres_temp=nres + nres=nres_chomo(k) do i=1,2*nres do j=1,3 c(j,i)=chomo(j,i,k) c write (iout,*) "c(",j,i,") =",c(j,i) enddo enddo -c call cartprint c write (iout,*) "read_klapaucjusz: calling int_from_cart" +c call cartprint +c write (iout,*) "idomain" +c write (iout,'(2i5)') (i,idomain(k,i),i=1,nres) call int_from_cart(.true.,.false.) call sc_loc_geom(.false.) c write (iout,*) "en" @@ -570,6 +606,7 @@ c write (iout,*) "en" thetaref(i)=theta(i) phiref(i)=phi(i) enddo + nres=nres_temp if (waga_dist.ne.0.0d0) then ii=0 do i = nnt,nct-2 diff --git a/source/wham/src-HCD/readpdb.F b/source/wham/src-HCD/readpdb.F index 55dcc04..6f4ba5f 100644 --- a/source/wham/src-HCD/readpdb.F +++ b/source/wham/src-HCD/readpdb.F @@ -91,7 +91,7 @@ c write (2,'(a)') card ! write (iout,*) "Calculating sidechain center iii",iii if (unres_pdb) then do j=1,3 - dc(j,ires+nres)=sccor(j,iii) + dc(j,ires_old)=sccor(j,iii) enddo else call sccenter(ires_old,iii,sccor) @@ -804,8 +804,8 @@ C Calculate internal coordinates. endif C Calculate internal coordinates. c call int_from_cart1(.false.) - call int_from_cart(.true.,.true.) - call sc_loc_geom(.true.) + call int_from_cart(.true.,out_template_coord) + call sc_loc_geom(.false.) do i=1,nres thetaref(i)=theta(i) phiref(i)=phi(i) -- 1.7.9.5 From 47fc0fb0bccd301d26a8dac1bb693932f9ebef15 Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Fri, 29 May 2020 21:42:15 +0200 Subject: [PATCH 03/16] corrections --- source/cluster/wham/src-HCD/COMMON.HOMOLOGY | 2 +- source/cluster/wham/src-HCD/COMMON.HOMRESTR | 7 +- source/cluster/wham/src-HCD/COMMON.SBRIDGE | 26 +- source/cluster/wham/src-HCD/DIMENSIONS | 13 + .../wham/src-HCD/Makefile-MPICH-ifort-okeanos | 8 +- source/cluster/wham/src-HCD/Makefile-tryton | 125 ++ source/cluster/wham/src-HCD/boxshift.f | 101 ++ source/cluster/wham/src-HCD/energy_p_new.F | 361 +---- .../wham/src-HCD/include_unres/COMMON.CONTMAT | 5 +- .../wham/src-HCD/include_unres/COMMON.CORRMAT | 3 - .../wham/src-HCD/include_unres/COMMON.DERIV | 4 +- source/cluster/wham/src-HCD/initialize_p.F | 4 +- source/cluster/wham/src-HCD/probabl.F | 2 + source/cluster/wham/src-HCD/readpdb.F | 2 +- source/cluster/wham/src-HCD/readrtns.F | 10 +- source/cluster/wham/src-HCD/ssMD.F | 1478 ++------------------ source/cluster/wham/src-HCD/wrtclust.f | 2 +- source/unres/src-HCD-5D/COMMON.CHAIN | 8 +- source/unres/src-HCD-5D/COMMON.CONTMAT | 5 +- source/unres/src-HCD-5D/COMMON.CORRMAT | 3 - source/unres/src-HCD-5D/COMMON.HOMOLOGY | 11 +- source/unres/src-HCD-5D/COMMON.INTERACT | 12 +- source/unres/src-HCD-5D/COMMON.SBRIDGE | 26 +- source/unres/src-HCD-5D/COMMON.SHIELD | 9 +- source/unres/src-HCD-5D/DIMENSIONS | 23 +- source/unres/src-HCD-5D/MD_A-MTS.F | 51 +- source/unres/src-HCD-5D/MP.F | 4 +- source/unres/src-HCD-5D/MREMD.F | 37 +- .../unres/src-HCD-5D/Makefile_MPICH_ifort-tryton | 200 +++ source/unres/src-HCD-5D/contact_cp2.F | 148 ++ source/unres/src-HCD-5D/energy_p_new-sep_barrier.F | 3 - source/unres/src-HCD-5D/energy_p_new_barrier.F | 28 +- source/unres/src-HCD-5D/energy_split-sep.F | 45 +- source/unres/src-HCD-5D/gen_rand_conf.F | 6 +- source/unres/src-HCD-5D/initialize_p.F | 4 +- source/unres/src-HCD-5D/make_xx_list.F | 124 +- source/unres/src-HCD-5D/minim_jlee.F | 4 +- source/unres/src-HCD-5D/minimize_p.F | 4 +- source/unres/src-HCD-5D/parmread.F | 7 +- source/unres/src-HCD-5D/read_constr_homology.F | 717 ++++++++++ source/unres/src-HCD-5D/readpdb-mult.F | 42 +- source/unres/src-HCD-5D/readrtns_CSA.F | 118 +- source/unres/src-HCD-5D/regularize.F | 3 +- source/unres/src-HCD-5D/ssMD.F | 167 +-- source/unres/src-HCD-5D/stochfric.F | 4 + source/unres/src-HCD-5D/test.F | 165 +-- source/wham/src-HCD/COMMON.HOMOLOGY | 2 +- source/wham/src-HCD/COMMON.HOMRESTR | 7 +- source/wham/src-HCD/COMMON.SHIELD | 9 +- source/wham/src-HCD/DIMENSIONS | 21 +- source/wham/src-HCD/Makefile-tryton | 162 +++ source/wham/src-HCD/Makefile_MPICH_ifort-okeanos | 2 +- source/wham/src-HCD/boxshift.f | 101 ++ source/wham/src-HCD/cxread.F | 7 +- source/wham/src-HCD/enecalc1.F | 11 +- source/wham/src-HCD/energy_p_new.F | 363 +---- source/wham/src-HCD/include_unres/COMMON.CALC | 4 +- source/wham/src-HCD/include_unres/COMMON.CONTMAT | 5 +- source/wham/src-HCD/include_unres/COMMON.CORRMAT | 3 - source/wham/src-HCD/include_unres/COMMON.DERIV | 4 +- source/wham/src-HCD/include_unres/COMMON.SBRIDGE | 24 +- source/wham/src-HCD/initialize_p.F | 4 +- source/wham/src-HCD/molread_zs.F | 9 +- source/wham/src-HCD/parmread.F | 4 +- source/wham/src-HCD/readpdb.F | 2 +- source/wham/src-HCD/readrtns.F | 2 + source/wham/src-HCD/ssMD.F | 1423 +------------------ source/wham/src-HCD/wham_calc1.F | 4 +- 68 files changed, 2475 insertions(+), 3829 deletions(-) create mode 100644 source/cluster/wham/src-HCD/Makefile-tryton create mode 100644 source/cluster/wham/src-HCD/boxshift.f create mode 100644 source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton create mode 100644 source/unres/src-HCD-5D/contact_cp2.F create mode 100644 source/unres/src-HCD-5D/read_constr_homology.F create mode 100644 source/wham/src-HCD/Makefile-tryton create mode 100644 source/wham/src-HCD/boxshift.f diff --git a/source/cluster/wham/src-HCD/COMMON.HOMOLOGY b/source/cluster/wham/src-HCD/COMMON.HOMOLOGY index e2a7754..d149f8d 100644 --- a/source/cluster/wham/src-HCD/COMMON.HOMOLOGY +++ b/source/cluster/wham/src-HCD/COMMON.HOMOLOGY @@ -5,4 +5,4 @@ & dist2_cut common /homol/ waga_homology(10), & waga_dist,waga_angle,waga_theta,waga_d,dist_cut,dist2_cut, - & iset,ihset,l_homo(max_template,maxdim) + & iset,ihset,l_homo(max_template,maxdim_cont) diff --git a/source/cluster/wham/src-HCD/COMMON.HOMRESTR b/source/cluster/wham/src-HCD/COMMON.HOMRESTR index 95ea932..0e558f1 100644 --- a/source/cluster/wham/src-HCD/COMMON.HOMRESTR +++ b/source/cluster/wham/src-HCD/COMMON.HOMRESTR @@ -1,6 +1,7 @@ - real*8 odl(max_template,maxdim),sigma_odl(max_template,maxdim), + real*8 odl(max_template,maxdim_cont), + & sigma_odl(max_template,maxdim_cont), & dih(max_template,maxres),sigma_dih(max_template,maxres), - & sigma_odlir(max_template,maxdim) + & sigma_odlir(max_template,maxdim_cont) c c Specification of new variables used in subroutine e_modeller c modified by FP (Nov.,2014) @@ -10,7 +11,7 @@ c modified by FP (Nov.,2014) & sigma_d(max_template,maxres) c - integer ires_homo(maxdim),jres_homo(maxdim) + integer ires_homo(maxdim_cont),jres_homo(maxdim_cont) double precision & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst, diff --git a/source/cluster/wham/src-HCD/COMMON.SBRIDGE b/source/cluster/wham/src-HCD/COMMON.SBRIDGE index ab78ed3..a313d8f 100644 --- a/source/cluster/wham/src-HCD/COMMON.SBRIDGE +++ b/source/cluster/wham/src-HCD/COMMON.SBRIDGE @@ -1,20 +1,22 @@ double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss - integer ns,nss,nfree,iss - logical restr_on_coord + integer ns,nss,nfree,iss,icys common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, - & ns,nss,nfree,iss(maxss) + & ns,nss,nfree,iss(maxss),icys(maxres) double precision dhpb,dhpb1,forcon,fordepth,xlscore,wboltzd, & dhpb_peak,dhpb1_peak,forcon_peak,fordepth_peak,scal_peak,bfac integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb,ibecarb_peak,npeak, & ipeak,irestr_type,irestr_type_peak,ihpb_peak,jhpb_peak,nhpb_peak - common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), - & fordepth(maxdim),bfac(maxres),xlscore(maxdim),wboltzd, - & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),irestr_type(maxdim), + logical restr_on_coord + common /links/ dhpb(maxdim_cont),dhpb1(maxdim_cont), + & forcon(maxdim_cont),fordepth(maxdim_cont),bfac(maxres), + & xlscore(maxdim_cont),wboltzd,ihpb(maxdim_cont),jhpb(maxdim_cont), + & ibecarb(maxdim_cont),irestr_type(maxdim_cont), & nhpb,restr_on_coord - common /NMRpeaks/ dhpb_peak(maxdim),dhpb1_peak(maxdim), - & forcon_peak(maxdim),fordepth_peak(maxdim),scal_peak, - & ihpb_peak(maxdim),jhpb_peak(maxdim),ibecarb_peak(maxdim), - & irestr_type_peak(maxdim),ipeak(2,maxdim),npeak,nhpb_peak + common /NMRpeaks/ dhpb_peak(maxdim_cont),dhpb1_peak(maxdim_cont), + & forcon_peak(maxdim_cont),fordepth_peak(maxdim_cont),scal_peak, + & ihpb_peak(maxdim_cont),jhpb_peak(maxdim_cont), + & ibecarb_peak(maxdim_cont),irestr_type_peak(maxdim_cont), + & ipeak(2,maxdim_cont),npeak,nhpb_peak double precision weidis common /restraints/ weidis integer link_start,link_end,link_start_peak,link_end_peak @@ -23,7 +25,7 @@ double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss logical dyn_ss,dyn_ss_mask common /dyn_ssbond/ dtriss,atriss,btriss,ctriss,Ht, - & dyn_ssbond_ij(maxres,maxres), - & idssb(maxdim),jdssb(maxdim) + & dyn_ssbond_ij(max_cyst,max_cyst), + & idssb(maxss),jdssb(maxss) common /dyn_ss_logic/ & dyn_ss,dyn_ss_mask(maxres) diff --git a/source/cluster/wham/src-HCD/DIMENSIONS b/source/cluster/wham/src-HCD/DIMENSIONS index ffd3a80..e6a29b3 100644 --- a/source/cluster/wham/src-HCD/DIMENSIONS +++ b/source/cluster/wham/src-HCD/DIMENSIONS @@ -11,6 +11,9 @@ C Max. number of AA residues integer maxres,maxres2 c parameter (maxres=1200) parameter (maxres=5000) +C Max. number of cysteines and other bridging residues + integer max_cyst + parameter (max_cyst=100) C Appr. max. number of interaction sites parameter (maxres2=2*maxres) C Max. number of variables @@ -34,6 +37,16 @@ C Max. number of SC contacts C Max. number of contacts per residue integer maxconts parameter (maxconts=maxres) +C Max. number of interactions within cutoff per residue + integer maxint_res + parameter (maxint_res=200) +C Max. number od residues within distance cufoff from a given residue to +C include in template-based/contact distance restraints. + integer maxcont_res + parameter (maxcont_res=200) +C Max. number of distance/contact-distance restraints + integer maxdim_cont + parameter (maxdim_cont=maxres*maxcont_res) C Number of AA types (at present only natural AA's will be handled integer ntyp,ntyp1 parameter (ntyp=24,ntyp1=ntyp+1) diff --git a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos index 4f7f61f..425bed2 100644 --- a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos +++ b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos @@ -18,10 +18,10 @@ object = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ - int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ - setup_var.o read_ref_str.o gnmr1.o permut.o seq2chains.o \ - chain_symmetry.o iperm.o rmscalc.o rmsnat.o TMscore.o ssMD.o refsys.o \ - read_constr_homology.o + int_from_cart1.o energy_p_new.o boxshift.o icant.o proc_proc.o \ + work_partition.o setup_var.o read_ref_str.o gnmr1.o permut.o \ + seq2chains.o chain_symmetry.o iperm.o rmscalc.o rmsnat.o TMscore.o \ + ssMD.o refsys.o read_constr_homology.o all: no_option @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR" diff --git a/source/cluster/wham/src-HCD/Makefile-tryton b/source/cluster/wham/src-HCD/Makefile-tryton new file mode 100644 index 0000000..e887bc9 --- /dev/null +++ b/source/cluster/wham/src-HCD/Makefile-tryton @@ -0,0 +1,125 @@ +################################################################### +#INSTALL_DIR = /net/software/local/intel/compilers_and_libraries_2016.3.210/linux/mpi/intel64 + + +FC = mpif90 -fc=ifort + + +OPT = -O3 -ip -mcmodel=medium +#OPT = -CB -g -mcmodel=medium -shared-intel +FFLAGS = ${OPT} -c -I. -Iinclude_unres -I$(INSTALL_DIR)/include +LIBS = -L$(INSTALL_DIR)/lib -lmpi xdrf/libxdrf.a + +.c.o: + cc -c -DLINUX -DPGI $*.c + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F + +object = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ + matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ + geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ + track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ + int_from_cart1.o energy_p_new.o boxshift.o icant.o proc_proc.o \ + work_partition.o setup_var.o read_ref_str.o gnmr1.o permut.o \ + seq2chains.o chain_symmetry.o iperm.o rmscalc.o rmsnat.o TMscore.o \ + ssMD.o refsys.o read_constr_homology.o + +all: no_option + @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR" + +no_option: + +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC \ + -DFOURBODY +GAB: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_GAB-HCD.exe +GAB: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC \ + -DFOURBODY +4P: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_4P-HCD.exe +4P: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCLUST -DSPLITELE -DFOURBODY +E0LL2Y: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_E0LL2Y-HCD.exe +E0LL2Y: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCLUST -DSPLITELE -DFOURBODY -DDFA +E0LL2Y_DFA: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_E0LL2Y-HCD-DFA.exe +E0LL2Y_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DFIVEDIAG +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR5D: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD5.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR5D: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +NEWCORR_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DDFA +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR_DFA: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD-DFA.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DDFA +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR5D_DFA: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD5-DFA.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR5D_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +xdrf/libxdrf.a: + cd xdrf && make + + +clean: + /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean + + diff --git a/source/cluster/wham/src-HCD/boxshift.f b/source/cluster/wham/src-HCD/boxshift.f new file mode 100644 index 0000000..29d3406 --- /dev/null +++ b/source/cluster/wham/src-HCD/boxshift.f @@ -0,0 +1,101 @@ + +c------------------------------------------------------------------------ + double precision function boxshift(x,boxsize) + implicit none + double precision x,boxsize + double precision xtemp + xtemp=dmod(x,boxsize) + if (dabs(xtemp-boxsize).lt.dabs(xtemp)) then + boxshift=xtemp-boxsize + else if (dabs(xtemp+boxsize).lt.dabs(xtemp)) then + boxshift=xtemp+boxsize + else + boxshift=xtemp + endif + return + end +c-------------------------------------------------------------------------- + subroutine closest_img(xi,yi,zi,xj,yj,zj) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + integer xshift,yshift,zshift,subchap + double precision dist_init,xj_safe,yj_safe,zj_safe, + & xj_temp,yj_temp,zj_temp,dist_temp + xj_safe=xj + yj_safe=yj + zj_safe=zj + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + return + end +c-------------------------------------------------------------------------- + subroutine to_box(xi,yi,zi) + implicit none + include 'DIMENSIONS' + include 'COMMON.CHAIN' + double precision xi,yi,zi + xi=dmod(xi,boxxsize) + if (xi.lt.0.0d0) xi=xi+boxxsize + yi=dmod(yi,boxysize) + if (yi.lt.0.0d0) yi=yi+boxysize + zi=dmod(zi,boxzsize) + if (zi.lt.0.0d0) zi=zi+boxzsize + return + end +c-------------------------------------------------------------------------- + subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi) + implicit none + include 'DIMENSIONS' + include 'COMMON.CHAIN' + double precision xi,yi,zi,sslipi,ssgradlipi + double precision fracinbuf + double precision sscalelip,sscagradlip + + if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then +C the energy transfer exist + if (zi.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + return + end diff --git a/source/cluster/wham/src-HCD/energy_p_new.F b/source/cluster/wham/src-HCD/energy_p_new.F index 5d07d5d..119bad6 100644 --- a/source/cluster/wham/src-HCD/energy_p_new.F +++ b/source/cluster/wham/src-HCD/energy_p_new.F @@ -180,14 +180,23 @@ c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr #ifdef DFA C BARTEK for dfa test! + edfadis=0.0d0 if (wdfa_dist.gt.0) call edfad(edfadis) c write(iout,*)'edfad is finished!', wdfa_dist,edfadis + edfator=0.0d0 if (wdfa_tor.gt.0) call edfat(edfator) c write(iout,*)'edfat is finished!', wdfa_tor,edfator + edfanei=0.0d0 if (wdfa_nei.gt.0) call edfan(edfanei) c write(iout,*)'edfan is finished!', wdfa_nei,edfanei + edfabet=0.0d0 if (wdfa_beta.gt.0) call edfab(edfabet) c write(iout,*)'edfab is finished!', wdfa_beta,edfabet +#else + edfadis=0.0d0 + edfator=0.0d0 + edfanei=0.0d0 + edfabet=0.0d0 #endif #ifdef SPLITELE @@ -511,6 +520,9 @@ C Bartek edfator = energia(29) edfanei = energia(30) edfabet = energia(31) + Eafmforc=0.0d0 + etube=0.0d0 + Uconst=0.0d0 #ifdef SPLITELE write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp, & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1), @@ -674,6 +686,7 @@ cROZNICA xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) C Change 12/1/95 num_conti=0 C @@ -688,6 +701,10 @@ cd & 'iend=',iend(i,iint) xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) C Change 12/1/95 to calculate four-body interactions rij=xj*xj+yj*yj+zj*zj rrij=1.0D0/rij @@ -857,6 +874,7 @@ c enddo xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) C C Calculate SC interaction energy. C @@ -867,6 +885,10 @@ C xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) fac_augm=rrij**expon e_augm=augm(itypi,itypj)*fac_augm @@ -972,6 +994,7 @@ c endif xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1004,9 +1027,13 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -1110,35 +1137,8 @@ c if (icall.gt.0) lprn=.true. yi=c(2,nres+i) zi=c(3,nres+i) C returning the ith atom to box - xi=mod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=mod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=mod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize - if ((zi.gt.bordlipbot) - &.and.(zi.lt.bordliptop)) then -C the energy transfer exist - if (zi.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((zi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipi=sscalelip(fracinbuf) - ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) - sslipi=sscalelip(fracinbuf) - ssgradlipi=sscagradlip(fracinbuf)/lipbufthick - else - sslipi=1.0d0 - ssgradlipi=0.0 - endif - else - sslipi=0.0d0 - ssgradlipi=0.0 - endif - + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1196,80 +1196,15 @@ c alf12=0.0D0 yj=c(2,nres+j) zj=c(3,nres+j) C returning jth atom to box - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.gt.bordlipbot) - &.and.(zj.lt.bordliptop)) then -C the energy transfer exist - if (zj.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((zj-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipj=sscalelip(fracinbuf) - ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick - elseif (zj.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) - sslipj=sscalelip(fracinbuf) - ssgradlipj=sscagradlip(fracinbuf)/lipbufthick - else - sslipj=1.0d0 - ssgradlipj=0.0 - endif - else - sslipj=0.0d0 - ssgradlipj=0.0 - endif - aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 - bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 -C if (aa.ne.aa_aq(itypi,itypj)) then - -C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa, -C & bb_aq(itypi,itypj)-bb, -C & sslipi,sslipj -C endif - -C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj) -C checking the distance - dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 -C finding the closest - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - subchap=1 - endif - enddo - enddo - enddo - if (subchap.eq.1) then - xj=xj_temp-xi - yj=yj_temp-yi - zj=zj_temp-zi - else - xj=xj_safe-xi - yj=yj_safe-yi - zj=zj_safe-zi - endif - + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -1391,6 +1326,8 @@ c if (icall.gt.0) lprn=.true. xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1425,9 +1362,15 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -2256,12 +2199,7 @@ c end if xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi - xmedi=mod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=mod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=mod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize + call to_box(xmedi,ymedi,zmedi) num_conti=0 call eelecij(i,i+2,ees,evdw1,eel_loc) if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) @@ -2291,38 +2229,7 @@ c & .or. itype(i-1).eq.ntyp1 xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi -C Return atom into box, boxxsize is size of box in x dimension -c 194 continue -c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize -c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize -C Condition for being inside the proper box -c if ((xmedi.gt.((0.5d0)*boxxsize)).or. -c & (xmedi.lt.((-0.5d0)*boxxsize))) then -c go to 194 -c endif -c 195 continue -c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize -c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize -C Condition for being inside the proper box -c if ((ymedi.gt.((0.5d0)*boxysize)).or. -c & (ymedi.lt.((-0.5d0)*boxysize))) then -c go to 195 -c endif -c 196 continue -c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize -c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize -C Condition for being inside the proper box -c if ((zmedi.gt.((0.5d0)*boxzsize)).or. -c & (zmedi.lt.((-0.5d0)*boxzsize))) then -c go to 196 -c endif - xmedi=mod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=mod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=mod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize - + call to_box(xmedi,ymedi,zmedi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -2362,43 +2269,7 @@ c & .or. itype(i-1).eq.ntyp1 xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi - xmedi=mod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=mod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=mod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize -C xmedi=xmedi+xshift*boxxsize -C ymedi=ymedi+yshift*boxysize -C zmedi=zmedi+zshift*boxzsize - -C Return tom into box, boxxsize is size of box in x dimension -c 164 continue -c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize -c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize -C Condition for being inside the proper box -c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or. -c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then -c go to 164 -c endif -c 165 continue -c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize -c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize -C Condition for being inside the proper box -c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or. -c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then -c go to 165 -c endif -c 166 continue -c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize -c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize -cC Condition for being inside the proper box -c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or. -c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then -c go to 166 -c endif - -c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) + call to_box(xmedi,ymedi,zmedi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -2503,75 +2374,11 @@ C zj=c(3,j)+0.5D0*dzj-zmedi xj=c(1,j)+0.5D0*dxj yj=c(2,j)+0.5D0*dyj zj=c(3,j)+0.5D0*dzj - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ" - dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - isubchap=0 - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - isubchap=1 - endif - enddo - enddo - enddo - if (isubchap.eq.1) then - xj=xj_temp-xmedi - yj=yj_temp-ymedi - zj=zj_temp-zmedi - else - xj=xj_safe-xmedi - yj=yj_safe-ymedi - zj=zj_safe-zmedi - endif -C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC -c 174 continue -c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize -c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize -C Condition for being inside the proper box -c if ((xj.gt.((0.5d0)*boxxsize)).or. -c & (xj.lt.((-0.5d0)*boxxsize))) then -c go to 174 -c endif -c 175 continue -c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize -c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize -C Condition for being inside the proper box -c if ((yj.gt.((0.5d0)*boxysize)).or. -c & (yj.lt.((-0.5d0)*boxysize))) then -c go to 175 -c endif -c 176 continue -c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize -c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize -C Condition for being inside the proper box -c if ((zj.gt.((0.5d0)*boxzsize)).or. -c & (zj.lt.((-0.5d0)*boxzsize))) then -c go to 176 -c endif -C endif !endPBC condintion -C xj=xj-xmedi -C yj=yj-ymedi -C zj=zj-zmedi + call to_box(xj,yj,zj) + xj=boxshift(xj-xmedi,boxxsize) + yj=boxshift(yj-ymedi,boxysize) + zj=boxshift(zj-zmedi,boxzsize) rij=xj*xj+yj*yj+zj*zj - sss=sscale(sqrt(rij)) if (sss.eq.0.0d0) return sssgrad=sscagrad(sqrt(rij)) @@ -4055,12 +3862,7 @@ c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) yi=0.5D0*(c(2,i)+c(2,i+1)) zi=0.5D0*(c(3,i)+c(3,i+1)) C Returning the ith atom to box - xi=mod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=mod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=mod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize + call to_box(xi,yi,zi) do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) @@ -4075,44 +3877,10 @@ C Uncomment following three lines for Ca-p interactions yj=c(2,j) zj=c(3,j) C returning the jth atom to box - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 -C Finding the closest jth atom - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - subchap=1 - endif - enddo - enddo - enddo - if (subchap.eq.1) then - xj=xj_temp-xi - yj=yj_temp-yi - zj=zj_temp-zi - else - xj=xj_safe-xi - yj=yj_safe-yi - zj=zj_safe-zi - endif + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) C sss is scaling function for smoothing the cutoff gradient otherwise C the gradient would not be continuouse @@ -10217,7 +9985,6 @@ c min_odl=minval(distancek) & min_odl=distancek(kk) enddo endif - c write (iout,* )"min_odl",min_odl #ifdef DEBUG write (iout,*) "ij dij",i,j,dij diff --git a/source/cluster/wham/src-HCD/include_unres/COMMON.CONTMAT b/source/cluster/wham/src-HCD/include_unres/COMMON.CONTMAT index f0b6122..6e5b5d5 100644 --- a/source/cluster/wham/src-HCD/include_unres/COMMON.CONTMAT +++ b/source/cluster/wham/src-HCD/include_unres/COMMON.CONTMAT @@ -17,8 +17,9 @@ C 12/26/95 - H-bonding contacts & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), & ees0m(maxconts,maxres),d_cont(maxconts,maxres), & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions + double precision a_chuj,a_chuj_der + common /dipmat/ a_chuj(2,2,maxconts,maxres), + & a_chuj_der(2,2,3,5,maxconts,maxres) c 7/25/08 Commented out; not needed when cumulants used C Interactions of pseudo-dipoles generated by loc-el interactions. c double precision dip,dipderg,dipderx diff --git a/source/cluster/wham/src-HCD/include_unres/COMMON.CORRMAT b/source/cluster/wham/src-HCD/include_unres/COMMON.CORRMAT index 5f154e0..ae25625 100644 --- a/source/cluster/wham/src-HCD/include_unres/COMMON.CORRMAT +++ b/source/cluster/wham/src-HCD/include_unres/COMMON.CORRMAT @@ -30,9 +30,6 @@ C consecutive amino-acid residues. & costab2(maxres),sintab2(maxres) C This common block contains dipole-interaction matrices and their C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, & AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont,EAEA,EAEAderg,EAEAderx, diff --git a/source/cluster/wham/src-HCD/include_unres/COMMON.DERIV b/source/cluster/wham/src-HCD/include_unres/COMMON.DERIV index f1f5db5..9b47a73 100644 --- a/source/cluster/wham/src-HCD/include_unres/COMMON.DERIV +++ b/source/cluster/wham/src-HCD/include_unres/COMMON.DERIV @@ -15,7 +15,9 @@ & gdfad,gdfat,gdfan,gdfab integer nfl,icg logical calc_grad - common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), +c common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), +c 3/12/20 Adam: Arrays dcdv, dxdv, and dxds removed following recoding of gradient. + common /derivat/ & gradx(3,-1:maxres,2),gradc(3,-1:maxres,2),gvdwx(3,-1:maxres), & gvdwc(3,-1:maxres),gelc(3,-1:maxres),gelc_long(3,-1:maxres), & gvdwpp(3,-1:maxres),gvdwc_scpp(3,-1:maxres), diff --git a/source/cluster/wham/src-HCD/initialize_p.F b/source/cluster/wham/src-HCD/initialize_p.F index 87e4dde..aa675e9 100644 --- a/source/cluster/wham/src-HCD/initialize_p.F +++ b/source/cluster/wham/src-HCD/initialize_p.F @@ -174,10 +174,10 @@ C Initialize the bridge arrays do i=1,maxss iss(i)=0 enddo - do i=1,maxss + do i=1,maxdim_cont dhpb(i)=0.0D0 enddo - do i=1,maxss + do i=1,maxdim_cont ihpb(i)=0 jhpb(i)=0 enddo diff --git a/source/cluster/wham/src-HCD/probabl.F b/source/cluster/wham/src-HCD/probabl.F index a3a664b..40791a3 100644 --- a/source/cluster/wham/src-HCD/probabl.F +++ b/source/cluster/wham/src-HCD/probabl.F @@ -152,6 +152,8 @@ c call pdbout(totfree(i),16,i) c call flush(iout) #ifdef DEBUG write (iout,*) "conformation", i + write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), + & ((c(l,k+nres),l=1,3),k=nnt,nct) call enerprint(energia(0),fT) #endif etot=energia(0) diff --git a/source/cluster/wham/src-HCD/readpdb.F b/source/cluster/wham/src-HCD/readpdb.F index 58c63e4..f7cfb86 100644 --- a/source/cluster/wham/src-HCD/readpdb.F +++ b/source/cluster/wham/src-HCD/readpdb.F @@ -77,7 +77,7 @@ c write (2,*) "UNRES_PDB",unres_pdb sccalc=.true. endif ! Read free energy - if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp +c if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp ! Fish out the ATOM cards. if (index(card(1:4),'ATOM').gt.0) then sccalc=.false. diff --git a/source/cluster/wham/src-HCD/readrtns.F b/source/cluster/wham/src-HCD/readrtns.F index a3229a6..057f1ac 100644 --- a/source/cluster/wham/src-HCD/readrtns.F +++ b/source/cluster/wham/src-HCD/readrtns.F @@ -242,8 +242,8 @@ C Read weights of the subsequent energy terms. do i=1,maxres dyn_ss_mask(i)=.false. enddo - do i=1,maxres-1 - do j=i+1,maxres + do i=1,max_cyst-1 + do j=i+1,max_cyst dyn_ssbond_ij(i,j)=1.0d300 enddo enddo @@ -716,6 +716,12 @@ C Read information about disulfide bridges. C Read bridging residues. read (inp,*) ns,(iss(i),i=1,ns) c print *,'ns=',ns +c 5/24/2020 Adam: Added a table to translate residue numbers to cysteine +c numbers + icys=0 + do i=1,ns + icys(iss(i))=i + enddo C Check whether the specified bridging residues are cystines. do i=1,ns if (itype(iss(i)).ne.1) then diff --git a/source/cluster/wham/src-HCD/ssMD.F b/source/cluster/wham/src-HCD/ssMD.F index 9c23fe0..9b2908f 100644 --- a/source/cluster/wham/src-HCD/ssMD.F +++ b/source/cluster/wham/src-HCD/ssMD.F @@ -3,7 +3,6 @@ c---------------------------------------------------------------------------- c implicit none c Includes - implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.CHAIN' include 'COMMON.VAR' @@ -83,12 +82,8 @@ ct rij=ran_number(rmin,rmax) end C----------------------------------------------------------------------------- - subroutine dyn_ssbond_ene(resi,resj,eij) -c implicit none - -c Includes - implicit real*8 (a-h,o-z) + implicit none include 'DIMENSIONS' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' @@ -98,9 +93,10 @@ c Includes include 'COMMON.VAR' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.NAMES' #ifndef CLUST #ifndef WHAM -C include 'COMMON.MD' + include 'COMMON.MD' #endif #endif @@ -130,7 +126,10 @@ c integer itypi,itypj,k,l double precision omega,delta_inv,deltasq_inv,fac1,fac2 c-------FIRST METHOD double precision xm,d_xm(1:3) - integer xshift,yshift,zshift + double precision sslipi,sslipj,ssgradlipi,ssgradlipj + integer ici,icj,itypi,itypj + double precision boxshift,sscale,sscagrad + double precision aa,bb c-------END FIRST METHOD c-------SECOND METHOD c$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3) @@ -141,129 +140,50 @@ c-------TESTING CODE common /sschecks/ checkstop,transgrad integer icheck,nicheck,jcheck,njcheck - double precision echeck(-1:1),deps,ssx0,ljx0 + double precision echeck(-1:1),deps,ssx0,ljx0,xi,yi,zi c-------END TESTING CODE i=resi j=resj - + ici=icys(i) + icj=icys(j) + if (ici.eq.0 .or. icj.eq.0) then + write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') + & "Attempt to create", + & " a disulfide link between non-cysteine residues ",restyp(i),i, + & restyp(j),j + stop + endif itypi=itype(i) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) dsci_inv=vbld_inv(i+nres) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - xi=dmod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=dmod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=dmod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + call to_box(xi,yi,zi) C define scaling factor for lipids C if (positi.le.0) positi=positi+boxzsize C print *,i C first for peptide groups c for each residue check if it is in lipid or lipid water border area - if ((zi.gt.bordlipbot) - &.and.(zi.lt.bordliptop)) then -C the energy transfer exist - if (zi.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((positi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipi=sscalelip(fracinbuf) - ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) - sslipi=sscalelip(fracinbuf) - ssgradlipi=sscagradlip(fracinbuf)/lipbufthick - else - sslipi=1.0d0 - ssgradlipi=0.0 - endif - else - sslipi=0.0d0 - ssgradlipi=0.0 - endif - + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) itypj=itype(j) - xj=c(1,nres+j) - yj=c(2,nres+j) - zj=c(3,nres+j) - xj=dmod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=dmod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=dmod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.gt.bordlipbot) - &.and.(zj.lt.bordliptop)) then -C the energy transfer exist - if (zj.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((positi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipj=sscalelip(fracinbuf) - ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) - sslipj=sscalelip(fracinbuf) - ssgradlipj=sscagradlip(fracinbuf)/lipbufthick - else - sslipj=1.0d0 - ssgradlipj=0.0 - endif - else - sslipj=0.0d0 - ssgradlipj=0.0 - endif + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 - - dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - subchap=1 - endif - enddo - enddo - enddo - if (subchap.eq.1) then - xj=xj_temp-xi - yj=yj_temp-yi - zj=zj_temp-zi - else - xj=xj_safe-xi - yj=yj_safe-yi - zj=zj_safe-zi - endif - + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -281,6 +201,8 @@ C lipbufthick is thickenes of lipid buffore rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse + sss=sscale((1.0d0/rij)/sigma(itypi,itypj)) + sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj)) c The following are set in sc_angular c erij(1)=xj*rij c erij(2)=yj*rij @@ -360,15 +282,15 @@ c-------END TESTING CODE e1=fac*fac*aa e2=fac*bb eij=eps1*eps2rt*eps3rt*(e1+e2) -C write(iout,*) eij,'TU?1' eps2der=eij*eps3rt eps3der=eij*eps2rt - eij=eij*eps2rt*eps3rt + eij=eij*eps2rt*eps3rt*sss sigder=-sig/sigsq e1=e1*eps1*eps2rt**2*eps3rt**2 ed=-expon*(e1+eij)/ljd sigder=ed*sigder + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 eom12=eij*eps1_om12+eps2der*eps2rt_om12 @@ -377,8 +299,9 @@ C write(iout,*) eij,'TU?1' havebond=.true. ssd=rij-ssXs eij=ssA*ssd*ssd+ssB*ssd+ssC -C write(iout,*) 'TU?2',ssc,ssd + eij=eij*sss ed=2*akcm*ssd+akct*deltat12 + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij pom1=akct*ssd pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi eom1=-2*akth*deltat1-pom1-om2*pom2 @@ -413,13 +336,14 @@ c-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE h1=h_base(f1,hd1) h2=h_base(f2,hd2) eij=ssm*h1+Ht*h2 -C write(iout,*) eij,'TU?3' delta_inv=1.0d0/(xm-ssxm) deltasq_inv=delta_inv*delta_inv fac=ssm*hd1-Ht*hd2 fac1=deltasq_inv*fac*(xm-rij) fac2=deltasq_inv*fac*(rij-ssxm) ed=delta_inv*(Ht*hd2-ssm*hd1) + eij=eij*sss + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1) eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2) eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3) @@ -436,13 +360,14 @@ C write(iout,*) eij,'TU?3' h1=h_base(f1,hd1) h2=h_base(f2,hd2) eij=Ht*h1+ljm*h2 -C write(iout,*) 'TU?4',ssA delta_inv=1.0d0/(ljxm-xm) deltasq_inv=delta_inv*delta_inv fac=Ht*hd1-ljm*hd2 fac1=deltasq_inv*fac*(ljxm-rij) fac2=deltasq_inv*fac*(rij-xm) ed=delta_inv*(ljm*hd2-Ht*hd1) + eij=eij*sss + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1) eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2) eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3) @@ -508,7 +433,7 @@ c$$$ if (ed.gt.0.0d0) havebond=.true. c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE endif -C write(iout,*) 'havebond',havebond + if (havebond) then #ifndef CLUST #ifndef WHAM @@ -518,9 +443,10 @@ c & "SSBOND_E_FORM",totT,t_bath,i,j c endif #endif #endif - dyn_ssbond_ij(i,j)=eij - else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then - dyn_ssbond_ij(i,j)=1.0d300 + dyn_ssbond_ij(ici,icj)=eij + else if (.not.havebond .and. dyn_ssbond_ij(ici,icj).lt.1.0d300) + &then + dyn_ssbond_ij(ici,icj)=1.0d300 #ifndef CLUST #ifndef WHAM c write(iout,'(a15,f12.2,f8.1,2i5)') @@ -545,6 +471,8 @@ c-------TESTING CODE checkstop=.false. endif c-------END TESTING CODE + gg_lipi(3)=ssgradlipi*eij + gg_lipj(3)=ssgradlipj*eij do k=1,3 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij @@ -554,10 +482,10 @@ c-------END TESTING CODE gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) enddo do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) + gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k) & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwx(k,j)=gvdwx(k,j)+gg(k) + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k) & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv enddo @@ -568,13 +496,12 @@ cgrad enddo cgrad enddo do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l) - gvdwc(l,j)=gvdwc(l,j)+gg(l) + gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(k) + gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(k) enddo return end - C----------------------------------------------------------------------------- double precision function h_base(x,deriv) @@ -615,15 +542,12 @@ c$$$ deriv=30.0d0*xsq*deriv return end - c---------------------------------------------------------------------------- - subroutine dyn_set_nss c Adjust nss and other relevant variables based on dyn_ssbond_ij c implicit none c Includes - implicit real*8 (a-h,o-z) include 'DIMENSIONS' #ifdef MPI include "mpif.h" @@ -641,16 +565,16 @@ C include 'COMMON.MD' c Local variables double precision emin integer i,j,imin - integer diff,allflag(maxdim),allnss, - & allihpb(maxdim),alljhpb(maxdim), - & newnss,newihpb(maxdim),newjhpb(maxdim) + integer diff,allflag(maxdim_cont),allnss, + & allihpb(maxdim_cont),alljhpb(maxdim_cont), + & newnss,newihpb(maxdim_cont),newjhpb(maxdim_cont) logical found integer i_newnss(1024),displ(0:1024) - integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss + integer g_newihpb(maxdim_cont),g_newjhpb(maxdim_cont),g_newnss allnss=0 - do i=1,nres-1 - do j=i+1,nres + do i=1,ns-1 + do j=i+1,ns if (dyn_ssbond_ij(i,j).lt.1.0d300) then allnss=allnss+1 allflag(allnss)=0 @@ -768,1268 +692,34 @@ c & "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i) return end +c---------------------------------------------------------------------------- -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ integer i,iretcode,nfun_sc -c$$$ logical scfail -c$$$ double precision var(maxvar),e_sc,etot -c$$$ -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$c Minimize the two selected side-chains -c$$$ call overlap_sc(scfail) ! Better not fail! -c$$$ call minimize_sc(e_sc,var,iretcode,nfun_sc) -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------------- -c$$$ -c$$$ subroutine minimize_sc(etot_sc,iretcode,nfun) -c$$$c Minimize side-chains only, starting from geom but without modifying -c$$$c bond lengths. -c$$$c If mask_r is already set, only the selected side-chains are minimized, -c$$$c otherwise all side-chains are minimized keeping the backbone frozen. -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ integer icall -c$$$ common /srutu/ icall -c$$$ -c$$$c Output arguments -c$$$ double precision etot_sc -c$$$ integer iretcode,nfun -c$$$ -c$$$c External functions/subroutines -c$$$ external func_sc,grad_sc,fdum -c$$$ -c$$$c Local variables -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -c$$$ integer iv(liv) -c$$$ double precision rdum(1) -c$$$ double precision d(maxvar),v(1:lv),x(maxvar),xx(maxvar) -c$$$ integer idum(1) -c$$$ integer i,nvar_restr -c$$$ -c$$$ -c$$$cmc start_minim=.true. -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=1 -c$$$* selects output unit -c$$$ iv(21)=0 -c$$$c iv(21)=iout ! DEBUG -c$$$c iv(21)=8 ! DEBUG -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$c iv(22)=1 ! DEBUG -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$c iv(23)=1 ! DEBUG -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$c iv(24)=1 ! DEBUG -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-1 -c$$$ v(32)=rtolf -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,nphi -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ do i=nphi+1,nvar -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ -c$$$ call geom_to_var(nvar,x) -c$$$ IF (mask_r) THEN -c$$$ do i=1,nres ! Just in case... -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ELSE -c$$$c When minimizing ALL side-chains, etotal_sc is a little -c$$$c faster if we don't set mask_r -c$$$ do i=1,nres -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ mask_side(i)=1 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ENDIF -c$$$ call var_to_geom(nvar,x) -c$$$ call chainbuild_sc -c$$$ etot_sc=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6) -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine chainbuild_sc -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Local variables -c$$$ integer i -c$$$ -c$$$ -c$$$ do i=nnt,nct -c$$$ if (.not.mask_r .or. mask_side(i).eq.1) then -c$$$ call locate_side_chain(i) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision f -c$$$ -c$$$c Local variables -c$$$ double precision energia(0:n_ene) -c$$$#ifdef OSF -c$$$c Variables used to intercept NaNs -c$$$ double precision x_sum -c$$$ integer i_NAN -c$$$#endif -c$$$ -c$$$ -c$$$ nfl=nf -c$$$ icg=mod(nf,2)+1 -c$$$ -c$$$#ifdef OSF -c$$$c Intercept NaNs in the coordinates, before calling etotal_sc -c$$$ x_sum=0.D0 -c$$$ do i_NAN=1,n -c$$$ x_sum=x_sum+x(i_NAN) -c$$$ enddo -c$$$c Calculate the energy only if the coordinates are ok -c$$$ if ((.not.(x_sum.lt.0.D0)) .and. (.not.(x_sum.ge.0.D0))) then -c$$$ write(iout,*)" *** func_restr_sc : Found NaN in coordinates" -c$$$ f=1.0D+77 -c$$$ nf=0 -c$$$ else -c$$$#endif -c$$$ -c$$$ call var_to_geom_restr(n,x) -c$$$ call zerograd -c$$$ call chainbuild_sc -c$$$ call etotal_sc(energia(0)) -c$$$ f=energia(0) -c$$$ if (energia(1).eq.1.0D20 .or. energia(0).eq.1.0D99) nf=0 -c$$$ -c$$$#ifdef OSF -c$$$ endif -c$$$#endif -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------- -c$$$ -c$$$ subroutine grad_sc(n,x,nf,g,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.MINIM' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision g(maxvar) -c$$$ -c$$$c Local variables -c$$$ double precision f,gphii,gthetai,galphai,gomegai -c$$$ integer ig,ind,i,j,k,igall,ij -c$$$ -c$$$ -c$$$ icg=mod(nf,2)+1 -c$$$ if (nf-nfl+1) 20,30,40 -c$$$ 20 call func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$c write (iout,*) 'grad 20' -c$$$ if (nf.eq.0) return -c$$$ goto 40 -c$$$ 30 call var_to_geom_restr(n,x) -c$$$ call chainbuild_sc -c$$$C -c$$$C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -c$$$C -c$$$ 40 call cartder -c$$$C -c$$$C Convert the Cartesian gradient into internal-coordinate gradient. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ ind=nres-2 -c$$$ do i=2,nres-2 -c$$$ IF (mask_phi(i+2).eq.1) THEN -c$$$ gphii=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) -c$$$ gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ ig=ig+1 -c$$$ g(ig)=gphii -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ -c$$$ ind=0 -c$$$ do i=1,nres-2 -c$$$ IF (mask_theta(i+2).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gthetai=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) -c$$$ gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ g(ig)=gthetai -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ galphai=0.0D0 -c$$$ do k=1,3 -c$$$ galphai=galphai+dxds(k,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=galphai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gomegai=0.0D0 -c$$$ do k=1,3 -c$$$ gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=gomegai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$C -c$$$C Add the components corresponding to local energy terms. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ igall=0 -c$$$ do i=4,nres -c$$$ igall=igall+1 -c$$$ if (mask_phi(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do i=3,nres -c$$$ igall=igall+1 -c$$$ if (mask_theta(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do ij=1,2 -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ igall=igall+1 -c$$$ if (mask_side(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ endif -c$$$ enddo -c$$$ enddo -c$$$ -c$$$cd do i=1,ig -c$$$cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -c$$$cd enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine etotal_sc(energy_sc) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.FFIELD' -c$$$ -c$$$c Output arguments -c$$$ double precision energy_sc(0:n_ene) -c$$$ -c$$$c Local variables -c$$$ double precision evdw,escloc -c$$$ integer i,j -c$$$ -c$$$ -c$$$ do i=1,n_ene -c$$$ energy_sc(i)=0.0D0 -c$$$ enddo -c$$$ -c$$$ if (mask_r) then -c$$$ call egb_sc(evdw) -c$$$ call esc_sc(escloc) -c$$$ else -c$$$ call egb(evdw) -c$$$ call esc(escloc) -c$$$ endif -c$$$ -c$$$ if (evdw.eq.1.0D20) then -c$$$ energy_sc(0)=evdw -c$$$ else -c$$$ energy_sc(0)=wsc*evdw+wscloc*escloc -c$$$ endif -c$$$ energy_sc(1)=evdw -c$$$ energy_sc(12)=escloc -c$$$ -c$$$C -c$$$C Sum up the components of the Cartesian gradient. -c$$$C -c$$$ do i=1,nct -c$$$ do j=1,3 -c$$$ gradx(j,i,icg)=wsc*gvdwx(j,i) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_sc(evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$c if (icall.eq.0) lprn=.false. -c$$$ ind=0 -c$$$ do i=iatsc_s,iatsc_e -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$ do iint=1,nint_gr(i) -c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$ ENDIF -c$$$ enddo ! j -c$$$ enddo ! iint -c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine esc_sc(escloc) -c$$$C Calculate the local energy of a side chain and its derivatives in the -c$$$C corresponding virtual-bond valence angles THETA and the spherical angles -c$$$C ALPHA and OMEGA. -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.FFIELD' -c$$$ include 'COMMON.CONTROL' -c$$$ double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), -c$$$ & ddersc0(3),ddummy(3),xtemp(3),temp(3) -c$$$ common /sccalc/ time11,time12,time112,theti,it,nlobit -c$$$ delta=0.02d0*pi -c$$$ escloc=0.0D0 -c$$$c write (iout,'(a)') 'ESC' -c$$$ do i=loc_start,loc_end -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ it=itype(i) -c$$$ if (it.eq.10) goto 1 -c$$$ nlobit=nlob(it) -c$$$c print *,'i=',i,' it=',it,' nlobit=',nlobit -c$$$c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad -c$$$ theti=theta(i+1)-pipol -c$$$ x(1)=dtan(theti) -c$$$ x(2)=alph(i) -c$$$ x(3)=omeg(i) -c$$$ -c$$$ if (x(2).gt.pi-delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=pi-delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=pi-delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c escloci=esclocbi -c$$$c write (iout,*) escloci -c$$$ else if (x(2).lt.delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c write (iout,*) escloci -c$$$ else -c$$$ call enesc(x,escloci,dersc,ddummy,.false.) -c$$$ endif -c$$$ -c$$$ escloc=escloc+escloci -c$$$ if (energy_dec) write (iout,'(a6,i,0pf7.3)') -c$$$ & 'escloc',i,escloci -c$$$c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc -c$$$ -c$$$ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ -c$$$ & wscloc*dersc(1) -c$$$ gloc(ialph(i,1),icg)=wscloc*dersc(2) -c$$$ gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) -c$$$ 1 continue -c$$$ ENDIF -c$$$ enddo -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_ij(i_sc,j_sc,evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$ ind=0 -c$$$c$$$ do i=iatsc_s,iatsc_e -c$$$ i=i_sc -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$c$$$ do iint=1,nint_gr(i) -c$$$c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ j=j_sc -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$c$$$ enddo ! j -c$$$c$$$ enddo ! iint -c$$$c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine perturb_side_chain(i,angle) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i -c$$$ double precision angle ! In degrees -c$$$ -c$$$c Local variables -c$$$ integer i_sc -c$$$ double precision rad_ang,rand_v(3),length,cost,sint -c$$$ -c$$$ -c$$$ i_sc=i+nres -c$$$ rad_ang=angle*deg2rad -c$$$ -c$$$ length=0.0 -c$$$ do while (length.lt.0.01) -c$$$ rand_v(1)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(2)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(3)=ran_number(0.01D0,1.0D0) -c$$$ length=rand_v(1)*rand_v(1)+rand_v(2)*rand_v(2)+ -c$$$ + rand_v(3)*rand_v(3) -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ cost=rand_v(1)*dc_norm(1,i_sc)+rand_v(2)*dc_norm(2,i_sc)+ -c$$$ + rand_v(3)*dc_norm(3,i_sc) -c$$$ length=1.0D0-cost*cost -c$$$ if (length.lt.0.0D0) length=0.0D0 -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)-cost*dc_norm(1,i_sc) -c$$$ rand_v(2)=rand_v(2)-cost*dc_norm(2,i_sc) -c$$$ rand_v(3)=rand_v(3)-cost*dc_norm(3,i_sc) -c$$$ enddo -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ -c$$$ cost=dcos(rad_ang) -c$$$ sint=dsin(rad_ang) -c$$$ dc(1,i_sc)=vbld(i_sc)*(dc_norm(1,i_sc)*cost+rand_v(1)*sint) -c$$$ dc(2,i_sc)=vbld(i_sc)*(dc_norm(2,i_sc)*cost+rand_v(2)*sint) -c$$$ dc(3,i_sc)=vbld(i_sc)*(dc_norm(3,i_sc)*cost+rand_v(3)*sint) -c$$$ dc_norm(1,i_sc)=dc(1,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(2,i_sc)=dc(2,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(3,i_sc)=dc(3,i_sc)*vbld_inv(i_sc) -c$$$ c(1,i_sc)=c(1,i)+dc(1,i_sc) -c$$$ c(2,i_sc)=c(2,i)+dc(2,i_sc) -c$$$ c(3,i_sc)=c(3,i)+dc(3,i_sc) -c$$$ -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax3(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ double precision energy_sc(0:n_ene),etot -c$$$ double precision org_dc(3),org_dc_norm(3),org_c(3) -c$$$ double precision ang_pert,rand_fact,exp_fact,beta -c$$$ integer n,i_pert,i -c$$$ logical notdone -c$$$ -c$$$ -c$$$ beta=1.0D0 -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$ call etotal_sc(energy_sc) -c$$$ etot=energy_sc(0) -c$$$c write(iout,'(a,3d15.5)')" SS_MC_START ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ -c$$$ notdone=.true. -c$$$ n=0 -c$$$ do while (notdone) -c$$$ if (mod(n,2).eq.0) then -c$$$ i_pert=i_in -c$$$ else -c$$$ i_pert=j_in -c$$$ endif -c$$$ n=n+1 -c$$$ -c$$$ do i=1,3 -c$$$ org_dc(i)=dc(i,i_pert+nres) -c$$$ org_dc_norm(i)=dc_norm(i,i_pert+nres) -c$$$ org_c(i)=c(i,i_pert+nres) -c$$$ enddo -c$$$ ang_pert=ran_number(0.0D0,3.0D0) -c$$$ call perturb_side_chain(i_pert,ang_pert) -c$$$ call etotal_sc(energy_sc) -c$$$ exp_fact=exp(beta*(etot-energy_sc(0))) -c$$$ rand_fact=ran_number(0.0D0,1.0D0) -c$$$ if (rand_fact.lt.exp_fact) then -c$$$c write(iout,'(a,3d15.5)')" SS_MC_ACCEPT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ etot=energy_sc(0) -c$$$ else -c$$$c write(iout,'(a,3d15.5)')" SS_MC_REJECT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ do i=1,3 -c$$$ dc(i,i_pert+nres)=org_dc(i) -c$$$ dc_norm(i,i_pert+nres)=org_dc_norm(i) -c$$$ c(i,i_pert+nres)=org_c(i) -c$$$ enddo -c$$$ endif -c$$$ -c$$$ if (n.eq.10000.or.etot.lt.30.0D0) notdone=.false. -c$$$ enddo -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax2(etot,iretcode,nfun,i_in,j_in) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxres6*(maxres6+17)/2)) -c$$$********************************************************************* -c$$$* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for * -c$$$* the calling subprogram. * -c$$$* when d(i)=1.0, then v(35) is the length of the initial step, * -c$$$* calculated in the usual pythagorean way. * -c$$$* absolute convergence occurs when the function is within v(31) of * -c$$$* zero. unless you know the minimum value in advance, abs convg * -c$$$* is probably not useful. * -c$$$* relative convergence is when the model predicts that the function * -c$$$* will decrease by less than v(32)*abs(fun). * -c$$$********************************************************************* -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.CHAIN' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ double precision etot -c$$$ integer iretcode,nfun,i_in,j_in -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ external ss_func,fdum -c$$$ double precision ss_func,fdum -c$$$ -c$$$ integer iv(liv),uiparm(2) -c$$$ double precision v(lv),x(maxres6),d(maxres6),rdum -c$$$ integer i,j,k -c$$$ -c$$$ -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=2 -c$$$* selects output unit -c$$$c iv(21)=iout -c$$$ iv(21)=0 -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$ v(31)=1.0D-1 -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-4 -c$$$ v(32)=rtolf -c$$$ v(32)=1.0D-1 -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,6*nres -c$$$ d(i)=1.0D0 -c$$$ enddo -c$$$ -c$$$ do i=0,2*nres -c$$$ do j=1,3 -c$$$ orig_ss_dc(j,i)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ call geom_to_var(nvar,orig_ss_var) -c$$$ -c$$$ do i=1,nres -c$$$ do j=i,nres -c$$$ orig_ss_dist(j,i)=dist(j,i) -c$$$ orig_ss_dist(j+nres,i)=dist(j+nres,i) -c$$$ orig_ss_dist(j,i+nres)=dist(j,i+nres) -c$$$ orig_ss_dist(j+nres,i+nres)=dist(j+nres,i+nres) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i+nres) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ -c$$$ uiparm(1)=i_in -c$$$ uiparm(2)=j_in -c$$$ call smsno(k,d,x,ss_func,iv,liv,lv,v,uiparm,rdum,fdum) -c$$$ etot=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6)+iv(30) -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_func(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.SBRIDGE' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ integer n -c$$$ double precision x(maxres6) -c$$$ integer nf -c$$$ double precision f -c$$$ integer uiparm(2) -c$$$ real*8 urparm(1) -c$$$ external ufparm -c$$$ double precision ufparm -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ -c$$$ integer i,j,k,ss_i,ss_j -c$$$ double precision tempf,var(maxvar) -c$$$ -c$$$ -c$$$ ss_i=uiparm(1) -c$$$ ss_j=uiparm(2) -c$$$ f=0.0D0 -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ call geom_to_var(nvar,var) -c$$$ -c$$$c Constraints on all angles -c$$$ do i=1,nvar -c$$$ tempf=var(i)-orig_ss_var(i) -c$$$ f=f+tempf*tempf -c$$$ enddo -c$$$ -c$$$c Constraints on all distances -c$$$ do i=1,nres-1 -c$$$ if (i.gt.1) then -c$$$ tempf=dist(i+nres,i)-orig_ss_dist(i+nres,i) -c$$$ f=f+tempf*tempf -c$$$ endif -c$$$ do j=i+1,nres -c$$$ tempf=dist(j,i)-orig_ss_dist(j,i) -c$$$ if (tempf.lt.0.0D0 .or. j.eq.i+1) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i)-orig_ss_dist(j+nres,i) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j,i+nres)-orig_ss_dist(j,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i+nres)-orig_ss_dist(j+nres,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ enddo -c$$$ enddo -c$$$ -c$$$c Constraints for the relevant CYS-CYS -c$$$ tempf=dist(nres+ss_i,nres+ss_j)-8.0D0 -c$$$ f=f+tempf*tempf -c$$$CCCCCCCCCCCCCCCCC ADD SOME ANGULAR STUFF -c$$$ -c$$$c$$$ if (nf.ne.nfl) then -c$$$c$$$ write(iout,'(a,i10,2d15.5)')"IN DIST_FUNC (NF,F,DIST)",nf, -c$$$c$$$ + f,dist(5+nres,14+nres) -c$$$c$$$ endif -c$$$ -c$$$ nfl=nf -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$C----------------------------------------------------------------------------- - subroutine triple_ssbond_ene(resi,resj,resk,eij) - implicit real*8 (a-h,o-z) +#ifdef SSREAD +#ifdef WHAM + subroutine read_ssHist + implicit none + +c Includes + include 'DIMENSIONS' + include "DIMENSIONS.FREE" + include 'COMMON.FREE' + +c Local variables + integer i,j + character*80 controlcard + + do i=1,dyn_nssHist + call card_concat(controlcard,.true.) + read(controlcard,*) + & dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0)) + enddo + + return + end +#endif +#endif +c$$$C---------------------------------------------------------------------------- + subroutine triple_ssbond_ene(resi,resj,resk,eij) include 'DIMENSIONS' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' diff --git a/source/cluster/wham/src-HCD/wrtclust.f b/source/cluster/wham/src-HCD/wrtclust.f index fa08111..91fc05e 100644 --- a/source/cluster/wham/src-HCD/wrtclust.f +++ b/source/cluster/wham/src-HCD/wrtclust.f @@ -24,7 +24,7 @@ DATA EXTEN /'.pdb'/,extmol /'.mol2'/,NUMM /'000'/,MUMM /'000'/ external ilen logical viol_nmr - integer ib,list_peak_viol(maxdim) + integer ib,list_peak_viol(maxdim_cont) double precision Esaxs_all(maxgr),Pcalc_all(maxsaxs,maxgr) do i=1,64 diff --git a/source/unres/src-HCD-5D/COMMON.CHAIN b/source/unres/src-HCD-5D/COMMON.CHAIN index ec15fdc..da83764 100644 --- a/source/unres/src-HCD-5D/COMMON.CHAIN +++ b/source/unres/src-HCD-5D/COMMON.CHAIN @@ -1,9 +1,11 @@ integer nres,nsup,nstart_sup,nz_start,nz_end,iz_sc, & nres0,nstart_seq,nchain,chain_length,chain_border,iprzes, - & chain_border1,ireschain,tabpermchain,npermchain,afmend,afmbeg + & chain_border1,ireschain,tabpermchain,npermchain,afmend,afmbeg, + & nres_chomo,nmodel_start double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm,t,r, & prod,rt,dc_work,cref,crefjlee,dc_norm2,velAFMconst, & totTafm,chomo + character*256 pdbfiles_chomo(max_template) common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2), & xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2), & dc_norm2(3,0:maxres2), @@ -30,4 +32,6 @@ & totTafm common /tube/ tubecenter(3),tubeR0, & buftubebot, buftubetop,bordtubebot,bordtubetop,tubebufthick - common /chomo_models/ chomo(3,maxres2+2,max_template) + common /chomo_models/ chomo(3,maxres2+2,max_template), + & nres_chomo(max_template),nmodel_start + common /chomo_files/ pdbfiles_chomo diff --git a/source/unres/src-HCD-5D/COMMON.CONTMAT b/source/unres/src-HCD-5D/COMMON.CONTMAT index d65e291..8e7e4ff 100644 --- a/source/unres/src-HCD-5D/COMMON.CONTMAT +++ b/source/unres/src-HCD-5D/COMMON.CONTMAT @@ -19,8 +19,9 @@ C 12/26/95 - H-bonding contacts & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), & ees0m(maxconts,maxres),d_cont(maxconts,maxres), & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions + double precision a_chuj,a_chuj_der + common /dipmat/ a_chuj(2,2,maxconts,maxres), + & a_chuj_der(2,2,3,5,maxconts,maxres) c 7/25/08 Commented out; not needed when cumulants used C Interactions of pseudo-dipoles generated by loc-el interactions. c double precision dip,dipderg,dipderx diff --git a/source/unres/src-HCD-5D/COMMON.CORRMAT b/source/unres/src-HCD-5D/COMMON.CORRMAT index 5f154e0..ae25625 100644 --- a/source/unres/src-HCD-5D/COMMON.CORRMAT +++ b/source/unres/src-HCD-5D/COMMON.CORRMAT @@ -30,9 +30,6 @@ C consecutive amino-acid residues. & costab2(maxres),sintab2(maxres) C This common block contains dipole-interaction matrices and their C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, & AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont,EAEA,EAEAderg,EAEAderx, diff --git a/source/unres/src-HCD-5D/COMMON.HOMOLOGY b/source/unres/src-HCD-5D/COMMON.HOMOLOGY index f19f0c6..e9b6320 100644 --- a/source/unres/src-HCD-5D/COMMON.HOMOLOGY +++ b/source/unres/src-HCD-5D/COMMON.HOMOLOGY @@ -4,9 +4,10 @@ common /homol/ waga_homology(maxprocs/20), & waga_dist,waga_angle,waga_theta,waga_d,dist_cut,dist2_cut ! Restraint parameters - double precision odl(max_template,maxdim), - & sigma_odl(max_template,maxdim),dih(max_template,maxres), - & sigma_dih(max_template,maxres),sigma_odlir(max_template,maxdim) + double precision odl(max_template,maxdim_cont), + & sigma_odl(max_template,maxdim_cont),dih(max_template,maxres), + & sigma_dih(max_template,maxres), + & sigma_odlir(max_template,maxdim_cont) ! ! Specification of new variables used in subroutine e_modeller ! modified by FP (Nov.,2014) @@ -15,10 +16,10 @@ & thetatpl(max_template,maxres),sigma_theta(max_template,maxres), & sigma_d(max_template,maxres) ! - integer ires_homo(maxdim),jres_homo(maxdim), + integer ires_homo(maxdim_cont),jres_homo(maxdim_cont), & idomain(max_template,maxres),lim_odl,lim_dih,link_start_homo, & link_end_homo,idihconstr_start_homo,idihconstr_end_homo - logical l_homo(max_template,maxdim) + logical l_homo(max_template,maxdim_cont) ! common /homrestr/ odl,dih,sigma_dih,sigma_odl, & lim_odl,lim_dih,ires_homo,jres_homo,link_start_homo, diff --git a/source/unres/src-HCD-5D/COMMON.INTERACT b/source/unres/src-HCD-5D/COMMON.INTERACT index 8e4e063..8c4876d 100644 --- a/source/unres/src-HCD-5D/COMMON.INTERACT +++ b/source/unres/src-HCD-5D/COMMON.INTERACT @@ -22,10 +22,14 @@ & iatsc_s,iatsc_e,iatel_s,iatel_e,iatel_s_vdw,iatel_e_vdw, & iatscp_s,iatscp_e,ispp,iscp C 3/26/20 Interaction lists - integer newcontlisti(2000*maxres),newcontlistj(2000*maxres), - & newcontlistppi(2000*maxres),newcontlistppj(2000*maxres), - & newcontlistpp_vdwi(2000*maxres),newcontlistpp_vdwj(2000*maxres), - & newcontlistscpi(2000*maxres),newcontlistscpj(2000*maxres), + integer newcontlisti(maxint_res*maxres), + & newcontlistj(maxint_res*maxres), + & newcontlistppi(maxint_res*maxres), + & newcontlistppj(maxint_res*maxres), + & newcontlistpp_vdwi(maxint_res*maxres), + & newcontlistpp_vdwj(maxint_res*maxres), + & newcontlistscpi(2*maxint_res*maxres), + & newcontlistscpj(2*maxint_res*maxres), & g_listscsc_start,g_listscsc_end,g_listpp_start,g_listpp_end, & g_listpp_vdw_start,g_listpp_vdw_end,g_listscp_start,g_listscp_end common /interact_list/newcontlisti,newcontlistj,g_listscsc_start, diff --git a/source/unres/src-HCD-5D/COMMON.SBRIDGE b/source/unres/src-HCD-5D/COMMON.SBRIDGE index e5f9a33..a71e1de 100644 --- a/source/unres/src-HCD-5D/COMMON.SBRIDGE +++ b/source/unres/src-HCD-5D/COMMON.SBRIDGE @@ -1,21 +1,23 @@ double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss - integer ns,nss,nfree,iss + integer ns,nss,nfree,iss,icys common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, - & ns,nss,nfree,iss(maxss) + & ns,nss,nfree,iss(max_cyst),icys(maxres) double precision dhpb,dhpb1,forcon,fordepth,xlscore,wboltzd, & dhpb_peak,dhpb1_peak,forcon_peak,fordepth_peak,scal_peak,bfac integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb,ibecarb_peak,npeak, & ipeak, & irestr_type,irestr_type_peak,ihpb_peak,jhpb_peak,nhpb_peak logical restr_on_coord - common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), - & fordepth(maxdim),bfac(maxres),xlscore(maxdim),wboltzd, - & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),irestr_type(maxdim), - & nhpb,restr_on_coord - common /NMRpeaks/ dhpb_peak(maxdim),dhpb1_peak(maxdim), - & forcon_peak(maxdim),fordepth_peak(maxdim),scal_peak, - & ihpb_peak(maxdim),jhpb_peak(maxdim),ibecarb_peak(maxdim), - & irestr_type_peak(maxdim),ipeak(2,maxdim),npeak,nhpb_peak + common /links/ dhpb(maxdim_cont),dhpb1(maxdim_cont), + & forcon(maxdim_cont),fordepth(maxdim_cont),bfac(maxres), + & xlscore(maxdim_cont),wboltzd, + & ihpb(maxdim_cont),jhpb(maxdim_cont),ibecarb(maxdim_cont), + & irestr_type(maxdim_cont),nhpb,restr_on_coord + common /NMRpeaks/ dhpb_peak(maxdim_cont),dhpb1_peak(maxdim_cont), + & forcon_peak(maxdim_cont),fordepth_peak(maxdim_cont),scal_peak, + & ihpb_peak(maxdim_cont),jhpb_peak(maxdim_cont), + & ibecarb_peak(maxdim_cont),irestr_type_peak(maxdim_cont), + & ipeak(2,maxdim_cont),npeak,nhpb_peak double precision weidis common /restraints/ weidis integer link_start,link_end,link_start_peak,link_end_peak @@ -23,6 +25,6 @@ & link_end_peak double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss logical dyn_ss,dyn_ss_mask - common /dyn_ssbond/ dyn_ssbond_ij(maxres,maxres), + common /dyn_ssbond/ dyn_ssbond_ij(max_cyst,max_cyst), & Ht,dtriss,atriss,btriss,ctriss,dyn_ss,dyn_ss_mask(maxres), - & idssb(maxdim),jdssb(maxdim) + & idssb(maxss),jdssb(maxss) diff --git a/source/unres/src-HCD-5D/COMMON.SHIELD b/source/unres/src-HCD-5D/COMMON.SHIELD index aead071..eecd4c9 100644 --- a/source/unres/src-HCD-5D/COMMON.SHIELD +++ b/source/unres/src-HCD-5D/COMMON.SHIELD @@ -5,10 +5,11 @@ common /shield/ VSolvSphere,VSolvSphere_div,buff_shield, & long_r_sidechain(ntyp), & short_r_sidechain(ntyp),fac_shield(maxres),wshield, - & grad_shield_side(3,maxcont,-1:maxres),grad_shield(3,-1:maxres), - & grad_shield_loc(3,maxcont,-1:maxres), - & ishield_list(maxres),shield_list(maxcont,maxres), - & ees0plist(maxcont,maxres) + & grad_shield_side(3,maxint_res,-1:maxres), + & grad_shield(3,-1:maxres), + & grad_shield_loc(3,maxint_res,-1:maxres), + & ishield_list(maxres),shield_list(maxint_res,maxres), + & ees0plist(maxint_res,maxres) diff --git a/source/unres/src-HCD-5D/DIMENSIONS b/source/unres/src-HCD-5D/DIMENSIONS index 599bfa2..137b45d 100644 --- a/source/unres/src-HCD-5D/DIMENSIONS +++ b/source/unres/src-HCD-5D/DIMENSIONS @@ -16,14 +16,16 @@ C Max. number of coarse-grain processors parameter (max_cg_procs=maxprocs) C Max. number of AA residues integer maxres - parameter (maxres=5000) + parameter (maxres=10000) C Max. number of AA residues per chain integer maxres_chain parameter (maxres_chain=1200) +C Max. number of cysteines and other bridging residues + integer max_cyst + parameter (max_cyst=100) C Appr. max. number of interaction sites - integer maxres2,maxres6,maxres2_chain,mmaxres2,mmaxres2_chain + integer maxres2,maxres6,maxres2_chain,mmaxres2_chain parameter (maxres2=2*maxres,maxres6=6*maxres) - parameter (mmaxres2=(maxres2*(maxres2+1)/2)) parameter (maxres2_chain=2*maxres_chain, & mmaxres2_chain=maxres2_chain*(maxres2_chain+1)/2) C Max number of symetric chains @@ -49,6 +51,16 @@ C Max. number of contacts per residue integer maxconts parameter (maxconts=maxres) c parameter (maxconts=50) +C Max. number of interactions within cutoff per residue + integer maxint_res + parameter (maxint_res=200) +C Max. number od residues within distance cufoff from a given residue to +C include in template-based/contact distance restraints. + integer maxcont_res + parameter (maxcont_res=200) +C Max. number of distance/contact-distance restraints + integer maxdim_cont + parameter (maxdim_cont=maxres*maxcont_res) C Number of AA types (at present only natural AA's will be handled integer ntyp,ntyp1 parameter (ntyp=24,ntyp1=ntyp+1) @@ -74,9 +86,10 @@ c Max number of torsional terms in SCCOR C Max. number of lobes in SC distribution integer maxlob parameter (maxlob=4) -C Max. number of S-S bridges +C Max. number of S-S bridges and other links integer maxss - parameter (maxss=20) +c parameter (maxss=20) + parameter (maxss=max_cyst*(max_cyst-1)/2) C Max. number of dihedral angle constraints integer maxdih_constr parameter (maxdih_constr=maxres) diff --git a/source/unres/src-HCD-5D/MD_A-MTS.F b/source/unres/src-HCD-5D/MD_A-MTS.F index d82cf17..fcef69e 100644 --- a/source/unres/src-HCD-5D/MD_A-MTS.F +++ b/source/unres/src-HCD-5D/MD_A-MTS.F @@ -264,10 +264,10 @@ C call check_ecartint if (rstcount.eq.1000.or.itime.eq.n_timestep) then open(irest2,file=rest2name,status='unknown') write(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres + do i=0,2*nres-1 write (irest2,'(3e15.5)') (d_t(j,i),j=1,3) enddo - do i=1,2*nres + do i=0,2*nres-1 write (irest2,'(3e15.5)') (dc(j,i),j=1,3) enddo close(irest2) @@ -1671,6 +1671,7 @@ c Set up the initial conditions of a MD simulation integer iran_num double precision etot logical fail + integer i_start_models(0:nodes-1) write (iout,*) "init_MD INDPDB",indpdb d_time0=d_time c write(iout,*) "d_time", d_time @@ -1758,10 +1759,10 @@ c statname=statname(:ilen(statname)-5)//qstr(:ipos-1)//'.stat' if (me.eq.king) & inquire(file=mremd_rst_name,exist=file_exist) #ifdef MPI - write (*,*) me," Before broadcast: file_exist",file_exist +c write (*,*) me," Before broadcast: file_exist",file_exist call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM, & IERR) - write (*,*) me," After broadcast: file_exist",file_exist +c write (*,*) me," After broadcast: file_exist",file_exist c inquire(file=mremd_rst_name,exist=file_exist) #endif if(me.eq.king.or..not.out1file) @@ -1839,7 +1840,18 @@ c Removing the velocity of the center of mass call flush(iout) endif endif - write (iout,*) "init_MD before initial structure REST ",rest +c write (iout,*) "init_MD before initial structure REST ",rest + if(start_from_model .and. (me.eq.king .or. .not. out1file)) + & write(iout,*) 'START_FROM_MODELS is ON' + if(start_from_model .and. rest) then + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then + write(iout,*) + & 'START_FROM_MODELS is OFF because the run is restarted' + write(iout,*) 'Remove restart keyword from input' + endif + endif +c write (iout,*) "rest ",rest," start_from_model",start_from_model, +c & " nmodel_start",nmodel_start," preminim",preminim if (.not.rest) then 122 continue if (iranconf.ne.0) then @@ -1920,9 +1932,12 @@ c 8/22/17 AL Loop to produce a low-energy random conformation else if (preminim) then if (start_from_model) then n_model_try=0 - do while (fail .and. n_model_try.lt.constr_homology) + fail=.true. + list_model_try=0 + do while (fail .and. n_model_try.lt.nmodel_start) + write (iout,*) "n_model_try",n_model_try do - i_model=iran_num(1,constr_homology) + i_model=iran_num(1,nmodel_start) do k=1,n_model_try if (i_model.eq.list_model_try(k)) exit enddo @@ -1930,7 +1945,9 @@ c 8/22/17 AL Loop to produce a low-energy random conformation enddo n_model_try=n_model_try+1 list_model_try(n_model_try)=i_model - write (iout,*) 'starting from model ',i_model + if (me.eq.king .or. .not. out1file) + & write (iout,*) 'Trying to start from model ', + & pdbfiles_chomo(i_model)(:ilen(pdbfiles_chomo(i_model))) do i=1,2*nres do j=1,3 c(j,i)=chomo(j,i,i_model) @@ -1981,10 +1998,14 @@ c 8/22/17 AL Loop to produce a low-energy random conformation call etotal(energia(0)) #endif enddo - if (n_model_try.gt.constr_homology) then + call MPI_Gather(i_model,1,MPI_INTEGER,i_start_models(0), + & 1,MPI_INTEGER,king,CG_COMM,IERROR) + if (n_model_try.gt.nmodel_start .and. + & (me.eq.king .or. out1file)) then write (iout,*) & "All models have irreparable overlaps. Trying randoms starts." iranconf=1 + i_model=nmodel_start+1 goto 122 endif else @@ -2027,6 +2048,17 @@ C 8/22/17 AL Minimize initial structure #endif endif endif + if (nmodel_start.gt.0 .and. me.eq.king) then + write (iout,'(a)') "Task Starting model" + do i=0,nodes-1 + if (i_start_models(i).gt.nmodel_start) then + write (iout,'(i4,2x,a)') i,"RANDOM STRUCTURE" + else + write(iout,'(i4,2x,a)')i,pdbfiles_chomo(i_start_models(i)) + & (:ilen(pdbfiles_chomo(i_start_models(i)))) + endif + enddo + endif endif ! .not. rest call chainbuild_cart call kinetic(EK) @@ -2034,6 +2066,7 @@ C 8/22/17 AL Minimize initial structure call verlet_bath endif kinetic_T=2.0d0/(dimen3*Rb)*EK + write (iout,*) "Initial kinetic energy",EK," kinetic T",kinetic_T if(me.eq.king.or..not.out1file)then call cartprint call intout diff --git a/source/unres/src-HCD-5D/MP.F b/source/unres/src-HCD-5D/MP.F index debe2b1..d0b13b1 100644 --- a/source/unres/src-HCD-5D/MP.F +++ b/source/unres/src-HCD-5D/MP.F @@ -36,11 +36,11 @@ c determine # of nodes and current node MyRank=me C Determine the number of "fine-grain" tasks call getenv_loc("FGPROCS",cfgprocs) - print *,cfgprocs +c print *,cfgprocs read (cfgprocs,'(i3)') nfgtasks if (nfgtasks.eq.0) nfgtasks=1 call getenv_loc("MAXGSPROCS",cfgprocs) - print *,cfgprocs +c print *,cfgprocs read (cfgprocs,'(i3)') max_gs_size if (max_gs_size.eq.0) max_gs_size=2 if (lprn) diff --git a/source/unres/src-HCD-5D/MREMD.F b/source/unres/src-HCD-5D/MREMD.F index 9191402..f22e2f6 100644 --- a/source/unres/src-HCD-5D/MREMD.F +++ b/source/unres/src-HCD-5D/MREMD.F @@ -57,7 +57,7 @@ cold integer nup(0:maxprocs),ndown(0:maxprocs) integer rep2i(0:maxprocs),ireqi(maxprocs) integer icache_all(maxprocs) integer status(MPI_STATUS_SIZE),statusi(MPI_STATUS_SIZE,maxprocs) - logical synflag,end_of_run,file_exist /.false./,ovrtim + logical synflag,end_of_run,file_exist /.false./,ovrtim,first_pass double precision t_bath_temp,delta,ene_iex_iex,ene_i_i,ene_iex_i, & ene_i_iex,xxx,tmp,econstr_temp_iex,econstr_temp_i integer iran_num @@ -145,8 +145,8 @@ cold endif cd print '(i4,a6,100i4)',me,' ndown',(ndown(i),i=0,ndown(0)) - write (*,*) "Processor",me," rest",rest," - & restart1fie",restart1file +c write (*,*) "Processor",me," rest",rest," +c & restart1fie",restart1file if(rest.and.restart1file) then if (me.eq.king) & inquire(file=mremd_rst_name,exist=file_exist) @@ -424,6 +424,8 @@ c Entering the MD loop #endif itime=0 end_of_run=.false. + first_pass=.not.rest +c write (iout,*) "first_pass",first_pass do while(.not.end_of_run) itime=itime+1 if(itime.eq.n_timestep.and.me.eq.king) end_of_run=.true. @@ -942,7 +944,10 @@ c write (iout,*) "ene_i_i",remd_ene(0,i) c call flush(iout) c write (iout,*) "rescaling weights with temperature", c & remd_t_bath(iex) - if (real(ene_i_i).ne.real(remd_ene(0,i))) then +c write (iout,*) "first_pass",first_pass + if (.not.first_pass.and. + & real(ene_i_i).ne.real(remd_ene(0,i))) + & then write (iout,*) "ERROR: inconsistent energies:",i, & ene_i_i,remd_ene(0,i) endif @@ -960,7 +965,8 @@ c write (iout,*) "0,iex",remd_t_bath(iex) c call enerprint(remd_ene(0,iex)) call sum_energy(remd_ene(0,iex),.false.) - if (real(ene_iex_iex).ne.real(remd_ene(0,iex))) then + if (.not.first_pass.and. + & real(ene_iex_iex).ne.real(remd_ene(0,iex))) then write (iout,*) "ERROR: inconsistent energies:",iex, & ene_iex_iex,remd_ene(0,iex) endif @@ -1065,6 +1071,7 @@ c call flush(iout) endif enddo enddo + first_pass=.false. cd write (iout,*) "exchange completed" cd call flush(iout) ELSE @@ -1383,7 +1390,7 @@ c----------------------------------------------------------------------- include 'COMMON.SBRIDGE' include 'COMMON.INTERACT' - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), + real d_restart1(3,2*maxres*maxprocs),r_d(3,0:2*maxres-1), & d_restart2(3,2*maxres*maxprocs) real t5_restart1(5) integer iret,itmp @@ -1403,7 +1410,7 @@ c----------------------------------------------------------------------- & t_restart1,5,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres + do i=0,2*nres-1 do j=1,3 r_d(j,i)=d_t(j,i) enddo @@ -1413,7 +1420,7 @@ c----------------------------------------------------------------------- & CG_COMM,ierr) - do i=1,2*nres + do i=0,2*nres-1 do j=1,3 r_d(j,i)=dc(j,i) enddo @@ -1794,14 +1801,14 @@ c end debugging include 'COMMON.CHAIN' include 'COMMON.SBRIDGE' include 'COMMON.INTERACT' - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), + real d_restart1(3,2*maxres*maxprocs),r_d(3,0:2*maxres-1), & t5_restart1(5) integer*2 i_index & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) common /przechowalnia/ d_restart1 integer i,j,il,il1,ixdrf,iret,itmp integer ierr - write (*,*) "Processor",me," called read1restart" +c write (*,*) "Processor",me," called read1restart" if(me.eq.king)then open(irest2,file=mremd_rst_name,status='unknown') @@ -1888,7 +1895,7 @@ c & (d_restart1(j,i+2*nres*il),j=1,3) call mpi_scatter(d_restart1,3*2*nres,mpi_real, & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres + do i=0,2*nres-1 do j=1,3 d_t(j,i)=r_d(j,i) enddo @@ -1910,7 +1917,7 @@ c & (d_restart1(j,i+2*nres*il),j=1,3) endif call mpi_scatter(d_restart1,3*2*nres,mpi_real, & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres + do i=0,2*nres-1 do j=1,3 dc(j,i)=r_d(j,i) enddo @@ -1991,7 +1998,7 @@ c & CG_COMM,ierr) include 'COMMON.CHAIN' include 'COMMON.SBRIDGE' include 'COMMON.INTERACT' - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), + real d_restart1(3,2*maxres*maxprocs),r_d(3,0:2*maxres-1), & t5_restart1(5) common /przechowalnia/ d_restart1 integer i,j,il,itmp @@ -2027,7 +2034,7 @@ c & CG_COMM,ierr) call mpi_scatter(d_restart1,3*2*nres,mpi_real, & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres + do i=0,2*nres-1 do j=1,3 d_t(j,i)=r_d(j,i) enddo @@ -2042,7 +2049,7 @@ c & CG_COMM,ierr) endif call mpi_scatter(d_restart1,3*2*nres,mpi_real, & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres + do i=0,2*nres-1 do j=1,3 dc(j,i)=r_d(j,i) enddo diff --git a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton new file mode 100644 index 0000000..11b83dd --- /dev/null +++ b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton @@ -0,0 +1,200 @@ +################################################################### +#INSTALL_DIR = /opt/cray/mpt/7.3.2/gni/mpich-intel/15.0 + +FC = mpif90 -fc=ifort + +OPT = -O3 -ip -mcmodel=medium -shared-intel +#OPT = -g -CA -CB -mcmodel=medium -shared-intel + +FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include +FFLAGS1 = -c -g -CA -CB -mcmodel=medium -shared-intel +#FFLAGS1 = ${FFLAGS} +FFLAGS2 = -c -g -O0 -mcmodel=medium -shared-intel +#FFLAGSE = -c -O3 -ipo -mcmodel=medium -shared-intel +FFLAGSE = ${FFLAGS} + + +#LIBS = -L$(INSTALL_DIR)/lib -lmpi xdrf/libxdrf.a +LIBS = -lmpi xdrf/libxdrf.a +#/opt/cray/mpt/7.3.2/gni/mpich-intel/15.0/lib/libmpich.a + +ARCH = LINUX +PP = /lib/cpp -P + +all: no_option + @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR" + +.SUFFIXES: .F +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + + +object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ + matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ + pinorm.o randgens.o rescode.o intcor.o timing.o misc.o \ + cart2intgrad.o checkder_p.o contact_cp econstr_local.o econstr_qlike.o \ + econstrq-PMF.o PMFprocess.o energy_p_new_barrier.o make_xx_list.o \ + energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ + cored.o rmdd.o geomout.o readpdb-mult.o int_from_cart.o regularize.o \ + thread.o fitsq.o mcm.o \ + mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o \ + eigen.o blas.o add.o entmcm.o minim_mcmf.o \ + together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ + indexx.o MP.o compare_s1.o prng_32.o \ + banach.o rmsd.o rmscalc.o elecont.o dihed_cons.o \ + sc_move.o local_move.o djacob.o \ + intcartderiv.o lagrangian_lesyng.o\ + chain_symmetry.o permut.o seq2chains.o iperm.o\ + stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ + surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ + q_measure.o gnmr1.o mygauss.o ssMD.o + +object_lbfgs = inform.o iounit.o keys.o linmin.o math.o minima.o scales.o output.o lbfgs.o search.o optsave_dum.o + +no_option: + +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY +GAB: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD.exe +GAB: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY +4P: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD.exe +4P: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DFOURBODY +E0LL2Y: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD.exe +E0LL2Y: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DFOURBODY -DDFA +E0LL2Y_DFA: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD-DFA.exe +E0LL2Y_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD #-DFOURBODY #-DMYGAUSS #-DTIMING +NEWCORR: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD.exe +NEWCORR: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DFIVEDIAG -DLBFGS #-DMYGAUSS #-DTIMING +NEWCORR5D: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD5.exe +NEWCORR5D: ${object_lbfgs} ${object} fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} ${object_lbfgs} fdisy.o fdiag.o machpd.o kinetic_CASC.o cinfo.o ${LIBS} -o ${BIN} +#${FC} ${OPT} ${object} ${object_lbfgs} fdisy.o fdiag.o machpd.o kinetic_CASC.o cinfo.o ${LIBS} -Wl,-M -o ${BIN} + +NEWCORR_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DDFA #-DMYGAUSS #-DTIMING +NEWCORR_DFA: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD-DFA.exe +NEWCORR_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DFIVEDIAG -DLBFGS -DDFA #-DMYGAUSS #-DTIMING +NEWCORR5D_DFA: BIN = ~/bin/unres_ifort_MPICH-tryton-HCD5-DFA.exe +NEWCORR5D_DFA: ${object_lbfgs} ${object} dfa.o fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object_lbfgs} ${object} fdisy.o fdiag.o machpd.o dfa.o kinetic_CASC.o cinfo.o ${LIBS} -o ${BIN} + +xdrf/libxdrf.a: + cd xdrf && make + + +clean: + /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean + +test.o: test.F + ${FC} ${FFLAGS} ${CPPFLAGS} test.F + +chainbuild.o: chainbuild.F + ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F + +djacob.o: djacob.f + ${FC} ${FFLAGS2} djacob.f + +matmult.o: matmult.f + ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f + +parmread.o : parmread.F + ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F + +intcor.o : intcor.f + ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f + +cartder.o : cartder.F + ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F + +readpdb.o : readpdb.F + ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F + +readpdb-mult.o : readpdb-mult.F + ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb-mult.F + +sumsld.o : sumsld.f + ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f + +cored.o : cored.f + ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f + +rmdd.o : rmdd.f + ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f + +energy_p_new_barrier.o : energy_p_new_barrier.F + ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F + +gradient_p.o : gradient_p.F + ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F + +energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F + ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F + +lagrangian_lesyng.o : lagrangian_lesyng.F + ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F + +MD_A-MTS.o : MD_A-MTS.F + ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F + +blas.o : blas.f + ${FC} ${FFLAGS1} blas.f + +add.o : add.f + ${FC} ${FFLAGS1} add.f + +eigen.o : eigen.f + ${FC} ${FFLAGS2} eigen.f + +dfa.o: dfa.F + ${FC} ${FFLAGS2} dfa.F + +proc_proc.o: proc_proc.c + ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src-HCD-5D/contact_cp2.F b/source/unres/src-HCD-5D/contact_cp2.F new file mode 100644 index 0000000..785c8cb --- /dev/null +++ b/source/unres/src-HCD-5D/contact_cp2.F @@ -0,0 +1,148 @@ + subroutine contact_cp2(var,var2,iff,ieval,in_pdb) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' +#ifdef MPI + include 'mpif.h' +#endif + include 'COMMON.SBRIDGE' + include 'COMMON.FFIELD' + include 'COMMON.IOUNITS' + include 'COMMON.DISTFIT' + include 'COMMON.VAR' + include 'COMMON.CHAIN' + include 'COMMON.MINIM' + + character*50 linia + integer nf,ij(4) + double precision var(maxvar),var2(maxvar) + double precision time0,time1 + integer iff(maxres),ieval + double precision theta1(maxres),phi1(maxres),alph1(maxres), + & omeg1(maxres) + + + call var_to_geom(nvar,var) + call chainbuild + nhpb0=nhpb + ind=0 + do i=1,nres-3 + do j=i+3,nres + ind=ind+1 + if ( iff(i).eq.1.and.iff(j).eq.1 ) then + d0(ind)=DIST(i,j) + w(ind)=10.0 + nhpb=nhpb+1 + ihpb(nhpb)=i + jhpb(nhpb)=j + forcon(nhpb)=10.0 + dhpb(nhpb)=d0(ind) + else + w(ind)=0.0 + endif + enddo + enddo + call hpb_partition + + do i=1,nres + theta1(i)=theta(i) + phi1(i)=phi(i) + alph1(i)=alph(i) + omeg1(i)=omeg(i) + enddo + + call var_to_geom(nvar,var2) + + do i=1,nres + if ( iff(i).eq.1 ) then + theta(i)=theta1(i) + phi(i)=phi1(i) + alph(i)=alph1(i) + omeg(i)=omeg1(i) + endif + enddo + + call chainbuild +cd call write_pdb(3,'combined structure',0d0) +cd time0=MPI_WTIME() + + NX=NRES-3 + NY=((NRES-4)*(NRES-5))/2 + call distfit(.true.,200) + +cd time1=MPI_WTIME() +cd write (iout,'(a,f6.2,a)') ' Time for distfit ',time1-time0,' sec' + + ipot0=ipot + maxmin0=maxmin + maxfun0=maxfun + wstrain0=wstrain + + ipot=6 + maxmin=2000 + maxfun=5000 + call geom_to_var(nvar,var) +cd time0=MPI_WTIME() + call minimize(etot,var,iretcode,nfun) + write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun + +cd time1=MPI_WTIME() +cd write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0, +cd & nfun/(time1-time0),' SOFT eval/s' + call var_to_geom(nvar,var) + call chainbuild + + + iwsk=0 + nf=0 + if (iff(1).eq.1) then + iwsk=1 + nf=nf+1 + ij(nf)=0 + endif + do i=2,nres + if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then + iwsk=1 + nf=nf+1 + ij(nf)=i + endif + if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then + iwsk=0 + nf=nf+1 + ij(nf)=i-1 + endif + enddo + if (iff(nres).eq.1) then + nf=nf+1 + ij(nf)=nres + endif + + +cd write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)') +cd & "select",ij(1),"-",ij(2), +cd & ",",ij(3),"-",ij(4) +cd call write_pdb(in_pdb,linia,etot) + + + ipot=ipot0 + maxmin=maxmin0 + maxfun=maxfun0 +cd time0=MPI_WTIME() + call minimize(etot,var,iretcode,nfun) +cd write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun + ieval=nfun + +cd time1=MPI_WTIME() +cd write (iout,'(a,f6.2,f8.2,a)')' Time for DIST min.',time1-time0, +cd & nfun/(time1-time0),' eval/s' +cd call var_to_geom(nvar,var) +cd call chainbuild +cd call write_pdb(6,'dist structure',etot) + + + nhpb= nhpb0 + link_start=1 + link_end=nhpb + wstrain=wstrain0 + + return + end diff --git a/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F b/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F index 96f7777..28ba1d1 100644 --- a/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F @@ -639,7 +639,6 @@ c double precision rrsave(maxdim) logical lprn evdw=0.0D0 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 c if (icall.eq.0) then c lprn=.true. c else @@ -1100,7 +1099,6 @@ C double precision sss1,sssgrad1 evdw=0.0D0 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 lprn=.false. c if (icall.eq.0) lprn=.true. ind=0 @@ -1254,7 +1252,6 @@ C double precision boxshift evdw=0.0D0 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 lprn=.false. c if (icall.eq.0) lprn=.true. ind=0 diff --git a/source/unres/src-HCD-5D/energy_p_new_barrier.F b/source/unres/src-HCD-5D/energy_p_new_barrier.F index 190574e..3f5429d 100644 --- a/source/unres/src-HCD-5D/energy_p_new_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new_barrier.F @@ -118,9 +118,17 @@ c call chainbuild_cart c write (iout,*) "itime_mat",itime_mat," imatupdate",imatupdate if (mod(itime_mat,imatupdate).eq.0) then call make_SCp_inter_list +c write (iout,*) "Finished make_SCp_inter_list" +c call flush(iout) call make_SCSC_inter_list +c write (iout,*) "Finished make_SCSC_inter_list" +c call flush(iout) call make_pp_inter_list +c write (iout,*) "Finished make_pp_inter_list" +c call flush(iout) call make_pp_vdw_inter_list +c write (iout,*) "Finished make_pp_vdw_inter_list" +c call flush(iout) endif c print *,'Processor',myrank,' calling etotal ipot=',ipot c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct @@ -366,7 +374,17 @@ c call flush(iout) c write (iout,*) "MULTIBODY_HB ecorr",ecorr,ecorr5,ecorr6,n_corr, c & n_corr1 c call flush(iout) + else + ecorr=0.0d0 + ecorr5=0.0d0 + ecorr6=0.0d0 + eturn6=0.0d0 endif +#else + ecorr=0.0d0 + ecorr5=0.0d0 + ecorr6=0.0d0 + eturn6=0.0d0 #endif c print *,"Processor",myrank," computed Ucorr" c write (iout,*) "nsaxs",nsaxs," saxs_mode",saxs_mode @@ -409,15 +427,17 @@ C print *,"za lipidami" call AFMforce(Eafmforce) else if (selfguide.gt.0) then call AFMvel(Eafmforce) + else + Eafmforce=0.0d0 endif if (TUBElog.eq.1) then C print *,"just before call" call calctube(Etube) - elseif (TUBElog.eq.2) then + elseif (TUBElog.eq.2) then call calctube2(Etube) - else - Etube=0.0d0 - endif + else + Etube=0.0d0 + endif #ifdef TIMING time_enecalc=time_enecalc+MPI_Wtime()-time00 diff --git a/source/unres/src-HCD-5D/energy_split-sep.F b/source/unres/src-HCD-5D/energy_split-sep.F index f16bc1b..11ea406 100644 --- a/source/unres/src-HCD-5D/energy_split-sep.F +++ b/source/unres/src-HCD-5D/energy_split-sep.F @@ -44,6 +44,13 @@ c if (fg_rank.eq.0) call int_from_cart1(.false.) #endif endif #ifdef MPI + edfadis=0.0d0 + edfator=0.0d0 + edfanei=0.0d0 + edfabet=0.0d0 + ehomology_constr=0.0d0 + Uconst=0.0d0 + Uconst_back=0.0d0 c write(iout,*) "ETOTAL_LONG Processor",fg_rank, c & " absolute rank",myrank," nfgtasks",nfgtasks c call flush(iout) @@ -137,7 +144,6 @@ c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct call make_pp_vdw_inter_list endif #endif - cd print *,'nnt=',nnt,' nct=',nct C C Compute the side-chain and electrostatic interaction energy @@ -231,7 +237,17 @@ c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 endif if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) + else + ecorr=0.0d0 + ecorr5=0.0d0 + ecorr6=0.0d0 + eturn6=0.0d0 endif +#else + ecorr=0.0d0 + ecorr5=0.0d0 + ecorr6=0.0d0 + eturn6=0.0d0 #endif C C If performing constraint dynamics, call the constraint energy @@ -340,6 +356,18 @@ c call flush(iout) edfanei=0.0d0 edfabet=0.0d0 #endif + evdw=0.0d0 + ees=0.0d0 + evdw1=0.0d0 + eel_loc=0.0d0 + eello_turn3=0.0d0 + eello_turn4=0.0d0 + evdw2=0 + evdw2_14=0 + ecorr=0.0d0 + ecorr5=0.0d0 + ecorr6=0.0d0 + eturn6=0.0d0 c write(iout,*) "ETOTAL_SHORT Processor",fg_rank, c & " absolute rank",myrank," nfgtasks",nfgtasks c call flush(iout) @@ -526,6 +554,21 @@ c Lipid transfer else eliptran=0.0d0 endif + if (AFMlog.gt.0) then + call AFMforce(Eafmforce) + else if (selfguide.gt.0) then + call AFMvel(Eafmforce) + else + Eafmforce=0.0d0 + endif + if (TUBElog.eq.1) then +C print *,"just before call" + call calctube(Etube) + elseif (TUBElog.eq.2) then + call calctube2(Etube) + else + Etube=0.0d0 + endif if (ndih_constr.gt.0) call etor_constr(edihcnstr) c print *,"Processor",myrank," computed Utor" diff --git a/source/unres/src-HCD-5D/gen_rand_conf.F b/source/unres/src-HCD-5D/gen_rand_conf.F index b5e5595..9f5567d 100644 --- a/source/unres/src-HCD-5D/gen_rand_conf.F +++ b/source/unres/src-HCD-5D/gen_rand_conf.F @@ -281,7 +281,7 @@ c------------------------------------------------------------------------- double precision eig_limit /1.0D-8/ double precision Big /10.0D0/ double precision vec(3,3) - logical lprint,fail,lcheck + logical lprint,fail,lcheck,lprn /.false./ lcheck=.false. lprint=.false. fail=.false. @@ -514,10 +514,12 @@ C endif if (box(1,2).lt.-MaxBoxLen .or. box(2,2).gt.MaxBoxLen) then #ifdef MPI + if (lprn) then write (iout,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.' write (*,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.' + endif #else -c write (iout,'(a)') 'Bad sampling box.' + if (lprn) write (iout,'(a)') 'Bad sampling box.' #endif fail=.true. return diff --git a/source/unres/src-HCD-5D/initialize_p.F b/source/unres/src-HCD-5D/initialize_p.F index 855c7a4..710f907 100644 --- a/source/unres/src-HCD-5D/initialize_p.F +++ b/source/unres/src-HCD-5D/initialize_p.F @@ -261,10 +261,10 @@ C Initialize the bridge arrays ns=0 nss=0 nhpb=0 - do i=1,maxss + do i=1,max_cyst iss(i)=0 enddo - do i=1,maxdim + do i=1,maxdim_cont dhpb(i)=0.0D0 enddo do i=1,maxres diff --git a/source/unres/src-HCD-5D/make_xx_list.F b/source/unres/src-HCD-5D/make_xx_list.F index a69ee13..480aeb2 100644 --- a/source/unres/src-HCD-5D/make_xx_list.F +++ b/source/unres/src-HCD-5D/make_xx_list.F @@ -5,6 +5,7 @@ include 'mpif.h' include "COMMON.SETUP" #endif + include "COMMON.CONTROL" include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.SPLITELE" @@ -12,14 +13,15 @@ double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe, & xj_temp,yj_temp,zj_temp double precision dist_init, dist_temp,r_buff_list - integer contlisti(2000*maxres),contlistj(2000*maxres) + integer contlisti(maxint_res*maxres),contlistj(maxint_res*maxres) ! integer :: newcontlisti(200*nres),newcontlistj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, & ilist_sc,g_ilist_sc integer displ(0:max_fg_procs),i_ilist_sc(0:max_fg_procs),ierr + logical lprn /.false./ ! print *,"START make_SC" #ifdef DEBUG - write (iout,*) "make_SCSC_inter_list" + write (iout,*) "make_SCSC_inter_list maxint_res",maxint_res #endif r_buff_list=5.0d0 ilist_sc=0 @@ -80,7 +82,7 @@ zj=zj_safe-zi endif ! r_buff_list is a read value for a buffer - if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then + if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then ! Here the list is created ilist_sc=ilist_sc+1 ! this can be substituted by cantor and anti-cantor @@ -106,9 +108,25 @@ call MPI_Reduce(ilist_sc,g_ilist_sc,1, & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +c write (iout,*) "SCSC after reduce ierr",ierr + if (fg_rank.eq.0.and.g_ilist_sc.gt.maxres*maxint_res) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many SCSC interactions", + & g_ilist_sc," only",maxres*maxint_res," allowed." + write (iout,*) "Reduce r_cut_int and resubmit" + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many SCSC interactions", + & g_ilist_sc," only",maxres*maxint_res," allowed." + write (iout,*) "Reduce r_cut_int and resubmit" + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif c write(iout,*) "before bcast",g_ilist_sc call MPI_Gather(ilist_sc,1,MPI_INTEGER, & i_ilist_sc,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "SCSC after gather ierr",ierr displ(0)=0 do i=1,nfgtasks-1,1 displ(i)=i_ilist_sc(i-1)+displ(i-1) @@ -117,16 +135,20 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER, & newcontlisti,i_ilist_sc,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "SCSC after gatherv ierr",ierr call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER, & newcontlistj,i_ilist_sc,displ,MPI_INTEGER, & king,FG_COMM,IERR) call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr ! write(iout,*) "before bcast",g_ilist_sc ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "SCSC after bcast ierr",ierr ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) else @@ -140,8 +162,11 @@ c write(iout,*) "before bcast",g_ilist_sc #ifdef MPI endif #endif + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + & write (iout,'(a30,i10,a,i4)') "Number of SC-SC interactions", + & g_ilist_sc," per residue on average",g_ilist_sc/nres #ifdef DEBUG - write (iout,*) "after GATHERV",g_ilist_sc + write (iout,*) "make_SCSC_inter_list: after GATHERV",g_ilist_sc do i=1,g_ilist_sc write (iout,*) i,newcontlisti(i),newcontlistj(i) enddo @@ -157,6 +182,7 @@ c write(iout,*) "before bcast",g_ilist_sc include 'mpif.h' include "COMMON.SETUP" #endif + include "COMMON.CONTROL" include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.SPLITELE" @@ -164,16 +190,18 @@ c write(iout,*) "before bcast",g_ilist_sc double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe, & xj_temp,yj_temp,zj_temp double precision dist_init, dist_temp,r_buff_list - integer contlistscpi(2000*maxres),contlistscpj(2000*maxres) + integer contlistscpi(2*maxint_res*maxres), + & contlistscpj(2*maxint_res*maxres) ! integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, & ilist_scp,g_ilist_scp integer displ(0:max_fg_procs),i_ilist_scp(0:max_fg_procs),ierr - integer contlistscpi_f(2000*maxres),contlistscpj_f(2000*maxres) +c integer contlistscpi_f(2*maxint_res*maxres), +c & contlistscpj_f(2*maxint_res*maxres) integer ilist_scp_first,ifirstrun,g_ilist_sc ! print *,"START make_SC" #ifdef DEBUG - write (iout,*) "make_SCp_inter_list" + write (iout,*) "make_SCp_inter_list maxint_res",maxint_res #endif r_buff_list=5.0 ilist_scp=0 @@ -245,7 +273,7 @@ c write(iout,*) "before bcast",g_ilist_sc endif #ifdef DEBUG ! r_buff_list is a read value for a buffer - if ((sqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0)) + if((dsqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0)) & then ! Here the list is created ilist_scp_first=ilist_scp_first+1 @@ -255,7 +283,7 @@ c write(iout,*) "before bcast",g_ilist_sc endif #endif ! r_buff_list is a read value for a buffer - if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then + if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then ! Here the list is created ilist_scp=ilist_scp+1 ! this can be substituted by cantor and anti-cantor @@ -276,9 +304,23 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Reduce(ilist_scp,g_ilist_scp,1, & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +c write (iout,*) "SCp after reduce ierr",ierr + if (fg_rank.eq.0.and.g_ilist_scp.gt.2*maxres*maxint_res) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many SCp interactions", + & g_ilist_scp," only",2*maxres*maxint_res," allowed." + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many SCp interactions", + & g_ilist_scp," only",2*maxres*maxint_res," allowed." + write (*,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif c write(iout,*) "before bcast",g_ilist_sc call MPI_Gather(ilist_scp,1,MPI_INTEGER, & i_ilist_scp,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "SCp after gather ierr",ierr displ(0)=0 do i=1,nfgtasks-1,1 displ(i)=i_ilist_scp(i-1)+displ(i-1) @@ -287,16 +329,21 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER, & newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER, & newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR) +c write (iout,*) "SCp after bcast ierr",ierr ! write(iout,*) "before bcast",g_ilist_sc ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) call MPI_Bcast(newcontlistscpi,g_ilist_scp,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "SCp after bcast ierr",ierr call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "SCp bcast reduce ierr",ierr ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) else #endif @@ -309,8 +356,11 @@ c write(iout,*) "before bcast",g_ilist_sc #ifdef MPI endif #endif + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + & write (iout,'(a30,i10,a,i4)') "Number of SC-p interactions", + & g_ilist_scp," per residue on average",g_ilist_scp/nres #ifdef DEBUG - write (iout,*) "after MPIREDUCE",g_ilist_scp + write (iout,*) "make_SCp_inter_list: after GATHERV",g_ilist_scp do i=1,g_ilist_scp write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i) enddo @@ -338,6 +388,7 @@ c write(iout,*) "before bcast",g_ilist_sc include 'mpif.h' include "COMMON.SETUP" #endif + include "COMMON.CONTROL" include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.SPLITELE" @@ -349,7 +400,8 @@ c write(iout,*) "before bcast",g_ilist_sc & xmedi,ymedi,zmedi double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj, & dx_normj,dy_normj,dz_normj - integer contlistpp_vdwi(2000*maxres),contlistpp_vdwj(2000*maxres) + integer contlistpp_vdwi(maxint_res*maxres), + & contlistpp_vdwj(maxint_res*maxres) ! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, & ilist_pp_vdw,g_ilist_pp_vdw @@ -422,7 +474,7 @@ c write(iout,*) "before bcast",g_ilist_sc enddo enddo - if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then + if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then ! Here the list is created ilist_pp_vdw=ilist_pp_vdw+1 ! this can be substituted by cantor and anti-cantor @@ -443,6 +495,18 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Reduce(ilist_pp_vdw,g_ilist_pp_vdw,1, & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) + if (fg_rank.eq.0.and.g_ilist_pp_vdw.gt.maxres*maxint_res) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many pp VDW interactions", + & g_ilist_pp_vdw," only",maxres*maxint_res," allowed." + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many pp VDW interactions", + & g_ilist_pp_vdw," only",maxres*maxint_res," allowed." + write (8,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif ! write(iout,*) "before bcast",g_ilist_sc call MPI_Gather(ilist_pp_vdw,1,MPI_INTEGER, & i_ilist_pp_vdw,1,MPI_INTEGER,king,FG_COMM,IERR) @@ -480,10 +544,14 @@ c write(iout,*) "before bcast",g_ilist_sc #endif call int_bounds(g_ilist_pp_vdw,g_listpp_vdw_start, & g_listpp_vdw_end) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &write (iout,'(a30,i10,a,i4)') "Number of p-p VDW interactions", + & g_ilist_pp_vdw," per residue on average",g_ilist_pp_vdw/nres #ifdef DEBUG write (iout,*) "g_listpp_vdw_start",g_listpp_vdw_start, & "g_listpp_vdw_end",g_listpp_vdw_end - write (iout,*) "after MPIREDUCE",g_ilist_pp_vdw + write (iout,*) "make_pp_vdw_inter_list: after GATHERV", + & g_ilist_pp_vdw do i=1,g_ilist_pp_vdw write (iout,*) i,newcontlistpp_vdwi(i),newcontlistpp_vdwj(i) enddo @@ -498,6 +566,7 @@ c write(iout,*) "before bcast",g_ilist_sc include 'mpif.h' include "COMMON.SETUP" #endif + include "COMMON.CONTROL" include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.SPLITELE" @@ -509,7 +578,8 @@ c write(iout,*) "before bcast",g_ilist_sc & xmedi,ymedi,zmedi double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj, & dx_normj,dy_normj,dz_normj - integer contlistppi(2000*maxres),contlistppj(2000*maxres) + integer contlistppi(maxint_res*maxres), + & contlistppj(maxint_res*maxres) ! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, & ilist_pp,g_ilist_pp @@ -582,7 +652,7 @@ c write(iout,*) "before bcast",g_ilist_sc enddo enddo - if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then + if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then ! Here the list is created ilist_pp=ilist_pp+1 ! this can be substituted by cantor and anti-cantor @@ -603,9 +673,23 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Reduce(ilist_pp,g_ilist_pp,1, & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +c write (iout,*) "After reduce ierr",ierr + if (fg_rank.eq.0.and.g_ilist_pp.gt.maxres*maxint_res) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many pp interactions", + & g_ilist_pp," only",maxres*maxint_res," allowed." + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many pp interactions", + & g_ilist_pp," only",maxres*maxint_res," allowed." + write (*,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif ! write(iout,*) "before bcast",g_ilist_sc call MPI_Gather(ilist_pp,1,MPI_INTEGER, & i_ilist_pp,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "After gather ierr",ierr displ(0)=0 do i=1,nfgtasks-1,1 displ(i)=i_ilist_pp(i-1)+displ(i-1) @@ -614,16 +698,21 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Gatherv(contlistppi,ilist_pp,MPI_INTEGER, & newcontlistppi,i_ilist_pp,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "After gatherb ierr",ierr call MPI_Gatherv(contlistppj,ilist_pp,MPI_INTEGER, & newcontlistppj,i_ilist_pp,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "After gatherb ierr",ierr call MPI_Bcast(g_ilist_pp,1,MPI_INT,king,FG_COMM,IERR) ! write(iout,*) "before bcast",g_ilist_sc ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) +c write (iout,*) "After bcast ierr",ierr call MPI_Bcast(newcontlistppi,g_ilist_pp,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "After bcast ierr",ierr call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "After bcast ierr",ierr ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) @@ -639,8 +728,11 @@ c write(iout,*) "before bcast",g_ilist_sc endif #endif call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + & write (iout,'(a30,i10,a,i4)') "Number of p-p interactions", + & g_ilist_pp," per residue on average",g_ilist_pp/nres #ifdef DEBUG - write (iout,*) "after MPIREDUCE",g_ilist_pp + write (iout,*) "make_pp_inter_list: after GATHERV",g_ilist_pp do i=1,g_ilist_pp write (iout,*) i,newcontlistppi(i),newcontlistppj(i) enddo diff --git a/source/unres/src-HCD-5D/minim_jlee.F b/source/unres/src-HCD-5D/minim_jlee.F index 7162afb..5551640 100644 --- a/source/unres/src-HCD-5D/minim_jlee.F +++ b/source/unres/src-HCD-5D/minim_jlee.F @@ -37,11 +37,11 @@ c controls minimization and sorting routines include 'COMMON.GEO' include 'COMMON.FFIELD' include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' include 'COMMON.CHAIN' dimension var(maxvar),erg(mxch*(mxch+1)/2+1) dimension var2(maxvar) - integer iffr(maxres),ihpbt(maxdim),jhpbt(maxdim) + integer iffr(maxres),ihpbt(maxdim_cont),jhpbt(maxdim_cont) double precision d(maxvar),garbage(maxvar),g(maxvar) double precision energia(0:n_ene),time0s,time1s dimension indx(9),info(12) diff --git a/source/unres/src-HCD-5D/minimize_p.F b/source/unres/src-HCD-5D/minimize_p.F index cea54c4..41a1a27 100644 --- a/source/unres/src-HCD-5D/minimize_p.F +++ b/source/unres/src-HCD-5D/minimize_p.F @@ -198,8 +198,8 @@ c---------------------------------------------------------------------------- include 'COMMON.TIME1' double precision z(maxres6),d_a_tmp(maxres6) double precision edum(0:n_ene),time_order(0:10) - double precision Gcopy(maxres2,maxres2) - common /przechowalnia/ Gcopy +c double precision Gcopy(maxres2,maxres2) +c common /przechowalnia/ Gcopy integer icall /0/ integer i,j,iorder C Workers wait for variables and NF, and NFL from the boss diff --git a/source/unres/src-HCD-5D/parmread.F b/source/unres/src-HCD-5D/parmread.F index 2da8851..4da2913 100644 --- a/source/unres/src-HCD-5D/parmread.F +++ b/source/unres/src-HCD-5D/parmread.F @@ -2096,11 +2096,12 @@ C 12/1/95 Added weight for the multi-body term WCORR do i=1,maxres dyn_ss_mask(i)=.false. enddo - do i=1,maxres-1 - do j=i+1,maxres + do i=1,max_cyst-1 + do j=i+1,max_cyst dyn_ssbond_ij(i,j)=1.0d300 enddo enddo + call flush(iout) call reada(weightcard,"HT",Ht,0.0D0) if (dyn_ss) then ss_depth=ebr/wsc-0.25*eps(1,1) @@ -2131,7 +2132,7 @@ C 12/1/95 Added weight for the multi-body term WCORR write (iout,*) "BTRISS=", btriss write (iout,*) "CTRISS=", ctriss write (iout,*) "DTRISS=", dtriss - print *,'indpdb=',indpdb,' pdbref=',pdbref +c print *,'indpdb=',indpdb,' pdbref=',pdbref endif return end diff --git a/source/unres/src-HCD-5D/read_constr_homology.F b/source/unres/src-HCD-5D/read_constr_homology.F new file mode 100644 index 0000000..3fd4ae5 --- /dev/null +++ b/source/unres/src-HCD-5D/read_constr_homology.F @@ -0,0 +1,717 @@ + subroutine read_constr_homology + implicit none + include 'DIMENSIONS' +#ifdef MPI + include 'mpif.h' +#endif + include 'COMMON.SETUP' + include 'COMMON.CONTROL' + include 'COMMON.HOMOLOGY' + include 'COMMON.CHAIN' + include 'COMMON.IOUNITS' + include 'COMMON.MD' + include 'COMMON.QRESTR' + include 'COMMON.GEO' + include 'COMMON.INTERACT' + include 'COMMON.NAMES' +c +c For new homol impl +c + include 'COMMON.VAR' +c + +c double precision odl_temp,sigma_odl_temp,waga_theta,waga_d, +c & dist_cut +c common /przechowalnia/ odl_temp(maxres,maxres,max_template), +c & sigma_odl_temp(maxres,maxres,max_template) + character*2 kic2 + character*24 model_ki_dist, model_ki_angle + character*500 controlcard + integer ki,i,ii,j,k,l,ii_in_use(maxdim),i_tmp,idomain_tmp,irec, + & ik,iistart,nres_temp + integer ilen + external ilen + logical liiflag,lfirst + integer i01,i10 +c +c FP - Nov. 2014 Temporary specifications for new vars +c + double precision rescore_tmp,x12,y12,z12,rescore2_tmp, + & rescore3_tmp + double precision, dimension (max_template,maxres) :: rescore + double precision, dimension (max_template,maxres) :: rescore2 + double precision, dimension (max_template,maxres) :: rescore3 + double precision distal + character*24 pdbfile,tpl_k_rescore +c ----------------------------------------------------------------- +c Reading multiple PDB ref structures and calculation of retraints +c not using pre-computed ones stored in files model_ki_{dist,angle} +c FP (Nov., 2014) +c ----------------------------------------------------------------- +c +c +c Alternative: reading from input + call card_concat(controlcard) + call reada(controlcard,"HOMOL_DIST",waga_dist,1.0d0) + call reada(controlcard,"HOMOL_ANGLE",waga_angle,1.0d0) + call reada(controlcard,"HOMOL_THETA",waga_theta,1.0d0) ! new + call reada(controlcard,"HOMOL_SCD",waga_d,1.0d0) ! new + call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) ! for diff ways of calc sigma + call reada(controlcard,'DIST2_CUT',dist2_cut,9999.0d0) + call readi(controlcard,"HOMOL_NSET",homol_nset,1) + read2sigma=(index(controlcard,'READ2SIGMA').gt.0) + start_from_model=(index(controlcard,'START_FROM_MODELS').gt.0) + if(.not.read2sigma.and.start_from_model) then + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) + & write(iout,*) 'START_FROM_MODELS works only with READ2SIGMA' + start_from_model=.false. + endif + if(start_from_model .and. (me.eq.king .or. .not. out1file)) + & write(iout,*) 'START_FROM_MODELS is ON' + if(start_from_model .and. rest) then + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then + write(iout,*) 'START_FROM_MODELS is OFF' + write(iout,*) 'remove restart keyword from input' + endif + endif + if (homol_nset.gt.1)then + call card_concat(controlcard) + read(controlcard,*) (waga_homology(i),i=1,homol_nset) + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then + write(iout,*) "iset homology_weight " + do i=1,homol_nset + write(iout,*) i,waga_homology(i) + enddo + endif + iset=mod(kolor,homol_nset)+1 + else + iset=1 + waga_homology(1)=1.0 + endif + +cd write (iout,*) "nnt",nnt," nct",nct +cd call flush(iout) + + + lim_odl=0 + lim_dih=0 +c +c write(iout,*) 'nnt=',nnt,'nct=',nct +c + do i = nnt,nct + do k=1,constr_homology + idomain(k,i)=0 + enddo + enddo + + ii=0 + do i = nnt,nct-2 + do j=i+2,nct + ii=ii+1 + ii_in_use(ii)=0 + enddo + enddo + + if (read_homol_frag) then + call read_klapaucjusz + else + + do k=1,constr_homology + + read(inp,'(a)') pdbfile + if(me.eq.king .or. .not. out1file) + & write (iout,'(a,5x,a)') 'HOMOL: Opening PDB file', + & pdbfile(:ilen(pdbfile)) + open(ipdbin,file=pdbfile,status='old',err=33) + goto 34 + 33 write (iout,'(a,5x,a)') 'Error opening PDB file', + & pdbfile(:ilen(pdbfile)) + stop + 34 continue +c print *,'Begin reading pdb data' +c +c Files containing res sim or local scores (former containing sigmas) +c + + write(kic2,'(bz,i2.2)') k + + tpl_k_rescore="template"//kic2//".sco" + + unres_pdb=.false. + nres_temp=nres + if (read2sigma) then + call readpdb_template(k) + else + call readpdb + endif + nres_chomo(k)=nres + nres=nres_temp +c +c Distance restraints +c +c ... --> odl(k,ii) +C Copy the coordinates from reference coordinates (?) + do i=1,2*nres_chomo(k) + do j=1,3 + c(j,i)=cref(j,i) +c write (iout,*) "c(",j,i,") =",c(j,i) + enddo + enddo +c +c From read_dist_constr (commented out 25/11/2014 <-> res sim) +c +c write(iout,*) "tpl_k_rescore - ",tpl_k_rescore + open (ientin,file=tpl_k_rescore,status='old') + if (nnt.gt.1) rescore(k,1)=0.0d0 + do irec=nnt,nct ! loop for reading res sim + if (read2sigma) then + read (ientin,*,end=1401) i_tmp,rescore2_tmp,rescore_tmp, + & rescore3_tmp,idomain_tmp + i_tmp=i_tmp+nnt-1 + idomain(k,i_tmp)=idomain_tmp + rescore(k,i_tmp)=rescore_tmp + rescore2(k,i_tmp)=rescore2_tmp + rescore3(k,i_tmp)=rescore3_tmp + if (.not. out1file .or. me.eq.king) + & write(iout,'(a7,i5,3f10.5,i5)') "rescore", + & i_tmp,rescore2_tmp,rescore_tmp, + & rescore3_tmp,idomain_tmp + else + idomain(k,irec)=1 + read (ientin,*,end=1401) rescore_tmp + +c rescore(k,irec)=rescore_tmp+1.0d0 ! to avoid 0 values + rescore(k,irec)=0.5d0*(rescore_tmp+0.5d0) ! alt transf to reduce scores +c write(iout,*) "rescore(",k,irec,") =",rescore(k,irec) + endif + enddo + 1401 continue + close (ientin) + if (waga_dist.ne.0.0d0) then + ii=0 + do i = nnt,nct-2 + do j=i+2,nct + + x12=c(1,i)-c(1,j) + y12=c(2,i)-c(2,j) + z12=c(3,i)-c(3,j) + distal=dsqrt(x12*x12+y12*y12+z12*z12) +c write (iout,*) k,i,j,distal,dist2_cut + + if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0 + & .and. distal.le.dist2_cut ) then + + ii=ii+1 + ii_in_use(ii)=1 + l_homo(k,ii)=.true. + +c write (iout,*) "k",k +c write (iout,*) "i",i," j",j," constr_homology", +c & constr_homology + ires_homo(ii)=i + jres_homo(ii)=j + odl(k,ii)=distal + if (read2sigma) then + sigma_odl(k,ii)=0 + do ik=i,j + sigma_odl(k,ii)=sigma_odl(k,ii)+rescore2(k,ik) + enddo + sigma_odl(k,ii)=sigma_odl(k,ii)/(j-i+1) + if (odl(k,ii).gt.dist_cut) sigma_odl(k,ii) = + & sigma_odl(k,ii)*dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0) + else + if (odl(k,ii).le.dist_cut) then + sigma_odl(k,ii)=rescore(k,i)+rescore(k,j) + else +#ifdef OLDSIGMA + sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* + & dexp(0.5d0*(odl(k,ii)/dist_cut)**2) +#else + sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* + & dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0) +#endif + endif + endif + sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii)) + else + ii=ii+1 + l_homo(k,ii)=.false. + endif + enddo + enddo + lim_odl=ii + endif +c write (iout,*) "Distance restraints set" +c call flush(iout) +c +c Theta, dihedral and SC retraints +c + if (waga_angle.gt.0.0d0) then +c open (ientin,file=tpl_k_sigma_dih,status='old') +c do irec=1,maxres-3 ! loop for reading sigma_dih +c read (ientin,*,end=1402) i,j,ki,l,sigma_dih(k,i+nnt-1) ! j,ki,l what for? +c if (i+nnt-1.gt.lim_dih) lim_dih=i+nnt-1 ! right? +c sigma_dih(k,i+nnt-1)=sigma_dih(k,i+nnt-1)* ! not inverse because of use of res. similarity +c & sigma_dih(k,i+nnt-1) +c enddo +c1402 continue +c close (ientin) + do i = nnt+3,nct + if (idomain(k,i).eq.0) then + sigma_dih(k,i)=0.0 + cycle + endif + dih(k,i)=phiref(i) ! right? +c read (ientin,*) sigma_dih(k,i) ! original variant +c write (iout,*) "dih(",k,i,") =",dih(k,i) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i), +c & "rescore(",k,i-1,") =",rescore(k,i-1), +c & "rescore(",k,i-2,") =",rescore(k,i-2), +c & "rescore(",k,i-3,") =",rescore(k,i-3) + + sigma_dih(k,i)=(rescore(k,i)+rescore(k,i-1)+ + & rescore(k,i-2)+rescore(k,i-3))/4.0 +c if (read2sigma) sigma_dih(k,i)=sigma_dih(k,i)/4.0 +c write (iout,*) "Raw sigmas for dihedral angle restraints" +c write (iout,'(i5,10(2f8.2,4x))') i,sigma_dih(k,i) +c sigma_dih(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)* +c rescore(k,i-2)*rescore(k,i-3) ! right expression ? +c Instead of res sim other local measure of b/b str reliability possible + if (sigma_dih(k,i).ne.0) + & sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i)) +c sigma_dih(k,i)=sigma_dih(k,i)*sigma_dih(k,i) + enddo + lim_dih=nct-nnt-2 + endif +c write (iout,*) "Dihedral angle restraints set" +c call flush(iout) + + if (waga_theta.gt.0.0d0) then +c open (ientin,file=tpl_k_sigma_theta,status='old') +c do irec=1,maxres-2 ! loop for reading sigma_theta, right bounds? +c read (ientin,*,end=1403) i,j,ki,sigma_theta(k,i+nnt-1) ! j,ki what for? +c sigma_theta(k,i+nnt-1)=sigma_theta(k,i+nnt-1)* ! not inverse because of use of res. similarity +c & sigma_theta(k,i+nnt-1) +c enddo +c1403 continue +c close (ientin) + + do i = nnt+2,nct ! right? without parallel. +c do i = i=1,nres ! alternative for bounds acc to readpdb? +c do i=ithet_start,ithet_end ! with FG parallel. + if (idomain(k,i).eq.0) then + sigma_theta(k,i)=0.0 + cycle + endif + thetatpl(k,i)=thetaref(i) +c write (iout,*) "thetatpl(",k,i,") =",thetatpl(k,i) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i), +c & "rescore(",k,i-1,") =",rescore(k,i-1), +c & "rescore(",k,i-2,") =",rescore(k,i-2) +c read (ientin,*) sigma_theta(k,i) ! 1st variant + sigma_theta(k,i)=(rescore(k,i)+rescore(k,i-1)+ + & rescore(k,i-2))/3.0 +c if (read2sigma) sigma_theta(k,i)=sigma_theta(k,i)/3.0 + if (sigma_theta(k,i).ne.0) + & sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i)) + +c sigma_theta(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)* +c rescore(k,i-2) ! right expression ? +c sigma_theta(k,i)=sigma_theta(k,i)*sigma_theta(k,i) + enddo + endif +c write (iout,*) "Angle restraints set" +c call flush(iout) + + if (waga_d.gt.0.0d0) then +c open (ientin,file=tpl_k_sigma_d,status='old') +c do irec=1,maxres-1 ! loop for reading sigma_theta, right bounds? +c read (ientin,*,end=1404) i,j,sigma_d(k,i+nnt-1) ! j,ki what for? +c sigma_d(k,i+nnt-1)=sigma_d(k,i+nnt-1)* ! not inverse because of use of res. similarity +c & sigma_d(k,i+nnt-1) +c enddo +c1404 continue + + do i = nnt,nct ! right? without parallel. +c do i=2,nres-1 ! alternative for bounds acc to readpdb? +c do i=loc_start,loc_end ! with FG parallel. + if (itype(i).eq.10) cycle + if (idomain(k,i).eq.0 ) then + sigma_d(k,i)=0.0 + cycle + endif + xxtpl(k,i)=xxref(i) + yytpl(k,i)=yyref(i) + zztpl(k,i)=zzref(i) +c write (iout,*) "xxtpl(",k,i,") =",xxtpl(k,i) +c write (iout,*) "yytpl(",k,i,") =",yytpl(k,i) +c write (iout,*) "zztpl(",k,i,") =",zztpl(k,i) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i) + sigma_d(k,i)=rescore3(k,i) ! right expression ? + if (sigma_d(k,i).ne.0) + & sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i)) + +c sigma_d(k,i)=hmscore(k)*rescore(k,i) ! right expression ? +c sigma_d(k,i)=sigma_d(k,i)*sigma_d(k,i) +c read (ientin,*) sigma_d(k,i) ! 1st variant + enddo + endif + enddo +c write (iout,*) "SC restraints set" +c call flush(iout) +c +c remove distance restraints not used in any model from the list +c shift data in all arrays +c +c write (iout,*) "waga_dist",waga_dist," nnt",nnt," nct",nct + if (waga_dist.ne.0.0d0) then + ii=0 + liiflag=.true. + lfirst=.true. + do i=nnt,nct-2 + do j=i+2,nct + ii=ii+1 +c if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0 +c & .and. distal.le.dist2_cut ) then +c write (iout,*) "i",i," j",j," ii",ii +c call flush(iout) + if (ii_in_use(ii).eq.0.and.liiflag.or. + & ii_in_use(ii).eq.1.and.liiflag.and.ii.eq.lim_odl) then + liiflag=.false. + i10=ii + if (lfirst) then + lfirst=.false. + iistart=ii + else + if(i10.eq.lim_odl) i10=i10+1 + do ki=0,i10-i01-1 + ires_homo(iistart+ki)=ires_homo(ki+i01) + jres_homo(iistart+ki)=jres_homo(ki+i01) + ii_in_use(iistart+ki)=ii_in_use(ki+i01) + do k=1,constr_homology + odl(k,iistart+ki)=odl(k,ki+i01) + sigma_odl(k,iistart+ki)=sigma_odl(k,ki+i01) + l_homo(k,iistart+ki)=l_homo(k,ki+i01) + enddo + enddo + iistart=iistart+i10-i01 + endif + endif + if (ii_in_use(ii).ne.0.and..not.liiflag) then + i01=ii + liiflag=.true. + endif + enddo + enddo + lim_odl=iistart-1 + endif +c write (iout,*) "Removing distances completed" +c call flush(iout) + endif ! .not. klapaucjusz + + if (constr_homology.gt.0) call homology_partition +c write (iout,*) "After homology_partition" +c call flush(iout) + if (constr_homology.gt.0) call init_int_table +c write (iout,*) "After init_int_table" +c call flush(iout) +c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end +c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end +c +c Print restraints +c + if (.not.out_template_restr) return +cd write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then + write (iout,*) "Distance restraints from templates" + do ii=1,lim_odl + write(iout,'(3i5,100(2f8.2,1x,l1,4x))') + & ii,ires_homo(ii),jres_homo(ii), + & (odl(ki,ii),1.0d0/dsqrt(sigma_odl(ki,ii)),l_homo(ki,ii), + & ki=1,constr_homology) + enddo + write (iout,*) "Dihedral angle restraints from templates" + do i=nnt+3,nct + write (iout,'(i5,a4,100(2f8.2,4x))') i,restyp(itype(i)), + & (rad2deg*dih(ki,i), + & rad2deg/dsqrt(sigma_dih(ki,i)),ki=1,constr_homology) + enddo + write (iout,*) "Virtual-bond angle restraints from templates" + do i=nnt+2,nct + write (iout,'(i5,a4,100(2f8.2,4x))') i,restyp(itype(i)), + & (rad2deg*thetatpl(ki,i), + & rad2deg/dsqrt(sigma_theta(ki,i)),ki=1,constr_homology) + enddo + write (iout,*) "SC restraints from templates" + do i=nnt,nct + write(iout,'(i5,100(4f8.2,4x))') i, + & (xxtpl(ki,i),yytpl(ki,i),zztpl(ki,i), + & 1.0d0/dsqrt(sigma_d(ki,i)),ki=1,constr_homology) + enddo + endif +c ----------------------------------------------------------------- + return + end +c---------------------------------------------------------------------- + subroutine read_klapaucjusz + implicit none + include 'DIMENSIONS' +#ifdef MPI + include 'mpif.h' +#endif + include 'COMMON.SETUP' + include 'COMMON.CONTROL' + include 'COMMON.HOMOLOGY' + include 'COMMON.CHAIN' + include 'COMMON.IOUNITS' + include 'COMMON.MD' + include 'COMMON.GEO' + include 'COMMON.INTERACT' + include 'COMMON.NAMES' + character*256 fragfile + integer ninclust(maxclust),inclust(max_template,maxclust), + & nresclust(maxclust),iresclust(maxres,maxclust),nclust + + character*2 kic2 + character*24 model_ki_dist, model_ki_angle + character*500 controlcard + integer ki, i, j, k, l, ii_in_use(maxdim),i_tmp,idomain_tmp, + & ik,ll,ii,kk,iistart,iishift,lim_xx + double precision distal + logical lprn /.true./ + integer nres_temp + integer ilen + external ilen + logical liiflag +c +c + double precision rescore_tmp,x12,y12,z12,rescore2_tmp + double precision, dimension (max_template,maxres) :: rescore + double precision, dimension (max_template,maxres) :: rescore2 + character*24 pdbfile,tpl_k_rescore + +c +c For new homol impl +c + include 'COMMON.VAR' +c + call getenv("FRAGFILE",fragfile) + open(ientin,file=fragfile,status="old",err=10) + read(ientin,*) constr_homology,nclust + l_homo = .false. + sigma_theta=0.0 + sigma_d=0.0 + sigma_dih=0.0 +c Read pdb files + do k=1,constr_homology + read(ientin,'(a)') pdbfile + write (iout,'(a,5x,a)') 'KLAPAUCJUSZ: Opening PDB file', + & pdbfile(:ilen(pdbfile)) + open(ipdbin,file=pdbfile,status='old',err=33) + goto 34 + 33 write (iout,'(a,5x,a)') 'Error opening PDB file', + & pdbfile(:ilen(pdbfile)) + stop + 34 continue + unres_pdb=.false. + nres_temp=nres + call readpdb_template(k) + nres_chomo(k)=nres + nres=nres_temp + do i=1,nres + rescore(k,i)=0.2d0 + rescore2(k,i)=1.0d0 + enddo + enddo +c Read clusters + do i=1,nclust + read(ientin,*) ninclust(i),nresclust(i) + read(ientin,*) (inclust(k,i),k=1,ninclust(i)) + read(ientin,*) (iresclust(k,i),k=1,nresclust(i)) + enddo +c +c Loop over clusters +c + do l=1,nclust + do ll = 1,ninclust(l) + + k = inclust(ll,l) + do i=1,nres + idomain(k,i)=0 + enddo + do i=1,nresclust(l) + if (nnt.gt.1) then + idomain(k,iresclust(i,l)+1) = 1 + else + idomain(k,iresclust(i,l)) = 1 + endif + enddo +c +c Distance restraints +c +c ... --> odl(k,ii) +C Copy the coordinates from reference coordinates (?) + nres_temp=nres + nres=nres_chomo(k) + do i=1,2*nres + do j=1,3 + c(j,i)=chomo(j,i,k) +c write (iout,*) "c(",j,i,") =",c(j,i) + enddo + enddo + call int_from_cart(.true.,.false.) + call sc_loc_geom(.false.) + do i=1,nres + thetaref(i)=theta(i) + phiref(i)=phi(i) + enddo + nres=nres_temp + if (waga_dist.ne.0.0d0) then + ii=0 + do i = nnt,nct-2 + do j=i+2,nct + + x12=c(1,i)-c(1,j) + y12=c(2,i)-c(2,j) + z12=c(3,i)-c(3,j) + distal=dsqrt(x12*x12+y12*y12+z12*z12) +c write (iout,*) k,i,j,distal,dist2_cut + + if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0 + & .and. distal.le.dist2_cut ) then + + ii=ii+1 + ii_in_use(ii)=1 + l_homo(k,ii)=.true. + +c write (iout,*) "k",k +c write (iout,*) "i",i," j",j," constr_homology", +c & constr_homology + ires_homo(ii)=i + jres_homo(ii)=j + odl(k,ii)=distal + if (read2sigma) then + sigma_odl(k,ii)=0 + do ik=i,j + sigma_odl(k,ii)=sigma_odl(k,ii)+rescore2(k,ik) + enddo + sigma_odl(k,ii)=sigma_odl(k,ii)/(j-i+1) + if (odl(k,ii).gt.dist_cut) sigma_odl(k,ii) = + & sigma_odl(k,ii)*dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0) + else + if (odl(k,ii).le.dist_cut) then + sigma_odl(k,ii)=rescore(k,i)+rescore(k,j) + else +#ifdef OLDSIGMA + sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* + & dexp(0.5d0*(odl(k,ii)/dist_cut)**2) +#else + sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* + & dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0) +#endif + endif + endif + sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii)) + else + ii=ii+1 +c l_homo(k,ii)=.false. + endif + enddo + enddo + lim_odl=ii + endif +c +c Theta, dihedral and SC retraints +c + if (waga_angle.gt.0.0d0) then + do i = nnt+3,nct + if (idomain(k,i).eq.0) then +c sigma_dih(k,i)=0.0 + cycle + endif + dih(k,i)=phiref(i) + sigma_dih(k,i)=(rescore(k,i)+rescore(k,i-1)+ + & rescore(k,i-2)+rescore(k,i-3))/4.0 +c write (iout,*) "k",k," l",l," i",i," rescore",rescore(k,i), +c & " sigma_dihed",sigma_dih(k,i) + if (sigma_dih(k,i).ne.0) + & sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i)) + enddo + lim_dih=nct-nnt-2 + endif + + if (waga_theta.gt.0.0d0) then + do i = nnt+2,nct + if (idomain(k,i).eq.0) then +c sigma_theta(k,i)=0.0 + cycle + endif + thetatpl(k,i)=thetaref(i) + sigma_theta(k,i)=(rescore(k,i)+rescore(k,i-1)+ + & rescore(k,i-2))/3.0 + if (sigma_theta(k,i).ne.0) + & sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i)) + enddo + endif + + if (waga_d.gt.0.0d0) then + do i = nnt,nct + if (itype(i).eq.10) cycle + if (idomain(k,i).eq.0 ) then +c sigma_d(k,i)=0.0 + cycle + endif + xxtpl(k,i)=xxref(i) + yytpl(k,i)=yyref(i) + zztpl(k,i)=zzref(i) + sigma_d(k,i)=rescore(k,i) + if (sigma_d(k,i).ne.0) + & sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i)) + if (i-nnt+1.gt.lim_xx) lim_xx=i-nnt+1 + enddo + endif + enddo ! l + enddo ! ll +c +c remove distance restraints not used in any model from the list +c shift data in all arrays +c + if (waga_dist.ne.0.0d0) then + ii=0 + liiflag=.true. + do i=nnt,nct-2 + do j=i+2,nct + ii=ii+1 + if (ii_in_use(ii).eq.0.and.liiflag) then + liiflag=.false. + iistart=ii + endif + if (ii_in_use(ii).ne.0.and..not.liiflag.or. + & .not.liiflag.and.ii.eq.lim_odl) then + if (ii.eq.lim_odl) then + iishift=ii-iistart+1 + else + iishift=ii-iistart + endif + liiflag=.true. + do ki=iistart,lim_odl-iishift + ires_homo(ki)=ires_homo(ki+iishift) + jres_homo(ki)=jres_homo(ki+iishift) + ii_in_use(ki)=ii_in_use(ki+iishift) + do k=1,constr_homology + odl(k,ki)=odl(k,ki+iishift) + sigma_odl(k,ki)=sigma_odl(k,ki+iishift) + l_homo(k,ki)=l_homo(k,ki+iishift) + enddo + enddo + ii=ii-iishift + lim_odl=lim_odl-iishift + endif + enddo + enddo + endif + + return + 10 stop "Error in fragment file" + end + diff --git a/source/unres/src-HCD-5D/readpdb-mult.F b/source/unres/src-HCD-5D/readpdb-mult.F index 40bf9ac..8346c4a 100644 --- a/source/unres/src-HCD-5D/readpdb-mult.F +++ b/source/unres/src-HCD-5D/readpdb-mult.F @@ -20,8 +20,9 @@ C geometry. double precision e1(3),e2(3),e3(3) integer rescode,iterter(maxres),cou logical fail,sccalc - integer i,j,iii,ires,ires_old,ishift,ishift1,ibeg - double precision dcj,efree_temp + integer i,j,iii,ires,ires_old,ishift,ishift1,ibeg,ifree + double precision dcj!,efree_temp + logical zero bfac=0.0d0 do i=1,maxres iterter(i)=0 @@ -36,6 +37,7 @@ C geometry. do read (ipdbin,'(a80)',end=10) card c write (iout,'(a)') card +c call flush(iout) if (card(:5).eq.'HELIX') then nhfrag=nhfrag+1 lsecondary=.true. @@ -76,7 +78,11 @@ c write (iout,'(a)') card sccalc=.true. endif ! Read free energy - if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp +c if (index(card,"FREE ENERGY").gt.0) then +c ifree=index(card,"FREE ENERGY")+12 +c read(card(ifree:),*,err=1115,end=1115) efree_temp +c 1115 continue +c endif ! Fish out the ATOM cards. if (index(card(1:4),'ATOM').gt.0) then sccalc=.false. @@ -96,9 +102,11 @@ c write (iout,*) "IRES",ires-ishift+ishift1,ires_old ! if (ibeg.eq.0) call sccenter(ires,iii,sccor) if (ibeg.eq.0) then c write (iout,*) "Calculating sidechain center iii",iii +c write (iout,*) "ires",ires if (unres_pdb) then +c write (iout,'(i5,3f10.5)') ires,(sccor(j,iii),j=1,3) do j=1,3 - dc(j,ires+nres)=sccor(j,iii) + dc(j,ires_old)=sccor(j,iii) enddo else call sccenter(ires_old,iii,sccor) @@ -153,7 +161,7 @@ c write (2,*) "ires",ires," res ",res!," ity"!,ity read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) ! write (iout,*) "backbone ",atom #ifdef DEBUG - write (iout,'(2i3,2x,a,3f8.3)') + write (iout,'(i6,i3,2x,a,3f8.3)') & ires,itype(ires),res,(c(j,ires),j=1,3) #endif iii=iii+1 @@ -178,6 +186,10 @@ c write (iout,*) "iii",iii C Calculate dummy residue coordinates inside the "chain" of a multichain C system nres=ires +c write (iout,*) "dc" +c do i=1,nres +c write (iout,'(i5,3f10.5)') i,(dc(j,i),j=1,3) +c enddo do i=2,nres-1 c write (iout,*) i,itype(i),itype(i+1),ntyp1,iterter(i) if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then @@ -187,14 +199,14 @@ C first is connected prevous chain (itype(i+1).eq.ntyp1)=true C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false if (unres_pdb) then C 2/15/2013 by Adam: corrected insertion of the last dummy residue - print *,i,'tu dochodze' +c print *,i,'tu dochodze' call refsys(i-3,i-2,i-1,e1,e2,e3,fail) if (fail) then e2(1)=0.0d0 e2(2)=1.0d0 e2(3)=0.0d0 endif !fail - print *,i,'a tu?' +c print *,i,'a tu?' do j=1,3 c(j,i)=c(j,i-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) enddo @@ -312,6 +324,18 @@ C Calculate internal coordinates. enddo call flush(iout) endif + zero=.false. + do ires=1,nres + zero=zero.or.itype(ires).eq.0 + enddo + if (zero) then + write (iout,'(2a)') "Gaps in PDB coordinates detected;", + & " look for ZERO in the control output above." + write (iout,'(2a)') "Repair the PDB file using MODELLER", + & " or other softwared and resubmit." + call flush(iout) + stop + endif c write(iout,*)"before int_from_cart nres",nres call int_from_cart(.true.,.false.) do i=1,nres @@ -439,7 +463,7 @@ C Calculate the CM of the preceding residue. if (ibeg.eq.0) then if (unres_pdb) then do j=1,3 - dc(j,ires)=sccor(j,iii) + dc(j,ires_old)=sccor(j,iii) enddo else call sccenter(ires_old,iii,sccor) @@ -652,7 +676,7 @@ C Calculate internal coordinates. enddo endif C Calculate internal coordinates. - call int_from_cart(.true.,.true.) + call int_from_cart(.true.,out_template_coord) call sc_loc_geom(.false.) do i=1,nres thetaref(i)=theta(i) diff --git a/source/unres/src-HCD-5D/readrtns_CSA.F b/source/unres/src-HCD-5D/readrtns_CSA.F index 16c0f37..d76b29e 100644 --- a/source/unres/src-HCD-5D/readrtns_CSA.F +++ b/source/unres/src-HCD-5D/readrtns_CSA.F @@ -187,7 +187,6 @@ c call readi(controlcard,'IZ_SC',iz_sc,0) pdbref=(index(controlcard,'PDBREF').gt.0) refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0) indpdb=index(controlcard,'PDBSTART') - extconf=(index(controlcard,'EXTCONF').gt.0) AFMlog=(index(controlcard,'AFM')) selfguide=(index(controlcard,'SELFGUIDE')) c print *,'AFMlog',AFMlog,selfguide,"KUPA" @@ -296,6 +295,12 @@ cfmc modecalc=10 indphi=index(controlcard,'PHI') indback=index(controlcard,'BACK') iranconf=index(controlcard,'RAND_CONF') + start_from_model=(index(controlcard,'START_FROM_MODELS').gt.0) + extconf=(index(controlcard,'EXTCONF').gt.0) + if (start_from_model) then + iranconf=0 + extconf=.false. + endif i2ndstr=index(controlcard,'USE_SEC_PRED') gradout=index(controlcard,'GRADOUT').gt.0 gnorm_check=index(controlcard,'GNORM_CHECK').gt.0 @@ -736,7 +741,7 @@ C integer ilen external ilen integer iperm,tperm - integer i,j,ii,k,l,itrial,itmp,i1,i2,it1,it2 + integer i,j,ii,k,l,itrial,itmp,i1,i2,it1,it2,nres_temp double precision sumv C C Read PDB structure if applicable @@ -831,7 +836,7 @@ c print '(20i4)',(itype(i),i=1,nres) do i=1,nres-1 write (iout,*) i,itype(i),itel(i) enddo - print *,'Call Read_Bridge.' +c print *,'Call Read_Bridge.' endif nnt=1 nct=nres @@ -844,7 +849,7 @@ cd print *,'NNT=',NNT,' NCT=',NCT chain_border1(1,i)=chain_border(1,i)-1 chain_border1(2,i)=chain_border(2,i)+1 enddo - chain_border1(1,nchain)=chain_border(1,nchain)-1 + if (nchain.gt.1) chain_border1(1,nchain)=chain_border(1,nchain)-1 chain_border1(2,nchain)=nres write(iout,*) "nres",nres," nchain",nchain do i=1,nchain @@ -870,9 +875,9 @@ c enddo if (.not. (wdfa_dist.eq.0.0 .and. wdfa_tor.eq.0.0 .and. & wdfa_nei.eq.0.0 .and. wdfa_beta.eq.0.0)) then call init_dfa_vars - print*, 'init_dfa_vars finished!' +c print*, 'init_dfa_vars finished!' call read_dfa_info - print*, 'read_dfa_info finished!' +c print*, 'read_dfa_info finished!' endif #endif if (pdbref) then @@ -1097,10 +1102,10 @@ czscore call geom_to_var(nvar,coord_exp_zs(1,1)) endif endif c print *, "A TU" - write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup +c write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup call flush(iout) if (constr_dist.gt.0) call read_dist_constr - write (iout,*) "After read_dist_constr nhpb",nhpb +c write (iout,*) "After read_dist_constr nhpb",nhpb if ((AFMlog.gt.0).or.(selfguide.gt.0)) call read_afminp call hpb_partition call NMRpeak_partition @@ -1163,6 +1168,49 @@ c print *, "A TU" enddo else homol_nset=0 + if (start_from_model) then + nmodel_start=0 + do + read(inp,'(a)',end=332,err=332) pdbfile + if (me.eq.king .or. .not. out1file) + & write (iout,'(a,5x,a)') 'Opening PDB file', + & pdbfile(:ilen(pdbfile)) + open(ipdbin,file=pdbfile,status='old',err=336) + goto 335 + 336 write (iout,'(a,5x,a)') 'Error opening PDB file', + & pdbfile(:ilen(pdbfile)) + call flush(iout) + stop + 335 continue + unres_pdb=.false. + nres_temp=nres + call readpdb + close(ipdbin) + if (nres.ge.nres_temp) then + nmodel_start=nmodel_start+1 + pdbfiles_chomo(nmodel_start)=pdbfile + do i=1,2*nres + do j=1,3 + chomo(j,i,nmodel_start)=c(j,i) + enddo + enddo + else + if (me.eq.king .or. .not. out1file) + & write (iout,'(a,2i5,1x,a)') + & "Different number of residues",nres_temp,nres, + & " model skipped." + endif + nres=nres_temp + enddo + 332 continue + if (nmodel_start.eq.0) then + if (me.eq.king .or. .not. out1file) + & write (iout,'(a)') + & "No valid starting model found START_FROM_MODELS is OFF" + start_from_model=.false. + endif + write (iout,*) "nmodel_start",nmodel_start + endif endif @@ -1172,14 +1220,15 @@ C endif & modecalc.ne.10) then C If input structure hasn't been supplied from the PDB file read or generate C initial geometry. - if (iranconf.eq.0 .and. .not. extconf) then + if (iranconf.eq.0 .and. .not. extconf .and. .not. + & start_from_model) then if(me.eq.king.or..not.out1file .and.fg_rank.eq.0) & write (iout,'(a)') 'Initial geometry will be read in.' if (read_cart) then read(inp,'(8f10.5)',end=36,err=36) & ((c(l,k),l=1,3),k=1,nres), & ((c(l,k+nres),l=1,3),k=nnt,nct) - write (iout,*) "Exit READ_CART" +c write (iout,*) "Exit READ_CART" c write (iout,'(8f10.5)') c & ((c(l,k),l=1,3),k=1,nres), c & ((c(l,k+nres),l=1,3),k=nnt,nct) @@ -1405,7 +1454,13 @@ C Read information about disulfide bridges. integer i,j C Read bridging residues. read (inp,*) ns,(iss(i),i=1,ns) - print *,'ns=',ns +c 5/24/2020 Adam: Added a table to translate residue numbers to cysteine +c numbers + icys=0 + do i=1,ns + icys(iss(i))=i + enddo +c print *,'ns=',ns if(me.eq.king.or..not.out1file) & write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns) C Check whether the specified bridging residues are cystines. @@ -1614,9 +1669,11 @@ C Generate CA distance constraints. include 'COMMON.CONTROL' include 'COMMON.DBASE' include 'COMMON.THREAD' + include 'COMMON.SPLITELE' include 'COMMON.TIME1' integer i,j,itype_pdb(maxres) common /pizda/ itype_pdb + double precision dd double precision dist character*2 iden cd print *,'gen_dist_constr: nnt=',nnt,' nct=',nct @@ -1627,11 +1684,14 @@ cd & ' nsup',nsup cd write (2,*) 'i',i,' seq ',restyp(itype(i+nstart_seq-nstart_sup)), cd & ' seq_pdb', restyp(itype_pdb(i)) do j=i+2,nstart_sup+nsup-1 +c 5/24/2020 Adam: Cutoff included to reduce array size + dd = dist(i,j) + if (dd.gt.r_cut_int) cycle nhpb=nhpb+1 ihpb(nhpb)=i+nstart_seq-nstart_sup jhpb(nhpb)=j+nstart_seq-nstart_sup forcon(nhpb)=weidis - dhpb(nhpb)=dist(i,j) + dhpb(nhpb)=dd enddo enddo cd write (iout,'(a)') 'Distance constraints:' @@ -2375,10 +2435,10 @@ c------------------------------------------------------------------------------ open(irest2,file=rest2name,status='unknown') read(irest2,*) totT,EK,potE,totE,t_bath totTafm=totT - do i=1,2*nres + do i=0,2*nres-1 read(irest2,'(3e15.5)') (d_t(j,i),j=1,3) enddo - do i=1,2*nres + do i=0,2*nres-1 read(irest2,'(3e15.5)') (dc(j,i),j=1,3) enddo if(usampl) then @@ -2468,7 +2528,7 @@ c print *, "wchodze" call readi(afmcard,"END",afmend,0) call reada(afmcard,"FORCE",forceAFMconst,0.0d0) call reada(afmcard,"VEL",velAFMconst,0.0d0) - print *,'FORCE=' ,forceAFMconst +c print *,'FORCE=' ,forceAFMconst CCCC NOW PROPERTIES FOR AFM distafminit=0.0d0 do i=1,3 @@ -2979,7 +3039,7 @@ c & sigma_odl_temp(maxres,maxres,max_template) character*24 model_ki_dist, model_ki_angle character*500 controlcard integer ki,i,ii,j,k,l,ii_in_use(maxdim),i_tmp,idomain_tmp,irec, - & ik,iistart + & ik,iistart,nres_temp integer ilen external ilen logical liiflag,lfirst @@ -3016,15 +3076,17 @@ c Alternative: reading from input if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) & write(iout,*) 'START_FROM_MODELS works only with READ2SIGMA' start_from_model=.false. + iranconf=(indpdb.le.0) endif if(start_from_model .and. (me.eq.king .or. .not. out1file)) & write(iout,*) 'START_FROM_MODELS is ON' - if(start_from_model .and. rest) then - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then - write(iout,*) 'START_FROM_MODELS is OFF' - write(iout,*) 'remove restart keyword from input' - endif - endif +c if(start_from_model .and. rest) then +c if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then +c write(iout,*) 'START_FROM_MODELS is OFF' +c write(iout,*) 'remove restart keyword from input' +c endif +c endif + if (start_from_model) nmodel_start=constr_homology if (homol_nset.gt.1)then call card_concat(controlcard) read(controlcard,*) (waga_homology(i),i=1,homol_nset) @@ -3089,17 +3151,20 @@ c tpl_k_rescore="template"//kic2//".sco" unres_pdb=.false. + nres_temp=nres if (read2sigma) then call readpdb_template(k) else call readpdb endif + nres_chomo(k)=nres + nres=nres_temp c c Distance restraints c c ... --> odl(k,ii) C Copy the coordinates from reference coordinates (?) - do i=1,2*nres + do i=1,2*nres_chomo(k) do j=1,3 c(j,i)=cref(j,i) c write (iout,*) "c(",j,i,") =",c(j,i) @@ -3562,6 +3627,7 @@ c---------------------------------------------------------------------- & ik,ll,ii,kk,iistart,iishift,lim_xx double precision distal logical lprn /.true./ + integer nres_temp integer ilen external ilen logical liiflag @@ -3596,7 +3662,10 @@ c Read pdb files stop 34 continue unres_pdb=.false. + nres_temp=nres call readpdb_template(k) + nres_chomo(k)=nres + nres=nres_temp do i=1,nres rescore(k,i)=0.2d0 rescore2(k,i)=1.0d0 @@ -3630,6 +3699,8 @@ c Distance restraints c c ... --> odl(k,ii) C Copy the coordinates from reference coordinates (?) + nres_temp=nres + nres=nres_chomo(k) do i=1,2*nres do j=1,3 c(j,i)=chomo(j,i,k) @@ -3642,6 +3713,7 @@ c write (iout,*) "c(",j,i,") =",c(j,i) thetaref(i)=theta(i) phiref(i)=phi(i) enddo + nres=nres_temp if (waga_dist.ne.0.0d0) then ii=0 do i = nnt,nct-2 diff --git a/source/unres/src-HCD-5D/regularize.F b/source/unres/src-HCD-5D/regularize.F index c506b8a..72d92da 100644 --- a/source/unres/src-HCD-5D/regularize.F +++ b/source/unres/src-HCD-5D/regularize.F @@ -7,7 +7,8 @@ include 'COMMON.HEADER' include 'COMMON.IOUNITS' include 'COMMON.MINIM' - double precision przes(3),obrot(3,3),fhpb0(maxdim),varia(maxvar) + double precision przes(3),obrot(3,3),fhpb0(maxdim_cont), + & varia(maxvar) double precision cref0(3,ncart) double precision energia(0:n_ene) logical non_conv diff --git a/source/unres/src-HCD-5D/ssMD.F b/source/unres/src-HCD-5D/ssMD.F index aa938b5..26807a0 100644 --- a/source/unres/src-HCD-5D/ssMD.F +++ b/source/unres/src-HCD-5D/ssMD.F @@ -84,10 +84,13 @@ ct rij=ran_number(rmin,rmax) C----------------------------------------------------------------------------- subroutine dyn_ssbond_ene(resi,resj,eij) -c implicit none - -c Includes + implicit none include 'DIMENSIONS' +#ifdef MPI + include 'mpif.h' + include 'COMMON.SETUP' + integer ierr +#endif include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -96,6 +99,7 @@ c Includes include 'COMMON.VAR' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.NAMES' #ifndef CLUST #ifndef WHAM include 'COMMON.MD' @@ -128,6 +132,9 @@ c integer itypi,itypj,k,l double precision omega,delta_inv,deltasq_inv,fac1,fac2 c-------FIRST METHOD double precision xm,d_xm(1:3) + double precision sslipi,sslipj,ssgradlipi,ssgradlipj + integer ici,icj,itypi,itypj + double precision boxshift,sscale,sscagrad c-------END FIRST METHOD c-------SECOND METHOD c$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3) @@ -144,125 +151,52 @@ c-------END TESTING CODE i=resi j=resj - + ici=icys(i) + icj=icys(j) + if (ici.eq.0 .or. icj.eq.0) then +#ifdef MPI + write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') + & "Processor",me," attempt to create", + & " a disulfide link between non-cysteine residues ",restyp(i),i, + & restyp(j),j + call MPI_Abort(MPI_COMM_WORLD,ierr) +#else + write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') + & "Processor",me," attempt to create", + & " a disulfide link between non-cysteine residues ",restyp(i),i, + & restyp(j),j + stop +#endif + endif itypi=itype(i) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) dsci_inv=vbld_inv(i+nres) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - xi=dmod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=dmod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=dmod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + call to_box(xi,yi,zi) C define scaling factor for lipids C if (positi.le.0) positi=positi+boxzsize C print *,i C first for peptide groups c for each residue check if it is in lipid or lipid water border area - if ((zi.gt.bordlipbot) - &.and.(zi.lt.bordliptop)) then -C the energy transfer exist - if (zi.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((positi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipi=sscalelip(fracinbuf) - ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) - sslipi=sscalelip(fracinbuf) - ssgradlipi=sscagradlip(fracinbuf)/lipbufthick - else - sslipi=1.0d0 - ssgradlipi=0.0 - endif - else - sslipi=0.0d0 - ssgradlipi=0.0 - endif + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) itypj=itype(j) - xj=c(1,nres+j) - yj=c(2,nres+j) - zj=c(3,nres+j) - xj=dmod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=dmod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=dmod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.gt.bordlipbot) - &.and.(zj.lt.bordliptop)) then -C the energy transfer exist - if (zj.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((positi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipj=sscalelip(fracinbuf) - ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) - sslipj=sscalelip(fracinbuf) - ssgradlipj=sscagradlip(fracinbuf)/lipbufthick - else - sslipj=1.0d0 - ssgradlipj=0.0 - endif - else - sslipj=0.0d0 - ssgradlipj=0.0 - endif + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 - - dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - subchap=1 - endif - enddo - enddo - enddo - if (subchap.eq.1) then - xj=xj_temp-xi - yj=yj_temp-yi - zj=zj_temp-zi - else - xj=xj_safe-xi - yj=yj_safe-yi - zj=zj_safe-zi - endif - -C xj=c(1,nres+j)-c(1,nres+i) -C yj=c(2,nres+j)-c(2,nres+i) -C zj=c(3,nres+j)-c(3,nres+i) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -522,9 +456,10 @@ c & "SSBOND_E_FORM",totT,t_bath,i,j c endif #endif #endif - dyn_ssbond_ij(i,j)=eij - else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then - dyn_ssbond_ij(i,j)=1.0d300 + dyn_ssbond_ij(ici,icj)=eij + else if (.not.havebond .and. dyn_ssbond_ij(ici,icj).lt.1.0d300) + &then + dyn_ssbond_ij(ici,icj)=1.0d300 #ifndef CLUST #ifndef WHAM c write(iout,'(a15,f12.2,f8.1,2i5)') @@ -646,16 +581,16 @@ c Includes c Local variables double precision emin integer i,j,imin - integer diff,allflag(maxdim),allnss, - & allihpb(maxdim),alljhpb(maxdim), - & newnss,newihpb(maxdim),newjhpb(maxdim) + integer diff,allflag(maxss),allnss, + & allihpb(maxss),alljhpb(maxss), + & newnss,newihpb(maxss),newjhpb(maxss) logical found integer i_newnss(max_fg_procs),displ(0:max_fg_procs) - integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss + integer g_newihpb(maxss),g_newjhpb(maxss),g_newnss allnss=0 - do i=1,nres-1 - do j=i+1,nres + do i=1,ns-1 + do j=i+1,ns if (dyn_ssbond_ij(i,j).lt.1.0d300) then allnss=allnss+1 allflag(allnss)=0 @@ -2037,7 +1972,7 @@ c$$$ end c$$$ c$$$C----------------------------------------------------------------------------- c$$$C----------------------------------------------------------------------------- - subroutine triple_ssbond_ene(resi,resj,resk,eij) + subroutine triple_ssbond_ene(resi,resj,resk,eij) include 'DIMENSIONS' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' diff --git a/source/unres/src-HCD-5D/stochfric.F b/source/unres/src-HCD-5D/stochfric.F index 368cf97..c83e9ce 100644 --- a/source/unres/src-HCD-5D/stochfric.F +++ b/source/unres/src-HCD-5D/stochfric.F @@ -496,6 +496,10 @@ c------------------------------------------------------------------ double precision time00 #endif include 'DIMENSIONS' +#ifndef FIVEDIAG + integer mmaxres2 + parameter (mmaxres2=(maxres2*(maxres2+1)/2)) +#endif include 'COMMON.VAR' include 'COMMON.CHAIN' include 'COMMON.DERIV' diff --git a/source/unres/src-HCD-5D/test.F b/source/unres/src-HCD-5D/test.F index ac867d9..1ea11ab 100644 --- a/source/unres/src-HCD-5D/test.F +++ b/source/unres/src-HCD-5D/test.F @@ -8,7 +8,7 @@ include 'COMMON.VAR' include 'COMMON.INTERACT' include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' include 'COMMON.SBRIDGE' include 'COMMON.CONTROL' include 'COMMON.FFIELD' @@ -129,7 +129,7 @@ c call write_pdb(999,'full min',etot) include 'COMMON.VAR' include 'COMMON.INTERACT' include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' include 'COMMON.SBRIDGE' include 'COMMON.CONTROL' include 'COMMON.FFIELD' @@ -324,7 +324,7 @@ c------------------------------------------ include 'COMMON.FFIELD' include 'COMMON.MINIM' c - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' integer if(20,maxres),nif,ifa(20) integer ibc(0:maxres,0:maxres),istrand(20) integer ibd(maxres),ifb(10,2),nifb,lifb(10),lifb0 @@ -1032,7 +1032,7 @@ c-------------------------------------------------------- include 'COMMON.FFIELD' include 'COMMON.MINIM' c - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' integer if(3,maxres),nif integer ibc(maxres,maxres),istrand(20) integer ibd(maxres),ifb(10,2),nifb,lifb(10),lifb0 @@ -1225,7 +1225,7 @@ c include 'COMMON.FFIELD' include 'COMMON.MINIM' c - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' integer if(2,2),ind integer iff(maxres) double precision time0,time1 @@ -1359,11 +1359,11 @@ c------------------------------------------------- include 'DIMENSIONS' include 'COMMON.CHAIN' include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' +c include 'COMMON.DISTFIT' - integer ncont,icont(2,maxres*maxres/2),isec(maxres,3) + integer ncont,icont(2,maxres*maxint_res),isec(maxres,3) logical lprint,not_done - real dcont(maxres*maxres/2),d + real dcont(maxres*maxint_res),d real rcomp /7.0/ real rbeta /5.2/ real ralfa /5.2/ @@ -1709,152 +1709,3 @@ c---------------------------------------------------------------------------- end c----------------------------------------------------------- - subroutine contact_cp2(var,var2,iff,ieval,in_pdb) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.MINIM' - - character*50 linia - integer nf,ij(4) - double precision var(maxvar),var2(maxvar) - double precision time0,time1 - integer iff(maxres),ieval - double precision theta1(maxres),phi1(maxres),alph1(maxres), - & omeg1(maxres) - - - call var_to_geom(nvar,var) - call chainbuild - nhpb0=nhpb - ind=0 - do i=1,nres-3 - do j=i+3,nres - ind=ind+1 - if ( iff(i).eq.1.and.iff(j).eq.1 ) then - d0(ind)=DIST(i,j) - w(ind)=10.0 - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=10.0 - dhpb(nhpb)=d0(ind) - else - w(ind)=0.0 - endif - enddo - enddo - call hpb_partition - - do i=1,nres - theta1(i)=theta(i) - phi1(i)=phi(i) - alph1(i)=alph(i) - omeg1(i)=omeg(i) - enddo - - call var_to_geom(nvar,var2) - - do i=1,nres - if ( iff(i).eq.1 ) then - theta(i)=theta1(i) - phi(i)=phi1(i) - alph(i)=alph1(i) - omeg(i)=omeg1(i) - endif - enddo - - call chainbuild -cd call write_pdb(3,'combined structure',0d0) -cd time0=MPI_WTIME() - - NX=NRES-3 - NY=((NRES-4)*(NRES-5))/2 - call distfit(.true.,200) - -cd time1=MPI_WTIME() -cd write (iout,'(a,f6.2,a)') ' Time for distfit ',time1-time0,' sec' - - ipot0=ipot - maxmin0=maxmin - maxfun0=maxfun - wstrain0=wstrain - - ipot=6 - maxmin=2000 - maxfun=5000 - call geom_to_var(nvar,var) -cd time0=MPI_WTIME() - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun - -cd time1=MPI_WTIME() -cd write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0, -cd & nfun/(time1-time0),' SOFT eval/s' - call var_to_geom(nvar,var) - call chainbuild - - - iwsk=0 - nf=0 - if (iff(1).eq.1) then - iwsk=1 - nf=nf+1 - ij(nf)=0 - endif - do i=2,nres - if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then - iwsk=1 - nf=nf+1 - ij(nf)=i - endif - if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then - iwsk=0 - nf=nf+1 - ij(nf)=i-1 - endif - enddo - if (iff(nres).eq.1) then - nf=nf+1 - ij(nf)=nres - endif - - -cd write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)') -cd & "select",ij(1),"-",ij(2), -cd & ",",ij(3),"-",ij(4) -cd call write_pdb(in_pdb,linia,etot) - - - ipot=ipot0 - maxmin=maxmin0 - maxfun=maxfun0 -cd time0=MPI_WTIME() - call minimize(etot,var,iretcode,nfun) -cd write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun - ieval=nfun - -cd time1=MPI_WTIME() -cd write (iout,'(a,f6.2,f8.2,a)')' Time for DIST min.',time1-time0, -cd & nfun/(time1-time0),' eval/s' -cd call var_to_geom(nvar,var) -cd call chainbuild -cd call write_pdb(6,'dist structure',etot) - - - nhpb= nhpb0 - link_start=1 - link_end=nhpb - wstrain=wstrain0 - - return - end -c----------------------------------------------------------- diff --git a/source/wham/src-HCD/COMMON.HOMOLOGY b/source/wham/src-HCD/COMMON.HOMOLOGY index 03740bf..ea57f19 100644 --- a/source/wham/src-HCD/COMMON.HOMOLOGY +++ b/source/wham/src-HCD/COMMON.HOMOLOGY @@ -5,4 +5,4 @@ & dist2_cut common /homol/ waga_homology(maxR), & waga_dist,waga_angle,waga_theta,waga_d,dist_cut,dist2_cut, - & iset,ihset,l_homo(max_template,maxdim) + & iset,ihset,l_homo(max_template,maxdim_cont) diff --git a/source/wham/src-HCD/COMMON.HOMRESTR b/source/wham/src-HCD/COMMON.HOMRESTR index 95ea932..0e558f1 100644 --- a/source/wham/src-HCD/COMMON.HOMRESTR +++ b/source/wham/src-HCD/COMMON.HOMRESTR @@ -1,6 +1,7 @@ - real*8 odl(max_template,maxdim),sigma_odl(max_template,maxdim), + real*8 odl(max_template,maxdim_cont), + & sigma_odl(max_template,maxdim_cont), & dih(max_template,maxres),sigma_dih(max_template,maxres), - & sigma_odlir(max_template,maxdim) + & sigma_odlir(max_template,maxdim_cont) c c Specification of new variables used in subroutine e_modeller c modified by FP (Nov.,2014) @@ -10,7 +11,7 @@ c modified by FP (Nov.,2014) & sigma_d(max_template,maxres) c - integer ires_homo(maxdim),jres_homo(maxdim) + integer ires_homo(maxdim_cont),jres_homo(maxdim_cont) double precision & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst, diff --git a/source/wham/src-HCD/COMMON.SHIELD b/source/wham/src-HCD/COMMON.SHIELD index 1f96c94..8d89f0b 100644 --- a/source/wham/src-HCD/COMMON.SHIELD +++ b/source/wham/src-HCD/COMMON.SHIELD @@ -5,10 +5,11 @@ common /shield/ VSolvSphere,VSolvSphere_div,buff_shield, & long_r_sidechain(ntyp), & short_r_sidechain(ntyp),fac_shield(maxres),wshield, - & grad_shield_side(3,maxcont,-1:maxres),grad_shield(3,-1:maxres), - & grad_shield_loc(3,maxcont,-1:maxres), - & ishield_list(maxres),shield_list(maxcont,maxres), - & ees0plist(maxcont,maxres) + & grad_shield_side(3,maxint_res,-1:maxres), + & grad_shield(3,-1:maxres), + & grad_shield_loc(3,maxint_res,-1:maxres), + & ishield_list(maxres),shield_list(maxint_res,maxres), + & ees0plist(maxint_res,maxres) diff --git a/source/wham/src-HCD/DIMENSIONS b/source/wham/src-HCD/DIMENSIONS index 4d690f3..65b3e75 100644 --- a/source/wham/src-HCD/DIMENSIONS +++ b/source/wham/src-HCD/DIMENSIONS @@ -15,16 +15,19 @@ C Max. number of AA residues integer maxres c parameter (maxres=250) c parameter (maxres=1200) - parameter (maxres=5000) + parameter (maxres=10000) +C Max. number of cysteines and other bridging residues + integer max_cyst + parameter (max_cyst=100) C Appr. max. number of interaction sites integer maxres2 parameter (maxres2=2*maxres) c Max. number of chains integer maxchain - parameter (maxchain=6) + parameter (maxchain=50) C Max number of symetries integer maxsym,maxperm - parameter (maxsym=maxchain,maxperm=720) + parameter (maxsym=maxchain,maxperm=120) C Max. number of variables integer maxvar parameter (maxvar=4*maxres) @@ -42,6 +45,16 @@ C Max. number of SC contacts C Max. number of contacts per residue integer maxconts parameter (maxconts=maxres) +C Max. number of interactions within cutoff per residue + integer maxint_res + parameter (maxint_res=200) +C Max. number od residues within distance cufoff from a given residue to +C include in template-based/contact distance restraints. + integer maxcont_res + parameter (maxcont_res=200) +C Max. number of distance/contact-distance restraints + integer maxdim_cont + parameter (maxdim_cont=maxres*maxcont_res) C Number of AA types (at present only natural AA's will be handled integer ntyp,ntyp1 parameter (ntyp=24,ntyp1=ntyp+1) @@ -71,7 +84,7 @@ C Max. number of lobes in SC distribution parameter (maxlob=4) C Max. number of S-S bridges integer maxss - parameter (maxss=20) + parameter (maxss=max_cyst*(max_cyst-1)/2) C Max. number of dihedral angle constraints integer maxdih_constr parameter (maxdih_constr=maxres) diff --git a/source/wham/src-HCD/Makefile-tryton b/source/wham/src-HCD/Makefile-tryton new file mode 100644 index 0000000..b595c21 --- /dev/null +++ b/source/wham/src-HCD/Makefile-tryton @@ -0,0 +1,162 @@ +BIN = ~/unres/bin +FC = mpif90 -fc=ifort +OPT = -mcmodel=medium -shared-intel -O3 +#OPT = -O3 -intel-static -mcmodel=medium +#OPT = -O3 -ip -w +#OPT = -g -CB -mcmodel=medium -shared-intel +FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include +LIBS = -L$(INSTALL_DIR)/lib -lmpi xdrf/libxdrf.a + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + +objects = \ + wham_multparm.o \ + bxread.o \ + xread.o \ + cxread.o \ + enecalc1.o \ + energy_p_new.o \ + boxshift.o \ + gnmr1.o \ + initialize_p.o \ + molread_zs.o \ + openunits.o \ + readrtns.o \ + read_constr_homology.o \ + arcos.o \ + cartprint.o \ + chainbuild.o \ + geomout.o \ + icant.o \ + intcor.o \ + int_from_cart.o \ + refsys.o \ + make_ensemble1.o \ + matmult.o \ + misc.o \ + mygetenv.o \ + parmread.o \ + permut.o \ + seq2chains.o \ + chain_symmetry.o \ + iperm.o \ + pinorm.o \ + printmat.o \ + proc_proc.o \ + rescode.o \ + setup_var.o \ + slices.o \ + store_parm.o \ + timing.o \ + wham_calc1.o \ + PMFprocess.o \ + ssMD.o \ + oligomer.o + +objects_compar = \ + readrtns_compar.o \ + readpdb.o fitsq.o contact.o \ + elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ + angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ + rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o + +all: no_option + @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR" + +no_option: + +GAB: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM +GAB: ${objects} ${objects_compar} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD.exe + +GAB_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM -DDFA +GAB_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD-DFA.exe + +4P: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM +4P: ${objects} ${objects_compar} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD.exe + +4P_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM -DDFA +4P_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD-DFA.exe + +E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DFOURBODY -DAMD64 -DWHAM +E0LL2Y: ${objects} ${objects_compar} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD.exe + +E0LL2Y_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DFOURBODY -DAMD64 -DWHAM -DDFA +E0LL2Y_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD-DFA.exe + +NEWCORR: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DPGI -DISNAN -DAMD64 -DWHAM +NEWCORR: ${objects} ${objects_compar} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD.exe + +NEWCORR5D: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DPGI -DISNAN -DAMD64 -DWHAM -DFIVEDIAG +NEWCORR5D: ${objects} ${objects_compar} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -Wl,-M -o ${BIN}/wham_ifort_MPICH-tryton-HCD5-D.exe + +NEWCORR_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DDFA -DPGI -DISNAN -DAMD64 -DWHAM -DDFA +NEWCORR_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD-DFA-D.exe + +NEWCORR5D_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DDFA -DPGI -DISNAN -DAMD64 -DWHAM -DFIVEDIAG -DDFA +NEWCORR5D_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-tryton-HCD5-DFA.exe + +xdrf/libxdrf.a: + cd xdrf && make + + +clean: + /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean + diff --git a/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos b/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos index e667382..b04295c 100644 --- a/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos +++ b/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos @@ -20,6 +20,7 @@ objects = \ cxread.o \ enecalc1.o \ energy_p_new.o \ + boxshift.o \ gnmr1.o \ initialize_p.o \ molread_zs.o \ @@ -27,7 +28,6 @@ objects = \ readrtns.o \ read_constr_homology.o \ arcos.o \ - cartder.o \ cartprint.o \ chainbuild.o \ geomout.o \ diff --git a/source/wham/src-HCD/boxshift.f b/source/wham/src-HCD/boxshift.f new file mode 100644 index 0000000..29d3406 --- /dev/null +++ b/source/wham/src-HCD/boxshift.f @@ -0,0 +1,101 @@ + +c------------------------------------------------------------------------ + double precision function boxshift(x,boxsize) + implicit none + double precision x,boxsize + double precision xtemp + xtemp=dmod(x,boxsize) + if (dabs(xtemp-boxsize).lt.dabs(xtemp)) then + boxshift=xtemp-boxsize + else if (dabs(xtemp+boxsize).lt.dabs(xtemp)) then + boxshift=xtemp+boxsize + else + boxshift=xtemp + endif + return + end +c-------------------------------------------------------------------------- + subroutine closest_img(xi,yi,zi,xj,yj,zj) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + integer xshift,yshift,zshift,subchap + double precision dist_init,xj_safe,yj_safe,zj_safe, + & xj_temp,yj_temp,zj_temp,dist_temp + xj_safe=xj + yj_safe=yj + zj_safe=zj + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + return + end +c-------------------------------------------------------------------------- + subroutine to_box(xi,yi,zi) + implicit none + include 'DIMENSIONS' + include 'COMMON.CHAIN' + double precision xi,yi,zi + xi=dmod(xi,boxxsize) + if (xi.lt.0.0d0) xi=xi+boxxsize + yi=dmod(yi,boxysize) + if (yi.lt.0.0d0) yi=yi+boxysize + zi=dmod(zi,boxzsize) + if (zi.lt.0.0d0) zi=zi+boxzsize + return + end +c-------------------------------------------------------------------------- + subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi) + implicit none + include 'DIMENSIONS' + include 'COMMON.CHAIN' + double precision xi,yi,zi,sslipi,ssgradlipi + double precision fracinbuf + double precision sscalelip,sscagradlip + + if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then +C the energy transfer exist + if (zi.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + return + end diff --git a/source/wham/src-HCD/cxread.F b/source/wham/src-HCD/cxread.F index cd29176..36ef6e6 100644 --- a/source/wham/src-HCD/cxread.F +++ b/source/wham/src-HCD/cxread.F @@ -171,8 +171,12 @@ c call flush(iout) c(j,i+nres+nnt-1)=xoord(j,i+nres) enddo enddo +c write (iout,*) "Before boxshift" +c call flush(iout) c Box shift call oligomer +c write (iout,*) "After oligomer" +c call flush(iout) do i=1,nres do j=1,3 xoord(j,i)=c(j,i) @@ -184,7 +188,8 @@ c Box shift enddo enddo c end change - +c write (iout,*) "Before islice" +c call flush(iout) if (islice.gt.0 .and. islice.le.nslice .and. (.not.separate_parset & .or. iset.eq.myparm)) then ii=ii+1 diff --git a/source/wham/src-HCD/enecalc1.F b/source/wham/src-HCD/enecalc1.F index 0040e37..60addc7 100644 --- a/source/wham/src-HCD/enecalc1.F +++ b/source/wham/src-HCD/enecalc1.F @@ -163,8 +163,8 @@ C write (iout,*) "tuz przed energia" C write (iout,*) "tuz za energia" #ifdef DEBUG write (iout,*) "Conformation",i -c write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), -c & ((c(l,k+nres),l=1,3),k=nnt,nct) + write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), + & ((c(l,k+nres),l=1,3),k=nnt,nct) call enerprint(energia(0),fT) c write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21) c write (iout,*) "ftors(1)",ftors(1) @@ -200,6 +200,8 @@ c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) if (ipar.eq.iparm) write (iout,*) i,iparm, & 1.0d0/(beta_h(ib,ipar)*1.987D-3),eini,energia(0) #endif +c write (iout,*) "eini",eini,"energia(0)",energia(0)," diff", +c & eini-energia(0) if (ipar.eq.iparm .and. einicheck.gt.0 .and. ! & dabs(eini-energia(0)-energia(27)).gt.tole) then & dabs(eini-energia(0)).gt.tole) then @@ -213,8 +215,8 @@ c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), & ((c(l,k+nres),l=1,3),k=nnt,nct) c call intout -c call pdbout(indstart(me1)+iii, -c & 1.0d0/(1.987D-3*beta_h(ib,ipar)),energia(0),eini,0.0d0,0.0d0) + call pdbout(indstart(me1)+iii, + & 1.0d0/(1.987D-3*beta_h(ib,ipar)),energia(0),eini,0.0d0,0.0d0) call enerprint(energia(0),fT) errmsg_count=errmsg_count+1 if (errmsg_count.gt.maxerrmsg_count) @@ -262,6 +264,7 @@ c call enerprint(energia(0),fT) iii=iii+1 if (q(1,iii).le.0.0d0 .and. indpdb.gt.0) & q(1,iii)=qwolynes(0,0,ipermin) +c write (iout,*) "iii",iii," q",q(1,iii) write (ientout,rec=iii) & ((csingle(l,k),l=1,3),k=1,nres), & ((csingle(l,k+nres),l=1,3),k=nnt,nct), diff --git a/source/wham/src-HCD/energy_p_new.F b/source/wham/src-HCD/energy_p_new.F index 6105156..ce7a6a7 100644 --- a/source/wham/src-HCD/energy_p_new.F +++ b/source/wham/src-HCD/energy_p_new.F @@ -159,6 +159,7 @@ c write (iout,*) "Calling multibody_hbond" call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) endif #endif +c write (iout,*) "nsaxs",nsaxs c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr if (nsaxs.gt.0 .and. saxs_mode.eq.0) then call e_saxs(Esaxs_constr) @@ -192,8 +193,12 @@ c write(iout,*)'edfan is finished!', wdfa_nei,edfanei edfabet=0.0d0 if (wdfa_beta.gt.0) call edfab(edfabet) c write(iout,*)'edfab is finished!', wdfa_beta,edfabet +#else + edfadis=0.0d0 + edfator=0.0d0 + edfanei=0.0d0 + edfabet=0.0d0 #endif - c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t #ifdef SPLITELE if (shield_mode.gt.0) then @@ -515,6 +520,9 @@ C Bartek edfator = energia(29) edfanei = energia(30) edfabet = energia(31) + Eafmforc=0.0d0 + etube=0.0d0 + Uconst=0.0d0 #ifdef SPLITELE write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp, & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1), @@ -680,6 +688,7 @@ cROZNICA xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) C Change 12/1/95 num_conti=0 C @@ -694,6 +703,10 @@ cd & 'iend=',iend(i,iint) xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) C Change 12/1/95 to calculate four-body interactions rij=xj*xj+yj*yj+zj*zj rrij=1.0D0/rij @@ -865,6 +878,7 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) C C Calculate SC interaction energy. C @@ -875,6 +889,10 @@ C xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) fac_augm=rrij**expon e_augm=augm(itypi,itypj)*fac_augm @@ -982,6 +1000,7 @@ c endif xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1014,9 +1033,13 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -1128,35 +1151,8 @@ c if (icall.gt.0) lprn=.true. yi=c(2,nres+i) zi=c(3,nres+i) C returning the ith atom to box - xi=mod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=mod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=mod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize - if ((zi.gt.bordlipbot) - &.and.(zi.lt.bordliptop)) then -C the energy transfer exist - if (zi.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((zi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipi=sscalelip(fracinbuf) - ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) - sslipi=sscalelip(fracinbuf) - ssgradlipi=sscagradlip(fracinbuf)/lipbufthick - else - sslipi=1.0d0 - ssgradlipi=0.0 - endif - else - sslipi=0.0d0 - ssgradlipi=0.0 - endif - + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1214,80 +1210,15 @@ c alf12=0.0D0 yj=c(2,nres+j) zj=c(3,nres+j) C returning jth atom to box - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.gt.bordlipbot) - &.and.(zj.lt.bordliptop)) then -C the energy transfer exist - if (zj.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((zj-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipj=sscalelip(fracinbuf) - ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick - elseif (zj.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) - sslipj=sscalelip(fracinbuf) - ssgradlipj=sscagradlip(fracinbuf)/lipbufthick - else - sslipj=1.0d0 - ssgradlipj=0.0 - endif - else - sslipj=0.0d0 - ssgradlipj=0.0 - endif - aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 - bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 -C if (aa.ne.aa_aq(itypi,itypj)) then - -C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa, -C & bb_aq(itypi,itypj)-bb, -C & sslipi,sslipj -C endif - -C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj) -C checking the distance - dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 -C finding the closest - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - subchap=1 - endif - enddo - enddo - enddo - if (subchap.eq.1) then - xj=xj_temp-xi - yj=yj_temp-yi - zj=zj_temp-zi - else - xj=xj_safe-xi - yj=yj_safe-yi - zj=zj_safe-zi - endif - + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -1413,6 +1344,8 @@ c if (icall.gt.0) lprn=.true. xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1447,9 +1380,21 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 +C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5') +C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj)) +C write(iout,*) "tu,", i,j,aa,bb,aa_lip(itypi,itypj),sslipi,sslipj + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -2271,12 +2216,7 @@ c end if xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi - xmedi=mod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=mod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=mod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize + call to_box(xmedi,ymedi,zmedi) num_conti=0 call eelecij(i,i+2,ees,evdw1,eel_loc) if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) @@ -2306,37 +2246,7 @@ c & .or. itype(i-1).eq.ntyp1 xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi -C Return atom into box, boxxsize is size of box in x dimension -c 194 continue -c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize -c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize -C Condition for being inside the proper box -c if ((xmedi.gt.((0.5d0)*boxxsize)).or. -c & (xmedi.lt.((-0.5d0)*boxxsize))) then -c go to 194 -c endif -c 195 continue -c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize -c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize -C Condition for being inside the proper box -c if ((ymedi.gt.((0.5d0)*boxysize)).or. -c & (ymedi.lt.((-0.5d0)*boxysize))) then -c go to 195 -c endif -c 196 continue -c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize -c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize -C Condition for being inside the proper box -c if ((zmedi.gt.((0.5d0)*boxzsize)).or. -c & (zmedi.lt.((-0.5d0)*boxzsize))) then -c go to 196 -c endif - xmedi=mod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=mod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=mod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize + call to_box(xmedi,ymedi,zmedi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -2376,43 +2286,7 @@ c & .or. itype(i-1).eq.ntyp1 xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi - xmedi=mod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=mod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=mod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize -C xmedi=xmedi+xshift*boxxsize -C ymedi=ymedi+yshift*boxysize -C zmedi=zmedi+zshift*boxzsize - -C Return tom into box, boxxsize is size of box in x dimension -c 164 continue -c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize -c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize -C Condition for being inside the proper box -c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or. -c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then -c go to 164 -c endif -c 165 continue -c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize -c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize -C Condition for being inside the proper box -c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or. -c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then -c go to 165 -c endif -c 166 continue -c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize -c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize -cC Condition for being inside the proper box -c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or. -c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then -c go to 166 -c endif - -c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) + call to_box(xmedi,ymedi,zmedi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -2518,73 +2392,10 @@ C zj=c(3,j)+0.5D0*dzj-zmedi xj=c(1,j)+0.5D0*dxj yj=c(2,j)+0.5D0*dyj zj=c(3,j)+0.5D0*dzj - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ" - dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - isubchap=0 - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - isubchap=1 - endif - enddo - enddo - enddo - if (isubchap.eq.1) then - xj=xj_temp-xmedi - yj=yj_temp-ymedi - zj=zj_temp-zmedi - else - xj=xj_safe-xmedi - yj=yj_safe-ymedi - zj=zj_safe-zmedi - endif -C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC -c 174 continue -c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize -c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize -C Condition for being inside the proper box -c if ((xj.gt.((0.5d0)*boxxsize)).or. -c & (xj.lt.((-0.5d0)*boxxsize))) then -c go to 174 -c endif -c 175 continue -c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize -c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize -C Condition for being inside the proper box -c if ((yj.gt.((0.5d0)*boxysize)).or. -c & (yj.lt.((-0.5d0)*boxysize))) then -c go to 175 -c endif -c 176 continue -c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize -c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize -C Condition for being inside the proper box -c if ((zj.gt.((0.5d0)*boxzsize)).or. -c & (zj.lt.((-0.5d0)*boxzsize))) then -c go to 176 -c endif -C endif !endPBC condintion -C xj=xj-xmedi -C yj=yj-ymedi -C zj=zj-zmedi + call to_box(xj,yj,zj) + xj=boxshift(xj-xmedi,boxxsize) + yj=boxshift(yj-ymedi,boxysize) + zj=boxshift(zj-zmedi,boxzsize) rij=xj*xj+yj*yj+zj*zj sss=sscale(sqrt(rij)) @@ -4075,13 +3886,7 @@ c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) zi=0.5D0*(c(3,i)+c(3,i+1)) -C Returning the ith atom to box - xi=mod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=mod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=mod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize + call to_box(xi,yi,zi) do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) @@ -4096,44 +3901,10 @@ C Uncomment following three lines for Ca-p interactions yj=c(2,j) zj=c(3,j) C returning the jth atom to box - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 -C Finding the closest jth atom - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - subchap=1 - endif - enddo - enddo - enddo - if (subchap.eq.1) then - xj=xj_temp-xi - yj=yj_temp-yi - zj=zj_temp-zi - else - xj=xj_safe-xi - yj=yj_safe-yi - zj=zj_safe-zi - endif + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) C sss is scaling function for smoothing the cutoff gradient otherwise C the gradient would not be continuouse diff --git a/source/wham/src-HCD/include_unres/COMMON.CALC b/source/wham/src-HCD/include_unres/COMMON.CALC index 67b4bb9..bf255c9 100644 --- a/source/wham/src-HCD/include_unres/COMMON.CALC +++ b/source/wham/src-HCD/include_unres/COMMON.CALC @@ -5,11 +5,11 @@ & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg + & dsci_inv,dscj_inv,gg,gg_lipi,gg_lipj common /calc/ erij(3),rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj, & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12, & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1, & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg(3),i,j + & dsci_inv,dscj_inv,gg(3),gg_lipi(3),gg_lipj(3),i,j diff --git a/source/wham/src-HCD/include_unres/COMMON.CONTMAT b/source/wham/src-HCD/include_unres/COMMON.CONTMAT index f0b6122..6e5b5d5 100644 --- a/source/wham/src-HCD/include_unres/COMMON.CONTMAT +++ b/source/wham/src-HCD/include_unres/COMMON.CONTMAT @@ -17,8 +17,9 @@ C 12/26/95 - H-bonding contacts & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), & ees0m(maxconts,maxres),d_cont(maxconts,maxres), & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions + double precision a_chuj,a_chuj_der + common /dipmat/ a_chuj(2,2,maxconts,maxres), + & a_chuj_der(2,2,3,5,maxconts,maxres) c 7/25/08 Commented out; not needed when cumulants used C Interactions of pseudo-dipoles generated by loc-el interactions. c double precision dip,dipderg,dipderx diff --git a/source/wham/src-HCD/include_unres/COMMON.CORRMAT b/source/wham/src-HCD/include_unres/COMMON.CORRMAT index 5f154e0..ae25625 100644 --- a/source/wham/src-HCD/include_unres/COMMON.CORRMAT +++ b/source/wham/src-HCD/include_unres/COMMON.CORRMAT @@ -30,9 +30,6 @@ C consecutive amino-acid residues. & costab2(maxres),sintab2(maxres) C This common block contains dipole-interaction matrices and their C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, & AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont,EAEA,EAEAderg,EAEAderx, diff --git a/source/wham/src-HCD/include_unres/COMMON.DERIV b/source/wham/src-HCD/include_unres/COMMON.DERIV index b694524..07bafe4 100644 --- a/source/wham/src-HCD/include_unres/COMMON.DERIV +++ b/source/wham/src-HCD/include_unres/COMMON.DERIV @@ -15,7 +15,9 @@ & gdfad,gdfat,gdfan,gdfab integer nfl,icg logical calc_grad - common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), +c common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), +c 3/12/20 Adam: Arrays dcdv, dxdv, and dxds removed following recoding of gradient. + common /derivat/ & gradx(3,-1:maxres,2),gradc(3,-1:maxres,2),gvdwx(3,-1:maxres), & gvdwc(3,-1:maxres),gelc(3,-1:maxres),gelc_long(3,-1:maxres), & gvdwpp(3,-1:maxres),gvdwc_scpp(3,-1:maxres), diff --git a/source/wham/src-HCD/include_unres/COMMON.SBRIDGE b/source/wham/src-HCD/include_unres/COMMON.SBRIDGE index 7facbfe..a313d8f 100644 --- a/source/wham/src-HCD/include_unres/COMMON.SBRIDGE +++ b/source/wham/src-HCD/include_unres/COMMON.SBRIDGE @@ -1,20 +1,22 @@ double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss - integer ns,nss,nfree,iss + integer ns,nss,nfree,iss,icys common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, - & ns,nss,nfree,iss(maxss) + & ns,nss,nfree,iss(maxss),icys(maxres) double precision dhpb,dhpb1,forcon,fordepth,xlscore,wboltzd, & dhpb_peak,dhpb1_peak,forcon_peak,fordepth_peak,scal_peak,bfac integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb,ibecarb_peak,npeak, & ipeak,irestr_type,irestr_type_peak,ihpb_peak,jhpb_peak,nhpb_peak logical restr_on_coord - common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), - & fordepth(maxdim),bfac(maxres),xlscore(maxdim),wboltzd, - & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),irestr_type(maxdim), + common /links/ dhpb(maxdim_cont),dhpb1(maxdim_cont), + & forcon(maxdim_cont),fordepth(maxdim_cont),bfac(maxres), + & xlscore(maxdim_cont),wboltzd,ihpb(maxdim_cont),jhpb(maxdim_cont), + & ibecarb(maxdim_cont),irestr_type(maxdim_cont), & nhpb,restr_on_coord - common /NMRpeaks/ dhpb_peak(maxdim),dhpb1_peak(maxdim), - & forcon_peak(maxdim),fordepth_peak(maxdim),scal_peak, - & ihpb_peak(maxdim),jhpb_peak(maxdim),ibecarb_peak(maxdim), - & irestr_type_peak(maxdim),ipeak(2,maxdim),npeak,nhpb_peak + common /NMRpeaks/ dhpb_peak(maxdim_cont),dhpb1_peak(maxdim_cont), + & forcon_peak(maxdim_cont),fordepth_peak(maxdim_cont),scal_peak, + & ihpb_peak(maxdim_cont),jhpb_peak(maxdim_cont), + & ibecarb_peak(maxdim_cont),irestr_type_peak(maxdim_cont), + & ipeak(2,maxdim_cont),npeak,nhpb_peak double precision weidis common /restraints/ weidis integer link_start,link_end,link_start_peak,link_end_peak @@ -23,7 +25,7 @@ double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss logical dyn_ss,dyn_ss_mask common /dyn_ssbond/ dtriss,atriss,btriss,ctriss,Ht, - & dyn_ssbond_ij(maxres,maxres), - & idssb(maxdim),jdssb(maxdim) + & dyn_ssbond_ij(max_cyst,max_cyst), + & idssb(maxss),jdssb(maxss) common /dyn_ss_logic/ & dyn_ss,dyn_ss_mask(maxres) diff --git a/source/wham/src-HCD/initialize_p.F b/source/wham/src-HCD/initialize_p.F index baf3aa2..a2281e5 100644 --- a/source/wham/src-HCD/initialize_p.F +++ b/source/wham/src-HCD/initialize_p.F @@ -183,7 +183,7 @@ C Initialize the bridge arrays do i=1,maxss iss(i)=0 enddo - do i=1,maxdim + do i=1,maxdim_cont dhpb(i)=0.0D0 enddo do i=1,maxres @@ -396,7 +396,7 @@ c--------------------------------------------------------------------------- include 'COMMON.IOUNITS' include "COMMON.TORCNSTR" logical scheck,lprint - lprint=.false. + lprint=.true. do i=1,maxres nint_gr(i)=0 nscp_gr(i)=0 diff --git a/source/wham/src-HCD/molread_zs.F b/source/wham/src-HCD/molread_zs.F index 878e4dd..e1a64f3 100644 --- a/source/wham/src-HCD/molread_zs.F +++ b/source/wham/src-HCD/molread_zs.F @@ -79,7 +79,7 @@ C Convert sequence to numeric code chain_border1(1,i)=chain_border(1,i)-1 chain_border1(2,i)=chain_border(2,i)+1 enddo - chain_border1(1,nchain)=chain_border(1,nchain)-1 + if (nchain.gt.1) chain_border1(1,nchain)=chain_border(1,nchain)-1 chain_border1(2,nchain)=nres write(iout,*) "nres",nres," nchain",nchain do i=1,nchain @@ -260,6 +260,7 @@ c call flush(iout) endif call setup_var + write (iout,*) "Calling init_int_table" call init_int_table if (ns.gt.0) then write (iout,'(/a,i3,a)') 'The chain contains',ns, @@ -332,6 +333,12 @@ C Read bridging residues. read (inp,*) ns,(iss(i),i=1,ns) print *,'ns=',ns write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns) +c 5/24/2020 Adam: Added a table to translate residue numbers to cysteine +c numbers + icys=0 + do i=1,ns + icys(iss(i))=i + enddo C Check whether the specified bridging residues are cystines. do i=1,ns if (itype(iss(i)).ne.1) then diff --git a/source/wham/src-HCD/parmread.F b/source/wham/src-HCD/parmread.F index ecf40a7..b21acb2 100644 --- a/source/wham/src-HCD/parmread.F +++ b/source/wham/src-HCD/parmread.F @@ -102,8 +102,8 @@ c V2SS = 7.61d0 V3SS = 13.7d0 - do i=1,maxres-1 - do j=i+1,maxres + do i=1,max_cyst-1 + do j=i+1,max_cyst dyn_ssbond_ij(i,j)=1.0d300 enddo enddo diff --git a/source/wham/src-HCD/readpdb.F b/source/wham/src-HCD/readpdb.F index 6f4ba5f..9efc6db 100644 --- a/source/wham/src-HCD/readpdb.F +++ b/source/wham/src-HCD/readpdb.F @@ -70,7 +70,7 @@ C geometry. sccalc=.true. endif ! Read free energy - if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp +c if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp ! Fish out the ATOM cards. if (index(card(1:4),'ATOM').gt.0) then sccalc=.false. diff --git a/source/wham/src-HCD/readrtns.F b/source/wham/src-HCD/readrtns.F index e7effcd..bca3771 100644 --- a/source/wham/src-HCD/readrtns.F +++ b/source/wham/src-HCD/readrtns.F @@ -95,6 +95,8 @@ c Cutoff range for interactions call reada(controlcard,"R_CUT",r_cut,25.0d0) call reada(controlcard,"LAMBDA",rlamb,0.3d0) + write (iout,*) "Cutoff on interactions",r_cut + write (iout,*) "lambda",rlamb call reada(controlcard,"LIPTHICK",lipthick,0.0d0) call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0) unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0 diff --git a/source/wham/src-HCD/ssMD.F b/source/wham/src-HCD/ssMD.F index ba32ff0..4ce1b3d 100644 --- a/source/wham/src-HCD/ssMD.F +++ b/source/wham/src-HCD/ssMD.F @@ -82,12 +82,10 @@ ct rij=ran_number(rmin,rmax) end C----------------------------------------------------------------------------- - subroutine dyn_ssbond_ene(resi,resj,eij) -c implicit none - -c Includes + implicit none include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -96,9 +94,10 @@ c Includes include 'COMMON.VAR' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.NAMES' #ifndef CLUST #ifndef WHAM -C include 'COMMON.MD' + include 'COMMON.MD' #endif #endif @@ -128,6 +127,10 @@ c integer itypi,itypj,k,l double precision omega,delta_inv,deltasq_inv,fac1,fac2 c-------FIRST METHOD double precision xm,d_xm(1:3) + double precision sslipi,sslipj,ssgradlipi,ssgradlipj + integer ici,icj,itypi,itypj + double precision boxshift,sscale,sscagrad + double precision aa,bb c-------END FIRST METHOD c-------SECOND METHOD c$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3) @@ -138,13 +141,21 @@ c-------TESTING CODE common /sschecks/ checkstop,transgrad integer icheck,nicheck,jcheck,njcheck - double precision echeck(-1:1),deps,ssx0,ljx0 + double precision echeck(-1:1),deps,ssx0,ljx0,xi,yi,zi c-------END TESTING CODE i=resi j=resj - + ici=icys(i) + icj=icys(j) + if (ici.eq.0 .or. icj.eq.0) then + write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') + & "Attempt to create", + & " a disulfide link between non-cysteine residues ",restyp(i),i, + & restyp(j),j + stop + endif itypi=itype(i) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) @@ -153,73 +164,27 @@ c-------END TESTING CODE xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) - xi=mod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=mod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=mod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize - if ((zi.gt.bordlipbot) - &.and.(zi.lt.bordliptop)) then -C the energy transfer exist - if (zi.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((zi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipi=sscalelip(fracinbuf) - ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick - elseif (zi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) - sslipi=sscalelip(fracinbuf) - ssgradlipi=sscagradlip(fracinbuf)/lipbufthick - else - sslipi=1.0d0 - ssgradlipi=0.0 - endif - else - sslipi=0.0d0 - ssgradlipi=0.0 - endif + call to_box(xi,yi,zi) +C define scaling factor for lipids + +C if (positi.le.0) positi=positi+boxzsize +C print *,i +C first for peptide groups +c for each residue check if it is in lipid or lipid water border area + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) itypj=itype(j) xj=c(1,nres+j) yj=c(2,nres+j) zj=c(3,nres+j) - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - if ((zj.gt.bordlipbot) - &.and.(zj.lt.bordliptop)) then -C the energy transfer exist - if (zj.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((zj-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslipj=sscalelip(fracinbuf) - ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick - elseif (zj.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) - sslipj=sscalelip(fracinbuf) - ssgradlipj=sscagradlip(fracinbuf)/lipbufthick - else - sslipj=1.0d0 - ssgradlipj=0.0 - endif - else - sslipj=0.0d0 - ssgradlipj=0.0 - endif + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 - xj=xj-xi - yj=yj-yi - zj=zj-zi + & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -237,6 +202,8 @@ C lipbufthick is thickenes of lipid buffore rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse + sss=sscale((1.0d0/rij)/sigma(itypi,itypj)) + sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj)) c The following are set in sc_angular c erij(1)=xj*rij c erij(2)=yj*rij @@ -316,15 +283,15 @@ c-------END TESTING CODE e1=fac*fac*aa e2=fac*bb eij=eps1*eps2rt*eps3rt*(e1+e2) -C write(iout,*) eij,'TU?1' eps2der=eij*eps3rt eps3der=eij*eps2rt - eij=eij*eps2rt*eps3rt + eij=eij*eps2rt*eps3rt*sss sigder=-sig/sigsq e1=e1*eps1*eps2rt**2*eps3rt**2 ed=-expon*(e1+eij)/ljd sigder=ed*sigder + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 eom12=eij*eps1_om12+eps2der*eps2rt_om12 @@ -333,8 +300,9 @@ C write(iout,*) eij,'TU?1' havebond=.true. ssd=rij-ssXs eij=ssA*ssd*ssd+ssB*ssd+ssC -C write(iout,*) 'TU?2',ssc,ssd + eij=eij*sss ed=2*akcm*ssd+akct*deltat12 + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij pom1=akct*ssd pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi eom1=-2*akth*deltat1-pom1-om2*pom2 @@ -369,13 +337,14 @@ c-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE h1=h_base(f1,hd1) h2=h_base(f2,hd2) eij=ssm*h1+Ht*h2 -C write(iout,*) eij,'TU?3' delta_inv=1.0d0/(xm-ssxm) deltasq_inv=delta_inv*delta_inv fac=ssm*hd1-Ht*hd2 fac1=deltasq_inv*fac*(xm-rij) fac2=deltasq_inv*fac*(rij-ssxm) ed=delta_inv*(Ht*hd2-ssm*hd1) + eij=eij*sss + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1) eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2) eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3) @@ -392,13 +361,14 @@ C write(iout,*) eij,'TU?3' h1=h_base(f1,hd1) h2=h_base(f2,hd2) eij=Ht*h1+ljm*h2 -C write(iout,*) 'TU?4',ssA delta_inv=1.0d0/(ljxm-xm) deltasq_inv=delta_inv*delta_inv fac=Ht*hd1-ljm*hd2 fac1=deltasq_inv*fac*(ljxm-rij) fac2=deltasq_inv*fac*(rij-xm) ed=delta_inv*(ljm*hd2-Ht*hd1) + eij=eij*sss + ed=ed+eij/sss*sssgrad/sigma(itypi,itypj)*rij eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1) eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2) eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3) @@ -464,7 +434,7 @@ c$$$ if (ed.gt.0.0d0) havebond=.true. c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE endif - write(iout,*) 'havebond',havebond + if (havebond) then #ifndef CLUST #ifndef WHAM @@ -474,9 +444,10 @@ c & "SSBOND_E_FORM",totT,t_bath,i,j c endif #endif #endif - dyn_ssbond_ij(i,j)=eij - else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then - dyn_ssbond_ij(i,j)=1.0d300 + dyn_ssbond_ij(ici,icj)=eij + else if (.not.havebond .and. dyn_ssbond_ij(ici,icj).lt.1.0d300) + &then + dyn_ssbond_ij(ici,icj)=1.0d300 #ifndef CLUST #ifndef WHAM c write(iout,'(a15,f12.2,f8.1,2i5)') @@ -501,6 +472,8 @@ c-------TESTING CODE checkstop=.false. endif c-------END TESTING CODE + gg_lipi(3)=ssgradlipi*eij + gg_lipj(3)=ssgradlipj*eij do k=1,3 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij @@ -510,10 +483,10 @@ c-------END TESTING CODE gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) enddo do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) + gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k) & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwx(k,j)=gvdwx(k,j)+gg(k) + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k) & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv enddo @@ -524,13 +497,12 @@ cgrad enddo cgrad enddo do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l) - gvdwc(l,j)=gvdwc(l,j)+gg(l) + gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(k) + gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(k) enddo return end - C----------------------------------------------------------------------------- double precision function h_base(x,deriv) @@ -571,9 +543,7 @@ c$$$ deriv=30.0d0*xsq*deriv return end - c---------------------------------------------------------------------------- - subroutine dyn_set_nss c Adjust nss and other relevant variables based on dyn_ssbond_ij c implicit none @@ -596,16 +566,16 @@ C include 'COMMON.MD' c Local variables double precision emin integer i,j,imin - integer diff,allflag(maxdim),allnss, - & allihpb(maxdim),alljhpb(maxdim), - & newnss,newihpb(maxdim),newjhpb(maxdim) + integer diff,allflag(maxdim_cont),allnss, + & allihpb(maxdim_cont),alljhpb(maxdim_cont), + & newnss,newihpb(maxdim_cont),newjhpb(maxdim_cont) logical found integer i_newnss(1024),displ(0:1024) - integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss + integer g_newihpb(maxdim_cont),g_newjhpb(maxdim_cont),g_newnss allnss=0 - do i=1,nres-1 - do j=i+1,nres + do i=1,ns-1 + do j=i+1,ns if (dyn_ssbond_ij(i,j).lt.1.0d300) then allnss=allnss+1 allflag(allnss)=0 @@ -749,1277 +719,8 @@ c Local variables end #endif #endif -c---------------------------------------------------------------------------- - - -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- - -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ integer i,iretcode,nfun_sc -c$$$ logical scfail -c$$$ double precision var(maxvar),e_sc,etot -c$$$ -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$c Minimize the two selected side-chains -c$$$ call overlap_sc(scfail) ! Better not fail! -c$$$ call minimize_sc(e_sc,var,iretcode,nfun_sc) -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------------- -c$$$ -c$$$ subroutine minimize_sc(etot_sc,iretcode,nfun) -c$$$c Minimize side-chains only, starting from geom but without modifying -c$$$c bond lengths. -c$$$c If mask_r is already set, only the selected side-chains are minimized, -c$$$c otherwise all side-chains are minimized keeping the backbone frozen. -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ integer icall -c$$$ common /srutu/ icall -c$$$ -c$$$c Output arguments -c$$$ double precision etot_sc -c$$$ integer iretcode,nfun -c$$$ -c$$$c External functions/subroutines -c$$$ external func_sc,grad_sc,fdum -c$$$ -c$$$c Local variables -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -c$$$ integer iv(liv) -c$$$ double precision rdum(1) -c$$$ double precision d(maxvar),v(1:lv),x(maxvar),xx(maxvar) -c$$$ integer idum(1) -c$$$ integer i,nvar_restr -c$$$ -c$$$ -c$$$cmc start_minim=.true. -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=1 -c$$$* selects output unit -c$$$ iv(21)=0 -c$$$c iv(21)=iout ! DEBUG -c$$$c iv(21)=8 ! DEBUG -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$c iv(22)=1 ! DEBUG -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$c iv(23)=1 ! DEBUG -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$c iv(24)=1 ! DEBUG -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-1 -c$$$ v(32)=rtolf -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,nphi -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ do i=nphi+1,nvar -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ -c$$$ call geom_to_var(nvar,x) -c$$$ IF (mask_r) THEN -c$$$ do i=1,nres ! Just in case... -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ELSE -c$$$c When minimizing ALL side-chains, etotal_sc is a little -c$$$c faster if we don't set mask_r -c$$$ do i=1,nres -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ mask_side(i)=1 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ENDIF -c$$$ call var_to_geom(nvar,x) -c$$$ call chainbuild_sc -c$$$ etot_sc=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6) -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine chainbuild_sc -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Local variables -c$$$ integer i -c$$$ -c$$$ -c$$$ do i=nnt,nct -c$$$ if (.not.mask_r .or. mask_side(i).eq.1) then -c$$$ call locate_side_chain(i) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision f -c$$$ -c$$$c Local variables -c$$$ double precision energia(0:n_ene) -c$$$#ifdef OSF -c$$$c Variables used to intercept NaNs -c$$$ double precision x_sum -c$$$ integer i_NAN -c$$$#endif -c$$$ -c$$$ -c$$$ nfl=nf -c$$$ icg=mod(nf,2)+1 -c$$$ -c$$$#ifdef OSF -c$$$c Intercept NaNs in the coordinates, before calling etotal_sc -c$$$ x_sum=0.D0 -c$$$ do i_NAN=1,n -c$$$ x_sum=x_sum+x(i_NAN) -c$$$ enddo -c$$$c Calculate the energy only if the coordinates are ok -c$$$ if ((.not.(x_sum.lt.0.D0)) .and. (.not.(x_sum.ge.0.D0))) then -c$$$ write(iout,*)" *** func_restr_sc : Found NaN in coordinates" -c$$$ f=1.0D+77 -c$$$ nf=0 -c$$$ else -c$$$#endif -c$$$ -c$$$ call var_to_geom_restr(n,x) -c$$$ call zerograd -c$$$ call chainbuild_sc -c$$$ call etotal_sc(energia(0)) -c$$$ f=energia(0) -c$$$ if (energia(1).eq.1.0D20 .or. energia(0).eq.1.0D99) nf=0 -c$$$ -c$$$#ifdef OSF -c$$$ endif -c$$$#endif -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------- -c$$$ -c$$$ subroutine grad_sc(n,x,nf,g,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.MINIM' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision g(maxvar) -c$$$ -c$$$c Local variables -c$$$ double precision f,gphii,gthetai,galphai,gomegai -c$$$ integer ig,ind,i,j,k,igall,ij -c$$$ -c$$$ -c$$$ icg=mod(nf,2)+1 -c$$$ if (nf-nfl+1) 20,30,40 -c$$$ 20 call func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$c write (iout,*) 'grad 20' -c$$$ if (nf.eq.0) return -c$$$ goto 40 -c$$$ 30 call var_to_geom_restr(n,x) -c$$$ call chainbuild_sc -c$$$C -c$$$C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -c$$$C -c$$$ 40 call cartder -c$$$C -c$$$C Convert the Cartesian gradient into internal-coordinate gradient. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ ind=nres-2 -c$$$ do i=2,nres-2 -c$$$ IF (mask_phi(i+2).eq.1) THEN -c$$$ gphii=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) -c$$$ gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ ig=ig+1 -c$$$ g(ig)=gphii -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ -c$$$ ind=0 -c$$$ do i=1,nres-2 -c$$$ IF (mask_theta(i+2).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gthetai=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) -c$$$ gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ g(ig)=gthetai -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ galphai=0.0D0 -c$$$ do k=1,3 -c$$$ galphai=galphai+dxds(k,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=galphai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gomegai=0.0D0 -c$$$ do k=1,3 -c$$$ gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=gomegai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$C -c$$$C Add the components corresponding to local energy terms. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ igall=0 -c$$$ do i=4,nres -c$$$ igall=igall+1 -c$$$ if (mask_phi(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do i=3,nres -c$$$ igall=igall+1 -c$$$ if (mask_theta(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do ij=1,2 -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ igall=igall+1 -c$$$ if (mask_side(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ endif -c$$$ enddo -c$$$ enddo -c$$$ -c$$$cd do i=1,ig -c$$$cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -c$$$cd enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine etotal_sc(energy_sc) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.FFIELD' -c$$$ -c$$$c Output arguments -c$$$ double precision energy_sc(0:n_ene) -c$$$ -c$$$c Local variables -c$$$ double precision evdw,escloc -c$$$ integer i,j -c$$$ -c$$$ -c$$$ do i=1,n_ene -c$$$ energy_sc(i)=0.0D0 -c$$$ enddo -c$$$ -c$$$ if (mask_r) then -c$$$ call egb_sc(evdw) -c$$$ call esc_sc(escloc) -c$$$ else -c$$$ call egb(evdw) -c$$$ call esc(escloc) -c$$$ endif -c$$$ -c$$$ if (evdw.eq.1.0D20) then -c$$$ energy_sc(0)=evdw -c$$$ else -c$$$ energy_sc(0)=wsc*evdw+wscloc*escloc -c$$$ endif -c$$$ energy_sc(1)=evdw -c$$$ energy_sc(12)=escloc -c$$$ -c$$$C -c$$$C Sum up the components of the Cartesian gradient. -c$$$C -c$$$ do i=1,nct -c$$$ do j=1,3 -c$$$ gradx(j,i,icg)=wsc*gvdwx(j,i) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_sc(evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$c if (icall.eq.0) lprn=.false. -c$$$ ind=0 -c$$$ do i=iatsc_s,iatsc_e -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$ do iint=1,nint_gr(i) -c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$ ENDIF -c$$$ enddo ! j -c$$$ enddo ! iint -c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine esc_sc(escloc) -c$$$C Calculate the local energy of a side chain and its derivatives in the -c$$$C corresponding virtual-bond valence angles THETA and the spherical angles -c$$$C ALPHA and OMEGA. -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.FFIELD' -c$$$ include 'COMMON.CONTROL' -c$$$ double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), -c$$$ & ddersc0(3),ddummy(3),xtemp(3),temp(3) -c$$$ common /sccalc/ time11,time12,time112,theti,it,nlobit -c$$$ delta=0.02d0*pi -c$$$ escloc=0.0D0 -c$$$c write (iout,'(a)') 'ESC' -c$$$ do i=loc_start,loc_end -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ it=itype(i) -c$$$ if (it.eq.10) goto 1 -c$$$ nlobit=nlob(it) -c$$$c print *,'i=',i,' it=',it,' nlobit=',nlobit -c$$$c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad -c$$$ theti=theta(i+1)-pipol -c$$$ x(1)=dtan(theti) -c$$$ x(2)=alph(i) -c$$$ x(3)=omeg(i) -c$$$ -c$$$ if (x(2).gt.pi-delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=pi-delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=pi-delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c escloci=esclocbi -c$$$c write (iout,*) escloci -c$$$ else if (x(2).lt.delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c write (iout,*) escloci -c$$$ else -c$$$ call enesc(x,escloci,dersc,ddummy,.false.) -c$$$ endif -c$$$ -c$$$ escloc=escloc+escloci -c$$$ if (energy_dec) write (iout,'(a6,i,0pf7.3)') -c$$$ & 'escloc',i,escloci -c$$$c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc -c$$$ -c$$$ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ -c$$$ & wscloc*dersc(1) -c$$$ gloc(ialph(i,1),icg)=wscloc*dersc(2) -c$$$ gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) -c$$$ 1 continue -c$$$ ENDIF -c$$$ enddo -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_ij(i_sc,j_sc,evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$ ind=0 -c$$$c$$$ do i=iatsc_s,iatsc_e -c$$$ i=i_sc -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$c$$$ do iint=1,nint_gr(i) -c$$$c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ j=j_sc -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$c$$$ enddo ! j -c$$$c$$$ enddo ! iint -c$$$c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine perturb_side_chain(i,angle) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i -c$$$ double precision angle ! In degrees -c$$$ -c$$$c Local variables -c$$$ integer i_sc -c$$$ double precision rad_ang,rand_v(3),length,cost,sint -c$$$ -c$$$ -c$$$ i_sc=i+nres -c$$$ rad_ang=angle*deg2rad -c$$$ -c$$$ length=0.0 -c$$$ do while (length.lt.0.01) -c$$$ rand_v(1)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(2)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(3)=ran_number(0.01D0,1.0D0) -c$$$ length=rand_v(1)*rand_v(1)+rand_v(2)*rand_v(2)+ -c$$$ + rand_v(3)*rand_v(3) -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ cost=rand_v(1)*dc_norm(1,i_sc)+rand_v(2)*dc_norm(2,i_sc)+ -c$$$ + rand_v(3)*dc_norm(3,i_sc) -c$$$ length=1.0D0-cost*cost -c$$$ if (length.lt.0.0D0) length=0.0D0 -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)-cost*dc_norm(1,i_sc) -c$$$ rand_v(2)=rand_v(2)-cost*dc_norm(2,i_sc) -c$$$ rand_v(3)=rand_v(3)-cost*dc_norm(3,i_sc) -c$$$ enddo -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ -c$$$ cost=dcos(rad_ang) -c$$$ sint=dsin(rad_ang) -c$$$ dc(1,i_sc)=vbld(i_sc)*(dc_norm(1,i_sc)*cost+rand_v(1)*sint) -c$$$ dc(2,i_sc)=vbld(i_sc)*(dc_norm(2,i_sc)*cost+rand_v(2)*sint) -c$$$ dc(3,i_sc)=vbld(i_sc)*(dc_norm(3,i_sc)*cost+rand_v(3)*sint) -c$$$ dc_norm(1,i_sc)=dc(1,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(2,i_sc)=dc(2,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(3,i_sc)=dc(3,i_sc)*vbld_inv(i_sc) -c$$$ c(1,i_sc)=c(1,i)+dc(1,i_sc) -c$$$ c(2,i_sc)=c(2,i)+dc(2,i_sc) -c$$$ c(3,i_sc)=c(3,i)+dc(3,i_sc) -c$$$ -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax3(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ double precision energy_sc(0:n_ene),etot -c$$$ double precision org_dc(3),org_dc_norm(3),org_c(3) -c$$$ double precision ang_pert,rand_fact,exp_fact,beta -c$$$ integer n,i_pert,i -c$$$ logical notdone -c$$$ -c$$$ -c$$$ beta=1.0D0 -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$ call etotal_sc(energy_sc) -c$$$ etot=energy_sc(0) -c$$$c write(iout,'(a,3d15.5)')" SS_MC_START ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ -c$$$ notdone=.true. -c$$$ n=0 -c$$$ do while (notdone) -c$$$ if (mod(n,2).eq.0) then -c$$$ i_pert=i_in -c$$$ else -c$$$ i_pert=j_in -c$$$ endif -c$$$ n=n+1 -c$$$ -c$$$ do i=1,3 -c$$$ org_dc(i)=dc(i,i_pert+nres) -c$$$ org_dc_norm(i)=dc_norm(i,i_pert+nres) -c$$$ org_c(i)=c(i,i_pert+nres) -c$$$ enddo -c$$$ ang_pert=ran_number(0.0D0,3.0D0) -c$$$ call perturb_side_chain(i_pert,ang_pert) -c$$$ call etotal_sc(energy_sc) -c$$$ exp_fact=exp(beta*(etot-energy_sc(0))) -c$$$ rand_fact=ran_number(0.0D0,1.0D0) -c$$$ if (rand_fact.lt.exp_fact) then -c$$$c write(iout,'(a,3d15.5)')" SS_MC_ACCEPT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ etot=energy_sc(0) -c$$$ else -c$$$c write(iout,'(a,3d15.5)')" SS_MC_REJECT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ do i=1,3 -c$$$ dc(i,i_pert+nres)=org_dc(i) -c$$$ dc_norm(i,i_pert+nres)=org_dc_norm(i) -c$$$ c(i,i_pert+nres)=org_c(i) -c$$$ enddo -c$$$ endif -c$$$ -c$$$ if (n.eq.10000.or.etot.lt.30.0D0) notdone=.false. -c$$$ enddo -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax2(etot,iretcode,nfun,i_in,j_in) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxres6*(maxres6+17)/2)) -c$$$********************************************************************* -c$$$* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for * -c$$$* the calling subprogram. * -c$$$* when d(i)=1.0, then v(35) is the length of the initial step, * -c$$$* calculated in the usual pythagorean way. * -c$$$* absolute convergence occurs when the function is within v(31) of * -c$$$* zero. unless you know the minimum value in advance, abs convg * -c$$$* is probably not useful. * -c$$$* relative convergence is when the model predicts that the function * -c$$$* will decrease by less than v(32)*abs(fun). * -c$$$********************************************************************* -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.CHAIN' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ double precision etot -c$$$ integer iretcode,nfun,i_in,j_in -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ external ss_func,fdum -c$$$ double precision ss_func,fdum -c$$$ -c$$$ integer iv(liv),uiparm(2) -c$$$ double precision v(lv),x(maxres6),d(maxres6),rdum -c$$$ integer i,j,k -c$$$ -c$$$ -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=2 -c$$$* selects output unit -c$$$c iv(21)=iout -c$$$ iv(21)=0 -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$ v(31)=1.0D-1 -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-4 -c$$$ v(32)=rtolf -c$$$ v(32)=1.0D-1 -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,6*nres -c$$$ d(i)=1.0D0 -c$$$ enddo -c$$$ -c$$$ do i=0,2*nres -c$$$ do j=1,3 -c$$$ orig_ss_dc(j,i)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ call geom_to_var(nvar,orig_ss_var) -c$$$ -c$$$ do i=1,nres -c$$$ do j=i,nres -c$$$ orig_ss_dist(j,i)=dist(j,i) -c$$$ orig_ss_dist(j+nres,i)=dist(j+nres,i) -c$$$ orig_ss_dist(j,i+nres)=dist(j,i+nres) -c$$$ orig_ss_dist(j+nres,i+nres)=dist(j+nres,i+nres) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i+nres) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ -c$$$ uiparm(1)=i_in -c$$$ uiparm(2)=j_in -c$$$ call smsno(k,d,x,ss_func,iv,liv,lv,v,uiparm,rdum,fdum) -c$$$ etot=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6)+iv(30) -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_func(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.SBRIDGE' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ integer n -c$$$ double precision x(maxres6) -c$$$ integer nf -c$$$ double precision f -c$$$ integer uiparm(2) -c$$$ real*8 urparm(1) -c$$$ external ufparm -c$$$ double precision ufparm -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ -c$$$ integer i,j,k,ss_i,ss_j -c$$$ double precision tempf,var(maxvar) -c$$$ -c$$$ -c$$$ ss_i=uiparm(1) -c$$$ ss_j=uiparm(2) -c$$$ f=0.0D0 -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ call geom_to_var(nvar,var) -c$$$ -c$$$c Constraints on all angles -c$$$ do i=1,nvar -c$$$ tempf=var(i)-orig_ss_var(i) -c$$$ f=f+tempf*tempf -c$$$ enddo -c$$$ -c$$$c Constraints on all distances -c$$$ do i=1,nres-1 -c$$$ if (i.gt.1) then -c$$$ tempf=dist(i+nres,i)-orig_ss_dist(i+nres,i) -c$$$ f=f+tempf*tempf -c$$$ endif -c$$$ do j=i+1,nres -c$$$ tempf=dist(j,i)-orig_ss_dist(j,i) -c$$$ if (tempf.lt.0.0D0 .or. j.eq.i+1) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i)-orig_ss_dist(j+nres,i) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j,i+nres)-orig_ss_dist(j,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i+nres)-orig_ss_dist(j+nres,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ enddo -c$$$ enddo -c$$$ -c$$$c Constraints for the relevant CYS-CYS -c$$$ tempf=dist(nres+ss_i,nres+ss_j)-8.0D0 -c$$$ f=f+tempf*tempf -c$$$CCCCCCCCCCCCCCCCC ADD SOME ANGULAR STUFF -c$$$ -c$$$c$$$ if (nf.ne.nfl) then -c$$$c$$$ write(iout,'(a,i10,2d15.5)')"IN DIST_FUNC (NF,F,DIST)",nf, -c$$$c$$$ + f,dist(5+nres,14+nres) -c$$$c$$$ endif -c$$$ -c$$$ nfl=nf -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$C----------------------------------------------------------------------------- - subroutine triple_ssbond_ene(resi,resj,resk,eij) +c$$$C---------------------------------------------------------------------------- + subroutine triple_ssbond_ene(resi,resj,resk,eij) include 'DIMENSIONS' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' diff --git a/source/wham/src-HCD/wham_calc1.F b/source/wham/src-HCD/wham_calc1.F index 31de33e..7e4512d 100644 --- a/source/wham/src-HCD/wham_calc1.F +++ b/source/wham/src-HCD/wham_calc1.F @@ -235,8 +235,8 @@ c potEmin=potEmin_t/2 c write (9,'(3i5,f10.5)') i,(iparm,potE(i,iparm),iparm=1,nParmSet) do iparm=1,nParmSet #ifdef DEBUG - write (iout,'(2i5,21f8.2)') i,iparm, - & (enetb(k,i,iparm),k=1,22) + write (iout,'(2i5,31f8.2)') i,iparm, + & (enetb(k,i,iparm),k=1,n_ene) #endif call restore_parm(iparm) #ifdef DEBUG -- 1.7.9.5 From dc37bafabf63a9b6746e83731d45cfda9c7a8df1 Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Fri, 29 May 2020 23:33:07 +0200 Subject: [PATCH 04/16] time --- source/cluster/wham/src-HCD/read_constr_homology.F | 1 + source/unres/src-HCD-5D/MREMD.F | 1 + source/unres/src-HCD-5D/Makefile | 2 +- .../unres/src-HCD-5D/Makefile_MPICH_ifort-tryton | 4 ++-- 4 files changed, 5 insertions(+), 3 deletions(-) diff --git a/source/cluster/wham/src-HCD/read_constr_homology.F b/source/cluster/wham/src-HCD/read_constr_homology.F index 6ae3ef4..0b265fa 100644 --- a/source/cluster/wham/src-HCD/read_constr_homology.F +++ b/source/cluster/wham/src-HCD/read_constr_homology.F @@ -558,6 +558,7 @@ c Read clusters read(ientin,*) (inclust(k,i),k=1,ninclust(i)) read(ientin,*) (iresclust(k,i),k=1,nresclust(i)) enddo + close(ientin) c c Loop over clusters c diff --git a/source/unres/src-HCD-5D/MREMD.F b/source/unres/src-HCD-5D/MREMD.F index f22e2f6..e25e2bd 100644 --- a/source/unres/src-HCD-5D/MREMD.F +++ b/source/unres/src-HCD-5D/MREMD.F @@ -412,6 +412,7 @@ c Entering the MD loop call setup_fricmat endif time00=MPI_WTIME() + time01=time00 if (me.eq.king .or. .not. out1file) & write(iout,*) 'Setup time',time00-walltime call flush(iout) diff --git a/source/unres/src-HCD-5D/Makefile b/source/unres/src-HCD-5D/Makefile index ee054bf..2124a4e 120000 --- a/source/unres/src-HCD-5D/Makefile +++ b/source/unres/src-HCD-5D/Makefile @@ -1 +1 @@ -Makefile_MPICH_ifort-okeanos \ No newline at end of file +Makefile_MPICH_ifort-tryton \ No newline at end of file diff --git a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton index 11b83dd..c6a571b 100644 --- a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton +++ b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton @@ -10,8 +10,8 @@ FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include FFLAGS1 = -c -g -CA -CB -mcmodel=medium -shared-intel #FFLAGS1 = ${FFLAGS} FFLAGS2 = -c -g -O0 -mcmodel=medium -shared-intel -#FFLAGSE = -c -O3 -ipo -mcmodel=medium -shared-intel -FFLAGSE = ${FFLAGS} +FFLAGSE = -c -O3 -ipo -mcmodel=medium -shared-intel +#FFLAGSE = ${FFLAGS} #LIBS = -L$(INSTALL_DIR)/lib -lmpi xdrf/libxdrf.a -- 1.7.9.5 From 759e26746fc72e8e68ea50876d49a138c56c6814 Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Sat, 6 Jun 2020 17:06:55 +0200 Subject: [PATCH 05/16] Adam's cluster & unres corrections --- source/cluster/wham/src-HCD/energy_p_new.F | 2 +- source/unres/src-HCD-5D/energy_p_new_barrier.F | 6 ++++++ source/unres/src-HCD-5D/readrtns_CSA.F | 10 ++++++++-- 3 files changed, 15 insertions(+), 3 deletions(-) diff --git a/source/cluster/wham/src-HCD/energy_p_new.F b/source/cluster/wham/src-HCD/energy_p_new.F index 119bad6..db2e043 100644 --- a/source/cluster/wham/src-HCD/energy_p_new.F +++ b/source/cluster/wham/src-HCD/energy_p_new.F @@ -2899,7 +2899,7 @@ 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) + & *fac_shield(i)*fac_shield(j)*sss if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & 'eelloc',i,j,eel_loc_ij c if (eel_loc_ij.ne.0) diff --git a/source/unres/src-HCD-5D/energy_p_new_barrier.F b/source/unres/src-HCD-5D/energy_p_new_barrier.F index 3f5429d..2c701ca 100644 --- a/source/unres/src-HCD-5D/energy_p_new_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new_barrier.F @@ -2308,6 +2308,12 @@ C Calculate gradient components. fac=rij*fac-2*expon*rrij*e_augm fac=fac+(evdwij+e_augm)*sssgrad/sss*rij C Calculate the radial part of the gradient + gg_lipi(3)=eps1*(eps2rt*eps2rt) + & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))) + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac diff --git a/source/unres/src-HCD-5D/readrtns_CSA.F b/source/unres/src-HCD-5D/readrtns_CSA.F index d76b29e..f120ec7 100644 --- a/source/unres/src-HCD-5D/readrtns_CSA.F +++ b/source/unres/src-HCD-5D/readrtns_CSA.F @@ -1215,6 +1215,8 @@ c write (iout,*) "After read_dist_constr nhpb",nhpb C endif +c write (iout,*) "iranconf",iranconf," extconf",extconf, +c & " start_from_models",start_from_model if (indpdb.eq.0 .and. modecalc.ne.2 .and. modecalc.ne.4 & .and. modecalc.ne.8 .and. modecalc.ne.9 .and. & modecalc.ne.10) then @@ -3053,7 +3055,8 @@ c double precision, dimension (max_template,maxres) :: rescore2 double precision, dimension (max_template,maxres) :: rescore3 double precision distal - character*24 pdbfile,tpl_k_rescore + character*24 tpl_k_rescore + character*256 pdbfile c ----------------------------------------------------------------- c Reading multiple PDB ref structures and calculation of retraints c not using pre-computed ones stored in files model_ki_{dist,angle} @@ -3132,6 +3135,7 @@ c do k=1,constr_homology read(inp,'(a)') pdbfile + pdbfiles_chomo(k)=pdbfile if(me.eq.king .or. .not. out1file) & write (iout,'(a,5x,a)') 'HOMOL: Opening PDB file', & pdbfile(:ilen(pdbfile)) @@ -3636,7 +3640,8 @@ c double precision rescore_tmp,x12,y12,z12,rescore2_tmp double precision, dimension (max_template,maxres) :: rescore double precision, dimension (max_template,maxres) :: rescore2 - character*24 pdbfile,tpl_k_rescore + character*24 tpl_k_rescore + character*256 pdbfile c c For new homol impl @@ -3655,6 +3660,7 @@ c Read pdb files read(ientin,'(a)') pdbfile write (iout,'(a,5x,a)') 'KLAPAUCJUSZ: Opening PDB file', & pdbfile(:ilen(pdbfile)) + pdbfiles_chomo(k)=pdbfile open(ipdbin,file=pdbfile,status='old',err=33) goto 34 33 write (iout,'(a,5x,a)') 'Error opening PDB file', -- 1.7.9.5 From 076f2c04390f344c6817a9e373e75ae1e2997f3c Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Sun, 7 Jun 2020 12:15:53 +0200 Subject: [PATCH 06/16] Adam's lipid and dfa corrections --- source/cluster/wham/src-HCD/Makefile | 2 +- source/cluster/wham/src-HCD/Makefile-MPICH-ifort | 84 ++- .../wham/src-HCD/Makefile-MPICH-ifort-prometheus | 82 ++- source/cluster/wham/src-HCD/Makefile-tryton | 2 +- source/cluster/wham/src-HCD/energy_p_new.F | 128 ++-- .../wham/src-HCD/include_unres/COMMON.INTERACT | 7 +- source/cluster/wham/src-HCD/initialize.f | 99 --- source/cluster/wham/src-HCD/readrtns.F | 1 + source/cluster/wham/src-HCD/sizesclu.dat | 2 +- source/unres/src-HCD-5D/COMMON.DFA | 21 +- source/unres/src-HCD-5D/COMMON.INTERACT | 4 +- source/unres/src-HCD-5D/DIMENSIONS | 4 +- source/unres/src-HCD-5D/MD_A-MTS.F | 1 + source/unres/src-HCD-5D/checkder_p.F | 9 + source/unres/src-HCD-5D/dfa.F | 52 +- source/unres/src-HCD-5D/energy_p_new-sep_barrier.F | 322 +++++++--- source/unres/src-HCD-5D/energy_p_new_barrier.F | 308 +++++++--- source/unres/src-HCD-5D/energy_split-sep.F | 8 +- source/unres/src-HCD-5D/gradient_p.F | 9 +- source/unres/src-HCD-5D/parmread.F | 13 +- source/unres/src-HCD-5D/readpdb-mult.F | 1 + source/unres/src-HCD-5D/readpdb.F | 631 -------------------- source/unres/src-HCD-5D/readrtns_CSA.F | 7 +- source/unres/src-HCD-5D/unres.F | 34 +- source/wham/src-HCD/Makefile | 2 +- source/wham/src-HCD/Makefile_MPICH_ifort | 100 +++- source/wham/src-HCD/energy_p_new.F | 152 +++-- source/wham/src-HCD/include_unres/COMMON.INTERACT | 6 +- source/wham/src-HCD/initialize_p.F | 2 +- source/wham/src-HCD/oligomer.F | 4 +- source/wham/src-HCD/parmread.F | 2 + source/wham/src-HCD/proc_cont.f | 4 +- 32 files changed, 1008 insertions(+), 1095 deletions(-) delete mode 100644 source/cluster/wham/src-HCD/initialize.f delete mode 100644 source/unres/src-HCD-5D/readpdb.F diff --git a/source/cluster/wham/src-HCD/Makefile b/source/cluster/wham/src-HCD/Makefile index 8aee570..693492e 120000 --- a/source/cluster/wham/src-HCD/Makefile +++ b/source/cluster/wham/src-HCD/Makefile @@ -1 +1 @@ -Makefile-MPICH-ifort-okeanos \ No newline at end of file +Makefile-MPICH-ifort \ No newline at end of file diff --git a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort index 79b8d0f..907ce62 100644 --- a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort +++ b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort @@ -1,10 +1,10 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +INSTALL_DIR = /users/software/mpich2-1.4.1p1_intel BIN=../../../../bin/cluster -FC = ifort +FC= ${INSTALL_DIR}/bin/mpif90 OPT = -O3 -ip -w -mcmodel=medium -OPT = -CB -g -mcmodel=medium +#OPT = -CB -g -mcmodel=medium FFLAGS = ${OPT} -c -I. -Iinclude_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a +LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a .c.o: cc -c -DLINUX -DPGI $*.c @@ -20,49 +20,97 @@ object = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ - setup_var.o read_ref_str.o gnmr1.o permut.o ssMD.o + setup_var.o read_ref_str.o gnmr1.o permut.o seq2chains.o \ + chain_symmetry.o iperm.o rmscalc.o rmsnat.o TMscore.o ssMD.o refsys.o \ + read_constr_homology.o boxshift.o all: no_option - @echo "Specify force field: GAB, 4P or E0LL2Y" + @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR" no_option: GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = ../../../../bin/cluster/unres_clustMD-mult_ifort_MPICH_GAB.exe + -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC \ + -DFOURBODY +GAB: BIN = ~/bin/unres_clustMD_ifort_MPICH-okeanos_GAB-HCD.exe GAB: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c + gcc -o compinfo compinfo.c ./compinfo | true ${FC} ${FFLAGS} cinfo.f $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} 4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -4P: BIN = ../../../../bin/cluster/unres_clustMD-mult_ifort_MPICH_4P.exe + -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC \ + -DFOURBODY +4P: BIN = ~/bin/unres_clustMD_ifort_MPICH-okeanos_4P-HCD.exe 4P: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c + gcc -o compinfo compinfo.c ./compinfo | true ${FC} ${FFLAGS} cinfo.f $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} E0LL2Y: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ - -DCLUST -DSPLITELE -DLANG0 -E0LL2Y: BIN = ../../../../bin/cluster/unres_clustMD-mult_ifort_MPICH_E0LL2Y.exe + -DCLUST -DSPLITELE -DFOURBODY +E0LL2Y: BIN = ~/bin/unres_clustMD_ifort_MPICH-okeanos_E0LL2Y-HCD.exe E0LL2Y: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c + gcc -o compinfo compinfo.c ./compinfo | true ${FC} ${FFLAGS} cinfo.f $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} +E0LL2Y_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCLUST -DSPLITELE -DFOURBODY -DDFA +E0LL2Y_DFA: BIN = ~/bin/unres_clustMD_ifort_MPICH-okeanos_E0LL2Y-HCD-DFA.exe +E0LL2Y_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + NEWCORR: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ - -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -NEWCORR: BIN = ../../../../bin/cluster/unres_clustMD-mult_ifort_MPICH_NEWCORR.exe + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR: BIN = ~/bin/unres_clustMD_ifort_MPICH-okeanos_SC-HCD.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe NEWCORR: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DFIVEDIAG +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR5D: BIN = ~/bin/unres_clustMD_ifort_MPICH-okeanos_SC-HCD5.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR5D: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c ./compinfo | true ${FC} ${FFLAGS} cinfo.f $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} +NEWCORR_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DDFA +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR_DFA: BIN = ~/bin/unres_clustMD_ifort_MPICH-okeanos_SC-HCD-DFA.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DDFA +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR5D_DFA: BIN = ~/bin/unres_clustMD_ifort_MPICH-okeanos_SC-HCD5-DFA.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR5D_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + xdrf/libxdrf.a: cd xdrf && make diff --git a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-prometheus b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-prometheus index 1492755..e1b8f32 100644 --- a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-prometheus +++ b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-prometheus @@ -1,14 +1,14 @@ -FC = mpif90 -fc=ifort +################################################################### +#INSTALL_DIR = /net/software/local/intel/compilers_and_libraries_2016.3.210/linux/mpi/intel64 + -OPT = -O3 -ip -mcmodel=medium -shared-intel -#OPT = -O3 -#OPT = -g -CA -CB -mcmodel=medium -shared-intel +FC = mpif90 -fc=ifort -FFLAGS = -c ${OPT} -Iinclude_unres -FFLAGS1 = -c -g -CA -CB -mcmodel=medium -shared-intel -#FFLAGS = ${FFLAGS1} -LIBS = -lmpi xdrf/libxdrf.a +OPT = -O3 -ip -mcmodel=medium +#OPT = -CB -g -mcmodel=medium -shared-intel +FFLAGS = ${OPT} -c -I. -Iinclude_unres -I$(INSTALL_DIR)/include +LIBS = -L$(INSTALL_DIR)/lib -lmpi xdrf/libxdrf.a .c.o: cc -c -DLINUX -DPGI $*.c @@ -24,16 +24,19 @@ object = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ - setup_var.o read_ref_str.o gnmr1.o permut.o rmsnat.o TMscore.o ssMD.o oligomer.o + setup_var.o read_ref_str.o gnmr1.o permut.o seq2chains.o \ + chain_symmetry.o iperm.o rmscalc.o rmsnat.o TMscore.o ssMD.o refsys.o \ + read_constr_homology.o all: no_option - @echo "Specify force field: GAB, 4P or E0LL2Y" + @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR" no_option: GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = ~/unres/bin/unres_clustMD-mult_ifort_MPICH_GAB-SAXS-MRAMB-Bfac.exe + -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC \ + -DFOURBODY +GAB: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-prometheus_GAB-HCD.exe GAB: ${object} xdrf/libxdrf.a gcc -o compinfo compinfo.c ./compinfo | true @@ -41,8 +44,9 @@ GAB: ${object} xdrf/libxdrf.a $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} 4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -4P: BIN = ~/unres/bin/unres_clustMD-mult_ifort_MPICH_4P-SAXS-MRSAMB-Bfac.exe + -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC \ + -DFOURBODY +4P: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-prometheus_4P-HCD.exe 4P: ${object} xdrf/libxdrf.a gcc -o compinfo compinfo.c ./compinfo | true @@ -50,23 +54,67 @@ GAB: ${object} xdrf/libxdrf.a $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} E0LL2Y: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ - -DCLUST -DSPLITELE -DLANG0 -E0LL2Y: BIN = ~/unres/bin/unres_clustMD-mult_ifort_MPICH_E0LL2Y-SAXS-MRAMB-Bfac.exe + -DCLUST -DSPLITELE -DFOURBODY +E0LL2Y: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-prometheus_E0LL2Y-HCD.exe E0LL2Y: ${object} xdrf/libxdrf.a gcc -o compinfo compinfo.c ./compinfo | true ${FC} ${FFLAGS} cinfo.f $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} +E0LL2Y_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCLUST -DSPLITELE -DFOURBODY -DDFA +E0LL2Y_DFA: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-prometheus_E0LL2Y-HCD-DFA.exe +E0LL2Y_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + NEWCORR: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -NEWCORR: BIN = ~/unres/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-SAXS-MRAMB-Bfac.exe +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-prometheus_SC-HCD.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe NEWCORR: ${object} xdrf/libxdrf.a gcc -o compinfo compinfo.c ./compinfo | true ${FC} ${FFLAGS} cinfo.f $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} +NEWCORR5D: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DFIVEDIAG +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR5D: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-prometheus_SC-HCD5.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR5D: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +NEWCORR_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DDFA +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR_DFA: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-prometheus_SC-HCD-DFA.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DDFA +#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR5D_DFA: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-prometheus_SC-HCD5-DFA.exe +#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe +NEWCORR5D_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + xdrf/libxdrf.a: cd xdrf && make diff --git a/source/cluster/wham/src-HCD/Makefile-tryton b/source/cluster/wham/src-HCD/Makefile-tryton index e887bc9..ec6ae53 100644 --- a/source/cluster/wham/src-HCD/Makefile-tryton +++ b/source/cluster/wham/src-HCD/Makefile-tryton @@ -85,7 +85,7 @@ NEWCORR: ${object} xdrf/libxdrf.a NEWCORR5D: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DFIVEDIAG #-DCLUST -DSPLITELE -DLANG0 -DNEWCORR -NEWCORR5D: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD5.exe +NEWCORR5D: BIN = ~/unres/bin/unres_clustMD_ifort_MPICH-tryton_SC-HCD5-L.exe #NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe NEWCORR5D: ${object} xdrf/libxdrf.a gcc -o compinfo compinfo.c diff --git a/source/cluster/wham/src-HCD/energy_p_new.F b/source/cluster/wham/src-HCD/energy_p_new.F index db2e043..4fa79c5 100644 --- a/source/cluster/wham/src-HCD/energy_p_new.F +++ b/source/cluster/wham/src-HCD/energy_p_new.F @@ -1104,6 +1104,7 @@ C implicit real*8 (a-h,o-z) include 'DIMENSIONS' include "DIMENSIONS.COMPAR" + include 'COMMON.CONTROL' include 'COMMON.GEO' include 'COMMON.VAR' include 'COMMON.LOCAL' @@ -1264,6 +1265,8 @@ C#define DEBUG #endif C#undef DEBUG c endif + if (energy_dec) write (iout,'(a,2i5,4f10.5,e15.5)') + & 'r sss evdw',i,j,1.0d0/rij,sss,sslipi,sslipj,evdwij if (calc_grad) then C Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 @@ -1272,6 +1275,12 @@ C Calculate gradient components. fac=rij*fac fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij C Calculate the radial part of the gradient + gg_lipi(3)=eps1*(eps2rt*eps2rt) + & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))) + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac @@ -1433,6 +1442,12 @@ C Calculate gradient components. fac=rij*fac-2*expon*rrij*e_augm fac=fac+(evdwij+e_augm)*sssgrad/sss*rij C Calculate the radial part of the gradient + gg_lipi(3)=eps1*(eps2rt*eps2rt) + & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))) + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac @@ -2092,6 +2107,8 @@ C common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 + double precision sslipi,sslipj,ssgradlipi,ssgradlipj + common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions #ifdef MOMENT double precision scal_el /1.0d0/ @@ -2200,6 +2217,7 @@ c end if ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) num_conti=0 call eelecij(i,i+2,ees,evdw1,eel_loc) if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) @@ -2230,6 +2248,7 @@ c & .or. itype(i-1).eq.ntyp1 ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -2270,6 +2289,7 @@ c & .or. itype(i-1).eq.ntyp1 ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -2340,6 +2360,9 @@ C------------------------------------------------------------------------------- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 + double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij, + & faclipij2 + common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions #ifdef MOMENT double precision scal_el /1.0d0/ @@ -2375,6 +2398,9 @@ C zj=c(3,j)+0.5D0*dzj-zmedi yj=c(2,j)+0.5D0*dyj zj=c(3,j)+0.5D0*dzj call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0 + faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0 xj=boxshift(xj-xmedi,boxxsize) yj=boxshift(yj-ymedi,boxysize) zj=boxshift(zj-zmedi,boxzsize) @@ -2413,25 +2439,25 @@ C fac_shield(j)=0.6 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 + ees=ees+eesij*faclipij2 else fac_shield(i)=1.0 fac_shield(j)=1.0 eesij=(el1+el2) - ees=ees+eesij + ees=ees+eesij*faclipij2 endif - evdw1=evdw1+evdwij*sss + evdw1=evdw1+evdwij*sss*faclipij2 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, cd & 1.0D0/dsqrt(rrmij),evdwij,eesij, cd & xmedi,ymedi,zmedi,xj,yj,zj if (energy_dec) then - write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)') - &'evdw1',i,j,evdwij - &,iteli,itelj,aaa,evdw1,sss - write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij, - &fac_shield(i),fac_shield(j) + write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)') + & 'evdw1',i,j,evdwij,iteli,itelj,aaa,evdw1,sss + write (iout,'(a6,2i5,0pf7.3,6f8.5)') 'ees',i,j,eesij, + & fac_shield(i),fac_shield(j),sslipi,sslipj,faclipij, + & faclipij2 endif C @@ -2449,9 +2475,10 @@ C * Radial derivatives. First process both termini of the fragment (i,j) * if (calc_grad) then - ggg(1)=facel*xj - ggg(2)=facel*yj - ggg(3)=facel*zj + aux=(facel*sss+rmij*sssgrad*eesij)*faclipij2 + ggg(1)=aux*xj + ggg(2)=aux*yj + ggg(3)=aux*zj if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. & (shield_mode.gt.0)) then C print *,i,j @@ -2549,7 +2576,7 @@ cgrad gelc(l,k)=gelc(l,k)+ggg(l) cgrad enddo cgrad enddo if (sss.gt.0.0) then - facvdw=facvdw+sssgrad*rmij*evdwij + facvdw=facvdw+sssgrad*rmij*evdwij*faclipij2 ggg(1)=facvdw*xj ggg(2)=facvdw*yj ggg(3)=facvdw*zj @@ -2579,7 +2606,7 @@ cgrad enddo endif ! calc_grad #else C MARYSIA - facvdw=(ev1+evdwij) + facvdw=(ev1+evdwij)*faclipij2 facel=(el1+eesij) fac1=fac fac=-3*rrmij*(facvdw+facvdw+facel)*sss @@ -2642,7 +2669,7 @@ cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), cd & (dcosg(k),k=1,3) do k=1,3 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))* - & fac_shield(i)**2*fac_shield(j)**2 + & fac_shield(i)**2*fac_shield(j)**2*sss*faclipij2 enddo c do k=1,3 c ghalf=0.5D0*ggg(k) @@ -2663,11 +2690,11 @@ C print *,"before22", gelc_long(1,i), gelc_long(1,j) gelc(k,i)=gelc(k,i) & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)) - & *fac_shield(i)**2*fac_shield(j)**2 + & *fac_shield(i)**2*fac_shield(j)**2*faclipij2 gelc(k,j)=gelc(k,j) & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)) - & *fac_shield(i)**2*fac_shield(j)**2 + & *fac_shield(i)**2*fac_shield(j)**2*faclipij2 gelc_long(k,j)=gelc_long(k,j)+ggg(k) gelc_long(k,i)=gelc_long(k,i)-ggg(k) enddo @@ -2899,14 +2926,14 @@ 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)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & 'eelloc',i,j,eel_loc_ij c if (eel_loc_ij.ne.0) c & write (iout,'(a4,2i4,8f9.5)')'chuj', c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4) - eel_loc=eel_loc+eel_loc_ij*sss + eel_loc=eel_loc+eel_loc_ij C Now derivative over eel_loc if (calc_grad) then if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. @@ -2963,7 +2990,7 @@ C Calculate patrial derivative for theta angle & +a23*gmuij1(2) & +a32*gmuij1(3) & +a33*gmuij1(4)) - & *fac_shield(i)*fac_shield(j)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij c write(iout,*) "derivative over thatai" c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3), c & a33*gmuij1(4) @@ -2979,7 +3006,7 @@ c & a33*gmuij2(4) & +a33*gmuij2(4) gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ & geel_loc_ij*wel_loc - & *fac_shield(i)*fac_shield(j)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij c Derivative over j residue geel_loc_ji=a22*gmuji1(1) @@ -2992,7 +3019,7 @@ c & a33*gmuji1(4) gloc(nphi+j,icg)=gloc(nphi+j,icg)+ & geel_loc_ji*wel_loc - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*sss*faclipij geel_loc_ji= & +a22*gmuji2(1) @@ -3004,7 +3031,7 @@ c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3), c & a33*gmuji2(4) gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+ & geel_loc_ji*wel_loc - & *fac_shield(i)*fac_shield(j)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij #endif cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij @@ -3013,12 +3040,12 @@ C Partial derivatives in virtual-bond dihedral angles gamma & 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) + & *fac_shield(i)*fac_shield(j)*sss*faclipij 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) + & *fac_shield(i)*fac_shield(j)*sss*faclipij C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) aux=eel_loc_ij/sss*sssgrad*rmij ggg(1)=aux*xj @@ -3027,7 +3054,7 @@ C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) do l=1,3 ggg(l)=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)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) cgrad ghalf=0.5d0*ggg(l) @@ -3040,22 +3067,27 @@ cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l) cgrad enddo cgrad enddo C Remaining derivatives of eello + gel_loc_long(3,j)=gel_loc_long(3,j)+ + & ssgradlipj*eel_loc_ij/2.0d0*lipscale/faclipij + + gel_loc_long(3,i)=gel_loc_long(3,i)+ + & ssgradlipi*eel_loc_ij/2.0d0*lipscale/faclipij 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) + & *fac_shield(i)*fac_shield(j)*sss*faclipij 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) + & *fac_shield(i)*fac_shield(j)*sss*faclipij 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) + & *fac_shield(i)*fac_shield(j)*sss*faclipij 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) + & *fac_shield(i)*fac_shield(j)*sss*faclipij enddo endif ! calc_grad @@ -3321,6 +3353,8 @@ C Third- and fourth-order contributions from turns common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 + double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij + common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij j=i+2 c write (iout,*) "eturn3",i,j,j1,j2 a_temp(1,1)=a22 @@ -3358,7 +3392,7 @@ 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) + & *fac_shield(i)*fac_shield(j)*faclipij eello_t3=0.5d0*(pizda(1,1)+pizda(2,2)) & *fac_shield(i)*fac_shield(j) if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2, @@ -3368,10 +3402,10 @@ C#ifdef NEWCORR C Derivatives in theta gloc(nphi+i,icg)=gloc(nphi+i,icg) & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3 - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg) & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3 - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij C#endif C Derivatives in shield mode @@ -3426,14 +3460,14 @@ C Derivatives in gamma(i) call transpose2(auxmat2(1,1),auxmat3(1,1)) call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2)) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij C Derivatives in gamma(i+1) call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1)) call transpose2(auxmat2(1,1),auxmat3(1,1)) call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) gel_loc_turn3(i+1)=gel_loc_turn3(i+1) & +0.5d0*(pizda(1,1)+pizda(2,2)) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij C Cartesian derivatives do l=1,3 c ghalf1=0.5d0*agg(l,1) @@ -3447,7 +3481,7 @@ c ghalf4=0.5d0*agg(l,4) 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) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggi1(l,1)!+agg(l,1) a_temp(1,2)=aggi1(l,2)!+agg(l,2) @@ -3456,7 +3490,7 @@ c ghalf4=0.5d0*agg(l,4) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) & +0.5d0*(pizda(1,1)+pizda(2,2)) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggj(l,1)!+ghalf1 a_temp(1,2)=aggj(l,2)!+ghalf2 a_temp(2,1)=aggj(l,3)!+ghalf3 @@ -3464,7 +3498,7 @@ c ghalf4=0.5d0*agg(l,4) 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) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggj1(l,1) a_temp(1,2)=aggj1(l,2) a_temp(2,1)=aggj1(l,3) @@ -3472,7 +3506,7 @@ c ghalf4=0.5d0*agg(l,4) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,j1)=gcorr3_turn(l,j1) & +0.5d0*(pizda(1,1)+pizda(2,2)) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij enddo endif ! calc_grad @@ -3605,7 +3639,7 @@ C fac_shield(i)=0.6 C fac_shield(j)=0.4 endif eello_turn4=eello_turn4-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij eello_t4=-(s1+s2+s3) & *fac_shield(i)*fac_shield(j) c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2) @@ -3682,7 +3716,7 @@ C Derivatives in gamma(i) 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) + & *fac_shield(i)*fac_shield(j)*faclipij 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)) @@ -3691,7 +3725,7 @@ C Derivatives in gamma(i+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) + & *fac_shield(i)*fac_shield(j)*faclipij 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)) @@ -3703,7 +3737,7 @@ C Derivatives in gamma(i+2) call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij if (calc_grad) then C Cartesian derivatives C Derivatives of this turn contributions in DC(i+2) @@ -3724,7 +3758,7 @@ C Derivatives of this turn contributions in DC(i+2) 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) + & *fac_shield(i)*fac_shield(j)*faclipij enddo endif C Remaining derivatives of this turn contribution @@ -3743,7 +3777,7 @@ 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) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggi1(l,1) a_temp(1,2)=aggi1(l,2) a_temp(2,1)=aggi1(l,3) @@ -3758,7 +3792,7 @@ 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+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggj(l,1) a_temp(1,2)=aggj(l,2) a_temp(2,1)=aggj(l,3) @@ -3773,7 +3807,7 @@ 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,j)=gcorr4_turn(l,j)-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggj1(l,1) a_temp(1,2)=aggj1(l,2) a_temp(2,1)=aggj1(l,3) @@ -3789,7 +3823,7 @@ C Remaining derivatives of this turn contribution s3=0.5d0*(pizda(1,1)+pizda(2,2)) c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij enddo endif ! calc_grad diff --git a/source/cluster/wham/src-HCD/include_unres/COMMON.INTERACT b/source/cluster/wham/src-HCD/include_unres/COMMON.INTERACT index 1c0b8db..a02f7e4 100644 --- a/source/cluster/wham/src-HCD/include_unres/COMMON.INTERACT +++ b/source/cluster/wham/src-HCD/include_unres/COMMON.INTERACT @@ -31,6 +31,7 @@ c 12/5/03 modified 09/18/03 Bond stretching parameters. & distchainmax,nbondterm(ntyp) &,vbldpDUM C 01/29/15 Lipidic parameters - double precision pepliptran,liptranene - common /lipid/ pepliptran,liptranene(ntyp) - + double precision pepliptran,liptranene, lipscale, + &tubetranene, tubetranenepep + common /lipid/ pepliptran,liptranene(ntyp),lipscale + common /tubepar/ tubetranene(ntyp), tubetranenepep diff --git a/source/cluster/wham/src-HCD/initialize.f b/source/cluster/wham/src-HCD/initialize.f deleted file mode 100644 index 12ea156..0000000 --- a/source/cluster/wham/src-HCD/initialize.f +++ /dev/null @@ -1,99 +0,0 @@ - subroutine initialize -C -C Define constants and zero out tables. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.MINIM' - include 'COMMON.DERIV' -C -C The following is just to define auxiliary variables used in angle conversion -C - pi=4.0D0*datan(1.0D0) - dwapi=2.0D0*pi - dwapi3=pi/3.0D0 - pipol=0.5D0*pi - deg2rad=pi/180.0D0 - rad2deg=1.0D0/deg2rad - angmin=10.0D0*deg2rad -C Assign virtual-bond length - vbl=3.8D0 - vblinv=1.0D0/vbl - vblinv2=vblinv*vblinv -C -C Define I/O units. -C - inp= 1 - iout= 2 - ipdbin= 3 - ipdb= 7 - igeom= 8 - intin= 9 - istat= 17 - imol2= 18 - jplot= 19 - jstatin=10 - jstatout=11 -C -C Zero out tables. -C - do i=1,maxres2 - do j=1,3 - c(j,i)=0.0D0 - dc(j,i)=0.0D0 - enddo - enddo - do i=1,maxres - do j=1,3 - xloc(j,i)=0.0D0 - enddo - enddo -C Initialize the bridge arrays - ns=0 - nss=0 - nhpb=0 - do i=1,maxss - iss(i)=0 - enddo - do i=1,maxdim - dhpb(i)=0.0D0 - enddo - do i=1,maxres - ihpb(i)=0 - jhpb(i)=0 - enddo -C -C Initialize timing. -C - call set_timers - return - end -c------------------------------------------------------------------------- - block data chuj - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - 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','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','z','z','z','z','X'/ - data potname /'LJ','LJK','BP','GB','GBV'/ - data potname /'LJ','LJK','BP','GB','GBV'/ - end diff --git a/source/cluster/wham/src-HCD/readrtns.F b/source/cluster/wham/src-HCD/readrtns.F index 057f1ac..e9e576f 100644 --- a/source/cluster/wham/src-HCD/readrtns.F +++ b/source/cluster/wham/src-HCD/readrtns.F @@ -234,6 +234,7 @@ C Read weights of the subsequent energy terms. call reada(weightcard,'WDFAN',wdfa_nei,0.0d0) call reada(weightcard,'WDFAB',wdfa_beta,0.0d0) call reada(weightcard,'WLT',wliptran,0.0D0) + call reada(weightcard,'LIPSCALE',lipscale,1.0D0) call reada(weightcard,"ATRISS",atriss,0.301D0) call reada(weightcard,"BTRISS",btriss,0.021D0) call reada(weightcard,"CTRISS",ctriss,1.001D0) diff --git a/source/cluster/wham/src-HCD/sizesclu.dat b/source/cluster/wham/src-HCD/sizesclu.dat index cb8572c..7d0d666 100644 --- a/source/cluster/wham/src-HCD/sizesclu.dat +++ b/source/cluster/wham/src-HCD/sizesclu.dat @@ -5,7 +5,7 @@ * Max. number of conformations in the data set. * integer maxconf,maxstr_proc - PARAMETER (MAXCONF=12000) + PARAMETER (MAXCONF=8000) parameter (maxstr_proc=maxconf/2) * * Max. number of "distances" between conformations. diff --git a/source/unres/src-HCD-5D/COMMON.DFA b/source/unres/src-HCD-5D/COMMON.DFA index 67a1a0d..6759f8b 100644 --- a/source/unres/src-HCD-5D/COMMON.DFA +++ b/source/unres/src-HCD-5D/COMMON.DFA @@ -68,14 +68,21 @@ C NMAP - mapping between dfanum and ndis, nphi, nthe, nnei & NCA, ICAIDX(MAXRES) COMMON /IDFA2/ ishiftca,ilastca c parallel - integer idfadis_start,idfadis_end, - & idfaphi_start,idfaphi_end, - & idfathe_start,idfathe_end, - & idfanei_start,idfanei_end + integer idfadis_start,idfadis_end,idfaphi_start,idfaphi_end, + & idfathe_start,idfathe_end,idfanei_start,idfanei_end, + & idfadis_start_all(0:max_fg_procs-1), + & idfadis_end_all(0:max_fg_procs-1), + & idfaphi_start_all(0:max_fg_procs-1), + & idfaphi_end_all(0:max_fg_procs-1), + & idfathe_start_all(0:max_fg_procs-1), + & idfathe_end_all(0:max_fg_procs-1), + & idfanei_start_all(0:max_fg_procs-1), + & idfanei_end_all(0:max_fg_procs-1) COMMON /dfa_mpi/ idfadis_start,idfadis_end, - & idfaphi_start,idfaphi_end, - & idfathe_start,idfathe_end, - & idfanei_start,idfanei_end + & idfaphi_start,idfaphi_end,idfathe_start,idfathe_end, + & idfanei_start,idfanei_end,idfadis_start_all,idfadis_end_all, + & idfaphi_start_all,idfaphi_end_all,idfathe_start_all, + & idfathe_end_all,idfanei_start_all,idfanei_end_all CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC diff --git a/source/unres/src-HCD-5D/COMMON.INTERACT b/source/unres/src-HCD-5D/COMMON.INTERACT index 8c4876d..14416ad 100644 --- a/source/unres/src-HCD-5D/COMMON.INTERACT +++ b/source/unres/src-HCD-5D/COMMON.INTERACT @@ -58,8 +58,8 @@ c 12/5/03 modified 09/18/03 Bond stretching parameters. & aksc(maxbondterm,ntyp),abond0(maxbondterm,ntyp), & distchainmax,nbondterm(ntyp) C 01/29/15 Lipidic parameters - double precision pepliptran,liptranene, + double precision pepliptran,liptranene, lipscale, &tubetranene, tubetranenepep - common /lipid/ pepliptran,liptranene(ntyp) + common /lipid/ pepliptran,liptranene(ntyp),lipscale common /tubepar/ tubetranene(ntyp), tubetranenepep diff --git a/source/unres/src-HCD-5D/DIMENSIONS b/source/unres/src-HCD-5D/DIMENSIONS index 137b45d..9803b23 100644 --- a/source/unres/src-HCD-5D/DIMENSIONS +++ b/source/unres/src-HCD-5D/DIMENSIONS @@ -16,10 +16,10 @@ C Max. number of coarse-grain processors parameter (max_cg_procs=maxprocs) C Max. number of AA residues integer maxres - parameter (maxres=10000) + parameter (maxres=2000) C Max. number of AA residues per chain integer maxres_chain - parameter (maxres_chain=1200) + parameter (maxres_chain=800) C Max. number of cysteines and other bridging residues integer max_cyst parameter (max_cyst=100) diff --git a/source/unres/src-HCD-5D/MD_A-MTS.F b/source/unres/src-HCD-5D/MD_A-MTS.F index fcef69e..e504cbd 100644 --- a/source/unres/src-HCD-5D/MD_A-MTS.F +++ b/source/unres/src-HCD-5D/MD_A-MTS.F @@ -1955,6 +1955,7 @@ c 8/22/17 AL Loop to produce a low-energy random conformation enddo call int_from_cart(.true.,.false.) call sc_loc_geom(.false.) + dc(:,0)=c(:,1) do i=1,nres-1 do j=1,3 dc(j,i)=c(j,i+1)-c(j,i) diff --git a/source/unres/src-HCD-5D/checkder_p.F b/source/unres/src-HCD-5D/checkder_p.F index 48eedda..e1448db 100644 --- a/source/unres/src-HCD-5D/checkder_p.F +++ b/source/unres/src-HCD-5D/checkder_p.F @@ -132,6 +132,7 @@ c aincr=8.0D-7 c aincr=1.0D-7 print '("Calling CHECK_ECARTINT",1pd12.3)',aincr write (iout,'("Calling CHECK_ECARTINT",1pd12.3)') aincr + call cartprint nf=0 icall=0 call geom_to_var(nvar,x) @@ -212,6 +213,14 @@ c call flush(iout) enddo enddo endif +c write (iout,*) "Vector dc" +c do i=0,nres +c write (iout,'(i5,2(3f10.5,5x))') +c & i,(dc(j,i),j=1,3),(dc(j,i+nres),j=1,3) +c enddo +c write (iout,*) "Coordinates after chainbuild_cart" +c call chainbuild_cart +c call cartprint write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors' do i=0,nres print *,i diff --git a/source/unres/src-HCD-5D/dfa.F b/source/unres/src-HCD-5D/dfa.F index f69b81a..62e8892 100644 --- a/source/unres/src-HCD-5D/dfa.F +++ b/source/unres/src-HCD-5D/dfa.F @@ -71,12 +71,16 @@ C read fragment informations C implicit real*8 (a-h,o-z) include 'DIMENSIONS' +#ifdef MPI + include "mpif.h" + include 'COMMON.SETUP' + integer ierror +#endif include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.DFA' include 'COMMON.FFIELD' include 'COMMON.CONTROL' - include 'COMMON.SETUP' C NOTE THAT FILENAMES are FIXED, CURRENTLY!! @@ -90,6 +94,7 @@ C THIS SHOULD BE MODIFIED!! integer ica1, ica2,ica3,ica4,ica5 integer ishell, inca, itmp,iitmp double precision wtmp + logical lprn /.false./ C C READ DISTANCE C @@ -254,12 +259,55 @@ C BETA is not parallel ! call int_bounds(idfaphi,idfaphi_start,idfaphi_end) call int_bounds(idfathe,idfathe_start,idfathe_end) call int_bounds(idfanei,idfanei_start,idfanei_end) - if (me.eq.king .or. .not. out1file) + if (lprn) write (*,*) "Processor",MyRank," DFA MPI ", + & "idfadis ",idfadis,idfadis_start,idfadis_end, + & "idfaphi ",idfaphi,idfaphi_start,idfaphi_end, + & "idfathe ",idfathe,idfathe_start,idfathe_end, + & "idfanei ",idfanei,idfanei_start,idfanei_end + if (lprn) & write (iout,*) "DFA MPI ", & "idfadis ",idfadis,idfadis_start,idfadis_end, & "idfaphi ",idfaphi,idfaphi_start,idfaphi_end, & "idfathe ",idfathe,idfathe_start,idfathe_end, & "idfanei ",idfanei,idfanei_start,idfanei_end + do i=0,max_fg_procs-1 + idfadis_start_all(j)=0 + idfadis_end_all(j)=0 + idfaphi_start_all(j)=0 + idfaphi_end_all(j)=0 + idfathe_start_all(j)=0 + idfathe_end_all(j)=0 + idfanei_start_all(j)=0 + idfanei_end_all(j)=0 + enddo + call MPI_Allgather(idfadis_start,1,MPI_INTEGER, + & idfadis_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR) + call MPI_Allgather(idfadis_end,1,MPI_INTEGER, + & idfadis_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR) + call MPI_Allgather(idfaphi_start,1,MPI_INTEGER, + & idfaphi_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR) + call MPI_Allgather(idfaphi_end,1,MPI_INTEGER, + & idfaphi_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR) + call MPI_Allgather(idfathe_start,1,MPI_INTEGER, + & idfathe_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR) + call MPI_Allgather(idfathe_end,1,MPI_INTEGER, + & idfathe_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR) + call MPI_Allgather(idfanei_start,1,MPI_INTEGER, + & idfanei_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR) + call MPI_Allgather(idfanei_end,1,MPI_INTEGER, + & idfanei_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR) + if (me.eq.0 .or. out1file) then + write (iout,*) "Partitioning of DFA work" + write (iout,'(5a10)') 'Rank','DFA_dis','DFA_phi','DFA_the', + & 'DFA_nei' + do i=0,nfgtasks-1 + write (iout,'(i10,8i5)') i,idfadis_start_all(i), + & idfadis_end_all(i),idfaphi_start_all(i), + & idfaphi_end_all(i),idfathe_start_all(i), + & idfathe_end_all(i),idfanei_start_all(i), + & idfanei_end_all(i) + enddo + endif #else idfadis_start=1 idfadis_end=idfadis diff --git a/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F b/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F index 28ba1d1..c4e54bc 100644 --- a/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F @@ -84,10 +84,15 @@ c include 'COMMON.CONTACTS' integer i,j,k,itypi,itypj,itypi1,num_conti,iint,ikont double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij, & sigij,r0ij,rcut,sss1,sssgrad1,sqrij - double precision sscale,sscagrad + double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi, + & faclip + double precision sscale,sscagrad,sscagradlip,sscalelip double precision boxshift + double precision gg_lipi(3),gg_lipj(3) c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 c do i=iatsc_s,iatsc_e do ikont=g_listscsc_start,g_listscsc_end i=newcontlisti(ikont) @@ -99,6 +104,7 @@ c do i=iatsc_s,iatsc_e yi=c(2,nres+i) zi=c(3,nres+i) call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) C C Calculate SC interaction energy. C @@ -112,6 +118,11 @@ c do j=istart(i,iint),iend(i,iint) yj=c(2,nres+j) zj=c(3,nres+j) call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) @@ -127,6 +138,7 @@ c do j=istart(i,iint),iend(i,iint) if (sss.lt.1.0d0) then rrij=1.0D0/rij fac=rrij**expon2 + faclip=fac e1=fac*fac*aa e2=fac*bb evdwij=e1+e2 @@ -140,11 +152,16 @@ C gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac + gg_lipi(3)=(sss1*(1.0d0-sss)/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))))/expon + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) + gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k) + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k) + gvdwc(k,i)=gvdwc(k,i)-gg(k)+gg_lipi(k) + gvdwc(k,j)=gvdwc(k,j)+gg(k)+gg_lipj(k) enddo endif c enddo ! j @@ -192,10 +209,15 @@ c include 'COMMON.CONTACTS' integer i,j,k,itypi,itypj,itypi1,num_conti,iint,ikont double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij, & sigij,r0ij,rcut,sqrij,sss1,sssgrad1 - double precision sscale,sscagrad + double precision sscale,sscagrad,sscagradlip,sscalelip + double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi, + & faclip double precision boxshift + double precision gg_lipi(3),gg_lipj(3) c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 c do i=iatsc_s,iatsc_e do ikont=g_listscsc_start,g_listscsc_end i=newcontlisti(ikont) @@ -207,6 +229,7 @@ c do i=iatsc_s,iatsc_e yi=c(2,nres+i) zi=c(3,nres+i) call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) C Change 12/1/95 num_conti=0 C @@ -222,6 +245,11 @@ c do j=istart(i,iint),iend(i,iint) yj=c(2,nres+j) zj=c(3,nres+j) call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) @@ -235,6 +263,7 @@ C Change 12/1/95 to calculate four-body interactions rrij=1.0D0/rij eps0ij=eps(itypi,itypj) fac=rrij**expon2 + faclip=fac e1=fac*fac*aa e2=fac*bb evdwij=e1+e2 @@ -246,11 +275,16 @@ C gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac + gg_lipi(3)=(sss/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))))/expon + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) + gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k) + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k) + gvdwc(k,i)=gvdwc(k,i)-gg(k)+gg_lipi(k) + gvdwc(k,j)=gvdwc(k,j)+gg(k)+gg_lipj(k) enddo endif c enddo ! j @@ -296,10 +330,15 @@ C double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij, & fac_augm,e_augm,r_inv_ij,r_shift_inv,sss1,sssgrad1 logical scheck - double precision sscale,sscagrad + double precision sscale,sscagrad,sscagradlip,sscalelip + double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi, + & faclip double precision boxshift + double precision gg_lipi(3),gg_lipj(3) c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 c do i=iatsc_s,iatsc_e do ikont=g_listscsc_start,g_listscsc_end i=newcontlisti(ikont) @@ -311,6 +350,7 @@ c do i=iatsc_s,iatsc_e yi=c(2,nres+i) zi=c(3,nres+i) call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) C C Calculate SC interaction energy. C @@ -322,6 +362,11 @@ c do j=istart(i,iint),iend(i,iint) yj=c(2,nres+j) zj=c(3,nres+j) call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) @@ -339,6 +384,7 @@ c do j=istart(i,iint),iend(i,iint) & sscagrad(rij/sigma(itypi,itypj),r_cut_respa) r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) fac=r_shift_inv**expon + faclip=fac e1=fac*fac*aa e2=fac*bb evdwij=e_augm+e1+e2 @@ -360,11 +406,16 @@ C gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac + gg_lipi(3)=(sss1*(1.0d0-sss)/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))))/expon + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) + gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k) + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k) + gvdwc(k,i)=gvdwc(k,i)-gg(k)+gg_lipi(k) + gvdwc(k,j)=gvdwc(k,j)+gg(k)+gg_lipj(k) enddo endif c enddo ! j @@ -401,10 +452,15 @@ C double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij, & fac_augm,e_augm,r_inv_ij,r_shift_inv,sss1,sssgrad1 logical scheck - double precision sscale,sscagrad + double precision sscale,sscagrad,sscagradlip,sscalelip + double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi, + & faclip double precision boxshift + double precision gg_lipi(3),gg_lipj(3) c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 c do i=iatsc_s,iatsc_e do ikont=g_listscsc_start,g_listscsc_end i=newcontlisti(ikont) @@ -416,6 +472,7 @@ c do i=iatsc_s,iatsc_e yi=c(2,nres+i) zi=c(3,nres+i) call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) C C Calculate SC interaction energy. C @@ -427,6 +484,11 @@ c do j=istart(i,iint),iend(i,iint) yj=c(2,nres+j) zj=c(3,nres+j) call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) @@ -439,6 +501,7 @@ c do j=istart(i,iint),iend(i,iint) if (sss.gt.0.0d0) then r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) fac=r_shift_inv**expon + faclip=fac e1=fac*fac*aa e2=fac*bb evdwij=e_augm+e1+e2 @@ -459,11 +522,16 @@ C gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac + gg_lipi(3)=(sss/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))))/expon + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) + gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k) + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k) + gvdwc(k,i)=gvdwc(k,i)-gg(k)+gg_lipi(k) + gvdwc(k,j)=gvdwc(k,j)+gg(k)+gg_lipj(k) enddo endif c enddo ! j @@ -501,13 +569,16 @@ C integer itypi,itypj,itypi1,iint,ind,ikont double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi double precision sss1,sssgrad1 - double precision sscale,sscagrad + double precision sscale,sscagrad,sscagradlip,sscalelip + double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi, + & faclip double precision boxshift c double precision rrsave(maxdim) logical lprn evdw=0.0D0 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 c if (icall.eq.0) then c lprn=.true. c else @@ -525,6 +596,7 @@ c do i=iatsc_s,iatsc_e yi=c(2,nres+i) zi=c(3,nres+i) call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -553,6 +625,11 @@ c dscj_inv=dsc_inv(itypj) yj=c(2,nres+j) zj=c(3,nres+j) call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) @@ -573,6 +650,7 @@ C Calculate the angle-dependent terms of energy & contributions to derivatives. C Calculate whole angle-dependent part of epsilon and contributions C to its derivatives fac=(rrij*sigsq)**expon2 + faclip=fac e1=fac*fac*aa e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) @@ -600,6 +678,12 @@ C Calculate radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac + gg_lipi(3)=eps1*(eps2rt*eps2rt) + & *(eps3rt*eps3rt)*sss1*(1.0d0-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 angular part of the gradient and sum add the contributions C to the appropriate components of the Cartesian gradient. call sc_grad_scale((1.0d0-sss)*sss1) @@ -633,11 +717,15 @@ C double precision evdw integer itypi,itypj,itypi1,iint,ind,ikont double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi - double precision sscale,sscagrad + double precision sscale,sscagrad,sscagradlip,sscalelip + double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi, + & faclip double precision boxshift c double precision rrsave(maxdim) logical lprn evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon c if (icall.eq.0) then c lprn=.true. @@ -656,6 +744,7 @@ c do i=iatsc_s,iatsc_e yi=c(2,nres+i) zi=c(3,nres+i) call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -684,6 +773,11 @@ c dscj_inv=dsc_inv(itypj) yj=c(2,nres+j) zj=c(3,nres+j) call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) @@ -701,6 +795,7 @@ C Calculate the angle-dependent terms of energy & contributions to derivatives. C Calculate whole angle-dependent part of epsilon and contributions C to its derivatives fac=(rrij*sigsq)**expon2 + faclip=fac e1=fac*fac*aa e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) @@ -727,6 +822,17 @@ C Calculate radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac + gg_lipi(3)=(sss/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))))/expon + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi + do k=1,3 + gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k) + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k) + gvdwc(k,i)=gvdwc(k,i)-gg(k)+gg_lipi(k) + gvdwc(k,j)=gvdwc(k,j)+gg(k)+gg_lipj(k) + enddo C Calculate the angular part of the gradient and sum add the contributions C to the appropriate components of the Cartesian gradient. call sc_grad_scale(sss) @@ -770,7 +876,8 @@ C evdw=0.0D0 ccccc energy_dec=.false. c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 lprn=.false. c if (icall.eq.0) lprn=.false. ind=0 @@ -822,9 +929,9 @@ c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) call to_box(xj,yj,zj) call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 + & +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 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) @@ -860,6 +967,7 @@ cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon + faclip=fac e1=fac*fac*aa e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) @@ -880,8 +988,8 @@ c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 & evdwij endif - if (energy_dec) write (iout,'(a6,2i5,4f10.5)') - & 'evdw',i,j,rij,sss,sss1,evdwij + if (energy_dec) write (iout,'(a,2i5,5f10.5,e15.5)') + & 'r sss evdw',i,j,1.0d0/rij,sss1,sss,sslipi,sslipj,evdwij C Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 @@ -894,8 +1002,13 @@ C Calculate the radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac - gg_lipi(3)=ssgradlipi*evdwij - gg_lipj(3)=ssgradlipj*evdwij + gg_lipi(3)=eps1*(eps2rt*eps2rt) + & *(eps3rt*eps3rt)*sss1*(1.0d0-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 angular part of the gradient. call sc_grad_scale((1.0d0-sss)*sss1) endif @@ -936,7 +1049,8 @@ C evdw=0.0D0 ccccc energy_dec=.false. c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 + gg_lipi=0.0D0 + gg_lipj=0.0d0 lprn=.false. c if (icall.eq.0) lprn=.false. ind=0 @@ -988,9 +1102,14 @@ c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) call to_box(xj,yj,zj) call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 - & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 + & +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 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 +c write (iout,*) "aa bb",aa_lip(itypi,itypj), +c & bb_lip(itypi,itypj),aa_aq(itypi,itypj), +c & bb_aq(itypi,itypj),aa,bb +c write (iout,*) (sslipi+sslipj)/2.0d0, +c & (2.0d0-sslipi-sslipj)/2.0d0 xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) @@ -1023,6 +1142,7 @@ cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon + faclip=fac e1=fac*fac*aa e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) @@ -1043,8 +1163,8 @@ c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 & evdwij endif - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw',i,j,evdwij + if (energy_dec) write (iout,'(a,2i5,4f10.5,e15.5)') + & 'r sss evdw',i,j,1.0d0/rij,sss,sslipi,sslipj,evdwij C Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 @@ -1056,8 +1176,13 @@ C Calculate the radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac - gg_lipi(3)=ssgradlipi*evdwij - gg_lipj(3)=ssgradlipj*evdwij + 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 write (iout,*) "gglip",i,j,gg_lipi,gg_lipj C Calculate angular part of the gradient. call sc_grad_scale(sss) endif @@ -1098,6 +1223,8 @@ C double precision dist,sscale,sscagrad,sscagradlip,sscalelip double precision sss1,sssgrad1 evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon lprn=.false. c if (icall.eq.0) lprn=.true. @@ -1181,6 +1308,7 @@ C I hate to put IF's in the loops, but here don't have another choice!!!! c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon + faclip=fac e1=fac*fac*aa e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) @@ -1213,6 +1341,12 @@ C Calculate the radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac + gg_lipi(3)=eps1*(eps2rt*eps2rt) + & *(eps3rt*eps3rt)*sss1*(1.0d0-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 angular part of the gradient. call sc_grad_scale((1.0d0-sss)*sss1) endif @@ -1251,6 +1385,8 @@ C double precision dist,sscale,sscagrad,sscagradlip,sscalelip double precision boxshift evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon lprn=.false. c if (icall.eq.0) lprn=.true. @@ -1330,6 +1466,7 @@ C I hate to put IF's in the loops, but here don't have another choice!!!! c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon + faclip=fac e1=fac*fac*aa e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) @@ -1360,6 +1497,12 @@ C Calculate the radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac + 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 angular part of the gradient. call sc_grad_scale(sss) endif @@ -1414,6 +1557,7 @@ c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv C C Calculate the components of the gradient in DC and X C +c write (iout,*) "scgrad gglip",i,j,gg_lipi,gg_lipj do l=1,3 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l) gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l) @@ -1462,6 +1606,8 @@ C common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 + double precision sslipi,sslipj,ssgradlipi,ssgradlipj + common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions #ifdef MOMENT double precision scal_el /1.0d0/ @@ -1556,6 +1702,7 @@ C & .or. itype(i+4).eq.ntyp1 ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) num_conti=0 call eelecij_scale(i,i+2,ees,evdw1,eel_loc) if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) @@ -1580,6 +1727,7 @@ C & .or. itype(i-1).eq.ntyp1 ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -1611,6 +1759,7 @@ C & .or. itype(i-1).eq.ntyp1 ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend #ifdef FOURBODY num_conti=num_cont_hb(i) @@ -1693,7 +1842,9 @@ C------------------------------------------------------------------------------- double precision sscale,sscagrad double precision scalar double precision boxshift - + double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij, + & faclipij2 + common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions #ifdef MOMENT double precision scal_el /1.0d0/ @@ -1726,6 +1877,9 @@ C print *,"WCHODZE2" yj=c(2,j)+0.5D0*dyj zj=c(3,j)+0.5D0*dzj call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0 + faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0 xj=boxshift(xj-xmedi,boxxsize) yj=boxshift(yj-ymedi,boxysize) zj=boxshift(zj-zmedi,boxzsize) @@ -1763,17 +1917,18 @@ c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions eesij=el1+el2 C 12/26/95 - for the evaluation of multi-body H-bonding interactions ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg) - ees=ees+eesij*sss1 - evdw1=evdw1+evdwij*(1.0d0-sss)*sss1 + ees=ees+eesij*sss1*faclipij2 + evdw1=evdw1+evdwij*(1.0d0-sss)*sss1*faclipij2 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, cd & 1.0D0/dsqrt(rrmij),evdwij,eesij, cd & xmedi,ymedi,zmedi,xj,yj,zj if (energy_dec) then - write (iout,'(a6,2i5,0pf7.3,2f7.3)') - & 'evdw1',i,j,evdwij,sss,sss1 - write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij + write (iout,'(a6,2i5,0pf7.3,2i5,e11.3,5f10.5)') + & 'evdw1',i,j,evdwij,iteli,itelj,aaa,sss,sss1,sssgrad,sssgrad1,rij + write (iout,'(a6,2i5,0pf7.3,6f8.5)') 'ees',i,j,eesij, + & fac_shield(i),fac_shield(j),sslipi,sslipj,faclipij,faclipij2 endif C @@ -1791,7 +1946,8 @@ c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) * * Radial derivatives. First process both termini of the fragment (i,j) * - aux=facel+sssgrad1*(1.0d0-sss)*eesij*rmij +c old aux=(facel+sssgrad1*(1.0d0-sss)*eesij*rmij)*faclipij2 + aux=(facel+sssgrad1*eesij*rmij)*faclipij2 c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) ggg(1)=aux*xj ggg(2)=aux*yj @@ -1864,6 +2020,10 @@ c 9/28/08 AL Gradient compotents will be summed only at the end gelc_long(k,j)=gelc_long(k,j)+ggg(k) gelc_long(k,i)=gelc_long(k,i)-ggg(k) enddo + gelc_long(3,j)=gelc_long(3,j)+ + & ssgradlipj*eesij/2.0d0*lipscale**2*sss1 + gelc_long(3,i)=gelc_long(3,i)+ + & ssgradlipi*eesij/2.0d0*lipscale**2*sss1 c gelc_long(3,i)=gelc_long(3,i)+ c ssgradlipi*eesij/2.0d0*lipscale**2*sss1 * @@ -1874,9 +2034,9 @@ cgrad do l=1,3 cgrad gelc(l,k)=gelc(l,k)+ggg(l) cgrad enddo cgrad enddo - facvdw=facvdw+ - & (-sss1*sssgrad/rpp(iteli,itelj)+(1.0d0-sss)*sssgrad1)*rmij*evdwij -c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + facvdw=(facvdw+ + &(-sss1*sssgrad/rpp(iteli,itelj)+(1.0d0-sss)*sssgrad1)*rmij*evdwij) + & *faclipij2 ggg(1)=facvdw*xj ggg(2)=facvdw*yj ggg(3)=facvdw*zj @@ -1890,6 +2050,11 @@ c 9/28/08 AL Gradient compotents will be summed only at the end gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo +!C Lipidic part for scaling weight + gvdwpp(3,j)=gvdwpp(3,j)+ + & sss1*(1.0d0-sss)*ssgradlipj*evdwij/2.0d0*lipscale**2 + gvdwpp(3,i)=gvdwpp(3,i)+ + & sss1*(1.0d0-sss)*ssgradlipi*evdwij/2.0d0*lipscale**2 * * Loop over residues i+1 thru j-1. * @@ -1914,8 +2079,8 @@ c facel=el1+eesij * * Radial derivatives. First process both termini of the fragment (i,j) * - aux=fac+(sssgrad1*(1.0d0-sss)-sssgrad*sss1/rpp(iteli,itelj)) - & *eesij*rmij + aux=(fac+(sssgrad1*(1.0d0-sss)-sssgrad*sss1/rpp(iteli,itelj)) + & *eesij*rmij)*faclipij2 c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) ggg(1)=aux*xj ggg(2)=aux*yj @@ -1954,6 +2119,10 @@ C ggg(3)=facvdw*zj gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo + gvdwpp(3,j)=gvdwpp(3,j)+ + & sss1*ssgradlipj*evdwij/2.0d0*lipscale**2 + gvdwpp(3,i)=gvdwpp(3,i)+ + & sss1*ssgradlipi*evdwij/2.0d0*lipscale**2 #endif * * Angular part @@ -1971,7 +2140,7 @@ cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), cd & (dcosg(k),k=1,3) do k=1,3 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss1 - & *fac_shield(i)**2*fac_shield(j)**2 + & *fac_shield(i)**2*fac_shield(j)**2*faclipij2 c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) enddo @@ -1993,13 +2162,13 @@ cgrad enddo gelc(k,i)=gelc(k,i) & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) & +ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))*sss1 - & *fac_shield(i)**2*fac_shield(j)**2 + & *fac_shield(i)**2*fac_shield(j)**2*faclipij2 c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) gelc(k,j)=gelc(k,j) & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) & +ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))*sss1 - & *fac_shield(i)**2*fac_shield(j)**2 + & *fac_shield(i)**2*fac_shield(j)**2*faclipij2 c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) gelc_long(k,j)=gelc_long(k,j)+ggg(k) gelc_long(k,i)=gelc_long(k,i)-ggg(k) @@ -2213,7 +2382,7 @@ 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)*sss1 + & *fac_shield(i)*fac_shield(j)*sss1*faclipij eel_loc=eel_loc+eel_loc_ij if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. @@ -2265,7 +2434,7 @@ C & *2.0 & +a23*gmuij1(2) & +a32*gmuij1(3) & +a33*gmuij1(4)) - & *fac_shield(i)*fac_shield(j)*sss1 + & *fac_shield(i)*fac_shield(j)*sss1*faclipij c write(iout,*) "derivative over thatai" c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3), c & a33*gmuij1(4) @@ -2281,7 +2450,7 @@ c & a33*gmuij2(4) & +a33*gmuij2(4) gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ & geel_loc_ij*wel_loc - & *fac_shield(i)*fac_shield(j)*sss1 + & *fac_shield(i)*fac_shield(j)*sss1*faclipij c Derivative over j residue geel_loc_ji=a22*gmuji1(1) @@ -2294,7 +2463,7 @@ c & a33*gmuji1(4) gloc(nphi+j,icg)=gloc(nphi+j,icg)+ & geel_loc_ji*wel_loc - & *fac_shield(i)*fac_shield(j)*sss1 + & *fac_shield(i)*fac_shield(j)*sss1*faclipij geel_loc_ji= & +a22*gmuji2(1) @@ -2306,14 +2475,14 @@ c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3), c & a33*gmuji2(4) gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+ & geel_loc_ji*wel_loc - & *fac_shield(i)*fac_shield(j)*sss1 + & *fac_shield(i)*fac_shield(j)*sss1*faclipij #endif cC Paral derivatives in virtual-bond dihedral angles gamma if (i.gt.1) & gel_loc_loc(i-1)=gel_loc_loc(i-1)+ & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) - & *fac_shield(i)*fac_shield(j)*sss1 + & *fac_shield(i)*fac_shield(j)*sss1*faclipij c & *fac_shield(i)*fac_shield(j) c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) @@ -2321,7 +2490,7 @@ c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) 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)*sss1 + & *fac_shield(i)*fac_shield(j)*sss1*faclipij c & *fac_shield(i)*fac_shield(j) c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) @@ -2333,7 +2502,7 @@ C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) do l=1,3 ggg(l)=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)*sss1 + & *fac_shield(i)*fac_shield(j)*sss1*faclipij c & *fac_shield(i)*fac_shield(j) c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) @@ -2343,6 +2512,10 @@ cgrad ghalf=0.5d0*ggg(l) cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf enddo + gel_loc_long(3,j)=gel_loc_long(3,j)+ + & ssgradlipj*eel_loc_ij/2.0d0*lipscale/faclipij + gel_loc_long(3,i)=gel_loc_long(3,i)+ + & ssgradlipi*eel_loc_ij/2.0d0*lipscale/faclipij cgrad do k=i+1,j2 cgrad do l=1,3 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l) @@ -2360,22 +2533,22 @@ c ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut 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)*sss1 + & *fac_shield(i)*fac_shield(j)*sss1*faclipij c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) 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)*sss1 + & *fac_shield(i)*fac_shield(j)*sss1*faclipij c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) 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)*sss1 + & *fac_shield(i)*fac_shield(j)*sss1*faclipij c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) 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)*sss1 + & *fac_shield(i)*fac_shield(j)*sss1*faclipij c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) enddo @@ -2629,8 +2802,10 @@ c write (iout,*) "evdwpp_short" double precision xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp, & dist_temp, dist_init,sss_grad double precision sscale,sscagrad + double precision sslipi,ssgradlipi,sslipj,ssgradlipj double precision boxshift integer ikont + double precision faclipij2 evdw1=0.0D0 C print *,"WCHODZE" c write (iout,*) "iatel_s_vdw",iatel_s_vdw, @@ -2651,6 +2826,7 @@ c do i=iatel_s_vdw,iatel_e_vdw ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) num_conti=0 c write (iout,*) 'i',i,' ielstart',ielstart_vdw(i), c & ' ielend',ielend_vdw(i) @@ -2673,6 +2849,8 @@ c do j=ielstart_vdw(i),ielend_vdw(i) yj=c(2,j)+0.5D0*dyj zj=c(3,j)+0.5D0*dzj call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0 xj=boxshift(xj-xmedi,boxxsize) yj=boxshift(yj-ymedi,boxysize) zj=boxshift(zj-zmedi,boxzsize) @@ -2695,16 +2873,17 @@ c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions if (energy_dec) then write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss endif - evdw1=evdw1+evdwij*sss + evdw1=evdw1+evdwij*sss*faclipij2 if (energy_dec) write (iout,'(a10,2i5,0pf7.3)') & 'evdw1_sum',i,j,evdw1 C C Calculate contributions to the Cartesian gradient. C - facvdw=-6*rrmij*(ev1+evdwij)*sss - ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj/rpp(iteli,itelj) - ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj/rpp(iteli,itelj) - ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj/rpp(iteli,itelj) + facvdw=(-6*rrmij*(ev1+evdwij)*sss+sssgrad*rmij*evdwij/ + & rpp(iteli,itelj))*faclipij2 + 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 @@ -2712,6 +2891,11 @@ C ggg(3)=facvdw*zj gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo +!C Lipidic part for scaling weight + gvdwpp(3,j)=gvdwpp(3,j)+ + & sss*ssgradlipj*evdwij/2.0d0*lipscale**2 + gvdwpp(3,i)=gvdwpp(3,i)+ + & sss*ssgradlipi*evdwij/2.0d0*lipscale**2 endif c enddo ! j enddo ! i diff --git a/source/unres/src-HCD-5D/energy_p_new_barrier.F b/source/unres/src-HCD-5D/energy_p_new_barrier.F index 2c701ca..6d5b25f 100644 --- a/source/unres/src-HCD-5D/energy_p_new_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new_barrier.F @@ -103,10 +103,10 @@ C FG slaves receive the WEIGHTS array wliptran=weights(22) wtube=weights(25) wsaxs=weights(26) - wdfa_dist=weights_(28) - wdfa_tor=weights_(29) - wdfa_nei=weights_(30) - wdfa_beta=weights_(31) + wdfa_dist=weights(28) + wdfa_tor=weights(29) + wdfa_nei=weights(30) + wdfa_beta=weights(31) endif time_Bcast=time_Bcast+MPI_Wtime()-time00 time_Bcastw=time_Bcastw+MPI_Wtime()-time00 @@ -177,8 +177,10 @@ C 107 continue #ifdef DFA C BARTEK for dfa test! +c print *,"Processors",MyRank," wdfa",wdfa_dist if (wdfa_dist.gt.0) then call edfad(edfadis) +c print *,"Processors",MyRank," edfadis",edfadis else edfadis=0 endif @@ -831,7 +833,8 @@ c call flush(iout) #ifdef TIMING c time_allreduce=time_allreduce+MPI_Wtime()-time00 #endif - do i=nnt,nres +c do i=nnt,nres + do i=0,nres do k=1,3 gradbufc(k,i)=0.0d0 enddo @@ -856,7 +859,8 @@ c enddo do j=1,3 gradbufc(j,nres-1)=gradbufc_sum(j,nres) enddo - do i=nres-2,-1,-1 +c do i=nres-2,-1,-1 + do i=nres-2,0,-1 do j=1,3 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) enddo @@ -872,12 +876,13 @@ c enddo #endif #ifdef DEBUG write (iout,*) "gradbufc" - do i=1,nres + do i=0,nres write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) enddo call flush(iout) #endif - do i=-1,nres +c do i=-1,nres + do i=0,nres do j=1,3 gradbufc_sum(j,i)=gradbufc(j,i) gradbufc(j,i)=0.0d0 @@ -886,7 +891,8 @@ c enddo do j=1,3 gradbufc(j,nres-1)=gradbufc_sum(j,nres) enddo - do i=nres-2,-1,-1 +c do i=nres-2,-1,-1 + do i=nres-2,0,-1 do j=1,3 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) enddo @@ -914,7 +920,8 @@ c enddo do k=1,3 gradbufc(k,nres)=0.0d0 enddo - do i=-1,nct +c do i=-1,nct + do i=0,nct do j=1,3 #ifdef SPLITELE C print *,gradbufc(1,13) @@ -1019,6 +1026,8 @@ C print *,gradafm(1,13),"AFM" endif #ifdef DEBUG write (iout,*) "gradc gradx gloc after adding" + write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') + & i,(gradc(j,0,icg),j=1,3),(gradx(j,0,icg),j=1,3) do i=1,nres write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg) @@ -1048,7 +1057,7 @@ C print *,gradafm(1,13),"AFM" #ifdef MPI if (nfgtasks.gt.1) then do j=1,3 - do i=1,nres + do i=0,nres gradbufc(j,i)=gradc(j,i,icg) gradbufx(j,i)=gradx(j,i,icg) enddo @@ -1075,9 +1084,9 @@ c#undef DEBUG call MPI_Barrier(FG_COMM,IERR) time_barrier_g=time_barrier_g+MPI_Wtime()-time00 time00=MPI_Wtime() - call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres, + call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*(nres+1), & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres, + call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*(nres+1), & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres, & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) @@ -1087,7 +1096,7 @@ c#undef DEBUG time_reduce=time_reduce+MPI_Wtime()-time00 #ifdef DEBUG write (iout,*) "gradc after reduce" - do i=1,nres + do i=0,nres do j=1,3 write (iout,*) i,j,gradc(j,i,icg) enddo @@ -1496,10 +1505,15 @@ C double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij, & sigij,r0ij,rcut,sqrij,sss1,sssgrad1 double precision fcont,fprimcont - double precision sscale,sscagrad + double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi, + & faclip + double precision sscale,sscagrad,sscagradlip,sscalelip + double precision gg_lipi(3),gg_lipj(3) double precision boxshift c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 c do i=iatsc_s,iatsc_e do ikont=g_listscsc_start,g_listscsc_end i=newcontlisti(ikont) @@ -1511,6 +1525,7 @@ c do i=iatsc_s,iatsc_e yi=c(2,nres+i) zi=c(3,nres+i) call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) C Change 12/1/95 num_conti=0 C @@ -1526,6 +1541,11 @@ c do j=istart(i,iint),iend(i,iint) yj=c(2,nres+j) zj=c(3,nres+j) call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) @@ -1540,6 +1560,7 @@ C Change 12/1/95 to calculate four-body interactions c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj eps0ij=eps(itypi,itypj) fac=rrij**expon2 + faclip=fac C have you changed here? e1=fac*fac*aa e2=fac*bb @@ -1559,11 +1580,16 @@ C gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac + gg_lipi(3)=(sss1/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))))/expon + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) + gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k) + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k) + gvdwc(k,i)=gvdwc(k,i)-gg(k)+gg_lipi(k) + gvdwc(k,j)=gvdwc(k,j)+gg(k)+gg_lipj(k) enddo cgrad do k=i,j-1 cgrad do l=1,3 @@ -1675,10 +1701,15 @@ C double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij, & fac_augm,e_augm,r_inv_ij,r_shift_inv,sss1,sssgrad1 logical scheck - double precision sscale,sscagrad double precision boxshift + double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi, + & faclip + double precision gg_lipi(3),gg_lipj(3) + double precision sscale,sscagrad,sscagradlip,sscalelip c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 c do i=iatsc_s,iatsc_e do ikont=g_listscsc_start,g_listscsc_end i=newcontlisti(ikont) @@ -1690,6 +1721,7 @@ c do i=iatsc_s,iatsc_e yi=c(2,nres+i) zi=c(3,nres+i) call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) C C Calculate SC interaction energy. C @@ -1701,6 +1733,11 @@ c do j=istart(i,iint),iend(i,iint) yj=c(2,nres+j) zj=c(3,nres+j) call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) @@ -1714,6 +1751,7 @@ c do j=istart(i,iint),iend(i,iint) sssgrad1=sscagrad(rij,r_cut_int) r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) fac=r_shift_inv**expon + faclip=fac C have you changed here? e1=fac*fac*aa e2=fac*bb @@ -1734,11 +1772,16 @@ C gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac + gg_lipi(3)=(sss1/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))))/expon + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) + gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k) + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k) + gvdwc(k,i)=gvdwc(k,i)-gg(k)+gg_lipi(k) + gvdwc(k,j)=gvdwc(k,j)+gg(k)+gg_lipj(k) enddo cgrad do k=i,j-1 cgrad do l=1,3 @@ -1780,13 +1823,16 @@ C integer itypi,itypj,itypi1,iint,ind,ikont double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi, & sss1,sssgrad1 - double precision sscale,sscagrad + double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi, + & faclip + double precision sscale,sscagrad,sscagradlip,sscalelip double precision boxshift c double precision rrsave(maxdim) logical lprn evdw=0.0D0 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 c if (icall.eq.0) then c lprn=.true. c else @@ -1804,6 +1850,7 @@ c do i=iatsc_s,iatsc_e yi=c(2,nres+i) zi=c(3,nres+i) call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1842,6 +1889,11 @@ c alf12=0.0D0 yj=c(2,nres+j) zj=c(3,nres+j) call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) @@ -1864,6 +1916,7 @@ C Calculate whole angle-dependent part of epsilon and contributions C to its derivatives C have you changed here? fac=(rrij*sigsq)**expon2 + faclip=fac e1=fac*fac*aa e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) @@ -1891,6 +1944,12 @@ C Calculate radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac + gg_lipi(3)=eps1*(eps2rt*eps2rt) + & *(eps3rt*eps3rt)*sss1/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 angular part of the gradient and sum add the contributions C to the appropriate components of the Cartesian gradient. call sc_grad @@ -1931,7 +1990,8 @@ C evdw=0.0D0 ccccc energy_dec=.false. C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 lprn=.false. c if (icall.eq.0) lprn=.false. ind=0 @@ -2043,9 +2103,15 @@ c alf12=0.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,*) "tu,", i,j,aa_lip(itypi,itypj),bb_lip(itypi,itypj) -C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)') -C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj)) +c write (iout,*) "aa bb",aa_lip(itypi,itypj), +c & bb_lip(itypi,itypj),aa_aq(itypi,itypj), +c & bb_aq(itypi,itypj),aa,bb +c write (iout,*) (sslipi+sslipj)/2.0d0, +c & (2.0d0-sslipi-sslipj)/2.0d0 + +c write(iout,*) "tu,", i,j,aa_lip(itypi,itypj),bb_lip(itypi,itypj) +c if (aa.ne.aa_aq(itypi,itypj)) write(iout,'(2e15.5)') +c &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj)) C if (ssgradlipj.gt.0.0d0) print *,"??WTF??" C print *,sslipi,sslipj,bordlipbot,zi,zj xj=boxshift(xj-xi,boxxsize) @@ -2116,8 +2182,8 @@ c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 & evdwij endif - if (energy_dec) write (iout,'(a,2i5,2f10.5,e15.5)') - & 'r sss evdw',i,j,1.0d0/rij,sss,evdwij + if (energy_dec) write (iout,'(a,2i5,4f10.5,e15.5)') + & 'r sss evdw',i,j,1.0d0/rij,sss,sslipi,sslipj,evdwij C Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 @@ -2185,7 +2251,8 @@ C double precision dist,sscale,sscagrad,sscagradlip,sscalelip evdw=0.0D0 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 + gg_lipi=0.0d0 + gg_lipj=0.0d0 lprn=.false. c if (icall.eq.0) lprn=.true. ind=0 @@ -2281,6 +2348,7 @@ C I hate to put IF's in the loops, but here don't have another choice!!!! c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon + faclip=fac e1=fac*fac*aa e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) @@ -2310,7 +2378,7 @@ C Calculate gradient components. C Calculate the radial part of the gradient gg_lipi(3)=eps1*(eps2rt*eps2rt) & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip* - & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & (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 @@ -3479,6 +3547,8 @@ C common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 + double precision sslipi,sslipj,ssgradlipi,ssgradlipj + common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions #ifdef MOMENT double precision scal_el /1.0d0/ @@ -3585,6 +3655,7 @@ c end if ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) num_conti=0 call eelecij(i,i+2,ees,evdw1,eel_loc) if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) @@ -3640,6 +3711,7 @@ c & (zmedi.lt.((-0.5d0)*boxzsize))) then c go to 196 c endif call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -3683,6 +3755,7 @@ c & .or. itype(i-1).eq.ntyp1 ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) C xmedi=xmedi+xshift*boxxsize C ymedi=ymedi+yshift*boxysize C zmedi=zmedi+zshift*boxzsize @@ -3802,6 +3875,9 @@ C------------------------------------------------------------------------------- double precision xmedi,ymedi,zmedi double precision sscale,sscagrad,scalar double precision boxshift + double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij, + & faclipij2 + common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions #ifdef MOMENT double precision scal_el /1.0d0/ @@ -3816,6 +3892,7 @@ C 13-go grudnia roku pamietnego... c time00=MPI_Wtime() cd write (iout,*) "eelecij",i,j c ind=ind+1 +c write (iout,*) "lipscale",lipscale iteli=itel(i) itelj=itel(j) if (j.eq.i+2 .and. itelj.eq.2) iteli=2 @@ -3836,6 +3913,9 @@ C zj=c(3,j)+0.5D0*dzj-zmedi yj=c(2,j)+0.5D0*dyj zj=c(3,j)+0.5D0*dzj call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0 + faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0 xj=boxshift(xj-xmedi,boxxsize) yj=boxshift(yj-ymedi,boxysize) zj=boxshift(zj-zmedi,boxzsize) @@ -3875,14 +3955,15 @@ C fac_shield(j)=0.6 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 + ees=ees+eesij*sss*faclipij2 else fac_shield(i)=1.0 fac_shield(j)=1.0 eesij=(el1+el2) - ees=ees+eesij*sss + ees=ees+eesij*sss*faclipij2 endif - evdw1=evdw1+evdwij*sss + ees=ees + evdw1=evdw1+evdwij*sss*faclipij2 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, @@ -3891,8 +3972,9 @@ cd & xmedi,ymedi,zmedi,xj,yj,zj if (energy_dec) then write (iout,'(a6,2i5,0pf7.3,2i5,e11.3,3f10.5)') & 'evdw1',i,j,evdwij,iteli,itelj,aaa,evdw1,sss,rij - write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij, - & fac_shield(i),fac_shield(j) + write (iout,'(a6,2i5,0pf7.3,6f8.5)') 'ees',i,j,eesij, + & fac_shield(i),fac_shield(j),sslipi,sslipj,faclipij, + & faclipij2 endif C @@ -3909,7 +3991,7 @@ C * * Radial derivatives. First process both termini of the fragment (i,j) * - aux=facel*sss+rmij*sssgrad*eesij + aux=(facel*sss+rmij*sssgrad*eesij)*faclipij2 ggg(1)=aux*xj ggg(2)=aux*yj ggg(3)=aux*zj @@ -3991,15 +4073,14 @@ c 9/28/08 AL Gradient compotents will be summed only at the end C print *,"before", gelc_long(1,i), gelc_long(1,j) do k=1,3 gelc_long(k,j)=gelc_long(k,j)+ggg(k) -C & +grad_shield(k,j)*eesij/fac_shield(j) gelc_long(k,i)=gelc_long(k,i)-ggg(k) -C & +grad_shield(k,i)*eesij/fac_shield(i) -C gelc_long(k,i-1)=gelc_long(k,i-1) -C & +grad_shield(k,i)*eesij/fac_shield(i) -C gelc_long(k,j-1)=gelc_long(k,j-1) -C & +grad_shield(k,j)*eesij/fac_shield(j) enddo -C print *,"bafter", gelc_long(1,i), gelc_long(1,j) + gelc_long(3,j)=gelc_long(3,j)+ + & ssgradlipj*eesij/2.0d0*lipscale**2*sss + + gelc_long(3,i)=gelc_long(3,i)+ + & ssgradlipi*eesij/2.0d0*lipscale**2*sss + * * Loop over residues i+1 thru j-1. @@ -4009,7 +4090,7 @@ cgrad do l=1,3 cgrad gelc(l,k)=gelc(l,k)+ggg(l) cgrad enddo cgrad enddo - facvdw=facvdw+sssgrad*rmij*evdwij + facvdw=(facvdw+sssgrad*rmij*evdwij)*faclipij2 ggg(1)=facvdw*xj ggg(2)=facvdw*yj ggg(3)=facvdw*zj @@ -4023,6 +4104,11 @@ c 9/28/08 AL Gradient compotents will be summed only at the end gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo +!C Lipidic part for scaling weight + gvdwpp(3,j)=gvdwpp(3,j)+ + & sss*ssgradlipj*evdwij/2.0d0*lipscale**2 + gvdwpp(3,i)=gvdwpp(3,i)+ + & sss*ssgradlipi*evdwij/2.0d0*lipscale**2 * * Loop over residues i+1 thru j-1. * @@ -4033,7 +4119,7 @@ cgrad enddo cgrad enddo #else C MARYSIA - facvdw=(ev1+evdwij) + facvdw=(ev1+evdwij)*faclipij2 facel=(el1+eesij) fac1=fac fac=-3*rrmij*(facvdw+facvdw+facel)*sss @@ -4076,6 +4162,10 @@ c 9/28/08 AL Gradient compotents will be summed only at the end gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo + gvdwpp(3,j)=gvdwpp(3,j)+ + & sss*ssgradlipj*evdwij/2.0d0*lipscale**2 + gvdwpp(3,i)=gvdwpp(3,i)+ + & sss*ssgradlipi*evdwij/2.0d0*lipscale**2 #endif * * Angular part @@ -4093,7 +4183,7 @@ cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), cd & (dcosg(k),k=1,3) do k=1,3 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))* - & fac_shield(i)**2*fac_shield(j)**2*sss + & fac_shield(i)**2*fac_shield(j)**2*sss*faclipij2 enddo c do k=1,3 c ghalf=0.5D0*ggg(k) @@ -4114,11 +4204,11 @@ C print *,"before22", gelc_long(1,i), gelc_long(1,j) gelc(k,i)=gelc(k,i) & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))*sss - & *fac_shield(i)**2*fac_shield(j)**2 + & *fac_shield(i)**2*fac_shield(j)**2*faclipij2 gelc(k,j)=gelc(k,j) & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))*sss - & *fac_shield(i)**2*fac_shield(j)**2 + & *fac_shield(i)**2*fac_shield(j)**2*faclipij2 gelc_long(k,j)=gelc_long(k,j)+ggg(k) gelc_long(k,i)=gelc_long(k,i)-ggg(k) enddo @@ -4353,7 +4443,7 @@ 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)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij c if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') c & 'eelloc',i,j,eel_loc_ij C Now derivative over eel_loc @@ -4411,7 +4501,7 @@ C Calculate patrial derivative for theta angle & +a23*gmuij1(2) & +a32*gmuij1(3) & +a33*gmuij1(4)) - & *fac_shield(i)*fac_shield(j)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij c write(iout,*) "derivative over thatai" c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3), c & a33*gmuij1(4) @@ -4427,7 +4517,7 @@ c & a33*gmuij2(4) & +a33*gmuij2(4) gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ & geel_loc_ij*wel_loc - & *fac_shield(i)*fac_shield(j)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij c Derivative over j residue geel_loc_ji=a22*gmuji1(1) @@ -4440,7 +4530,7 @@ c & a33*gmuji1(4) gloc(nphi+j,icg)=gloc(nphi+j,icg)+ & geel_loc_ji*wel_loc - & *fac_shield(i)*fac_shield(j)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij geel_loc_ji= & +a22*gmuji2(1) @@ -4452,7 +4542,7 @@ c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3), c & a33*gmuji2(4) gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+ & geel_loc_ji*wel_loc - & *fac_shield(i)*fac_shield(j)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij #endif cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij @@ -4468,12 +4558,12 @@ C Partial derivatives in virtual-bond dihedral angles gamma & 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)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij 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)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) aux=eel_loc_ij/sss*sssgrad*rmij ggg(1)=aux*xj @@ -4482,13 +4572,19 @@ C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) do l=1,3 ggg(l)=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)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) cgrad ghalf=0.5d0*ggg(l) cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf enddo + gel_loc_long(3,j)=gel_loc_long(3,j)+ + & ssgradlipj*eel_loc_ij/2.0d0*lipscale/faclipij + + gel_loc_long(3,i)=gel_loc_long(3,i)+ + & ssgradlipi*eel_loc_ij/2.0d0*lipscale/faclipij + cgrad do k=i+1,j2 cgrad do l=1,3 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l) @@ -4498,19 +4594,19 @@ C Remaining derivatives of eello do l=1,3 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)) - & *fac_shield(i)*fac_shield(j)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij 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)*sss + & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j)*sss*faclipij 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)*sss + & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j)*sss*faclipij 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)*sss + & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j)*sss*faclipij enddo ENDIF @@ -4763,6 +4859,8 @@ C Third- and fourth-order contributions from turns common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 + double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij + common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij j=i+2 c write (iout,*) "eturn3",i,j,j1,j2 a_temp(1,1)=a22 @@ -4800,7 +4898,7 @@ 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) + & *fac_shield(i)*fac_shield(j)*faclipij eello_t3=0.5d0*(pizda(1,1)+pizda(2,2)) & *fac_shield(i)*fac_shield(j) if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2, @@ -4809,10 +4907,10 @@ C#ifdef NEWCORR C Derivatives in theta gloc(nphi+i,icg)=gloc(nphi+i,icg) & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3 - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg) & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3 - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij C#endif C Derivatives in shield mode @@ -4867,14 +4965,14 @@ C Derivatives in gamma(i) call transpose2(auxmat2(1,1),auxmat3(1,1)) call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2)) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij C Derivatives in gamma(i+1) call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1)) call transpose2(auxmat2(1,1),auxmat3(1,1)) call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) gel_loc_turn3(i+1)=gel_loc_turn3(i+1) & +0.5d0*(pizda(1,1)+pizda(2,2)) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij C Cartesian derivatives do l=1,3 c ghalf1=0.5d0*agg(l,1) @@ -4888,7 +4986,7 @@ c ghalf4=0.5d0*agg(l,4) 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) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggi1(l,1)!+agg(l,1) a_temp(1,2)=aggi1(l,2)!+agg(l,2) @@ -4897,7 +4995,7 @@ c ghalf4=0.5d0*agg(l,4) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) & +0.5d0*(pizda(1,1)+pizda(2,2)) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggj(l,1)!+ghalf1 a_temp(1,2)=aggj(l,2)!+ghalf2 a_temp(2,1)=aggj(l,3)!+ghalf3 @@ -4905,7 +5003,7 @@ c ghalf4=0.5d0*agg(l,4) 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) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggj1(l,1) a_temp(1,2)=aggj1(l,2) a_temp(2,1)=aggj1(l,3) @@ -4913,8 +5011,17 @@ c ghalf4=0.5d0*agg(l,4) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,j1)=gcorr3_turn(l,j1) & +0.5d0*(pizda(1,1)+pizda(2,2)) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij enddo + gshieldc_t3(3,i)=gshieldc_t3(3,i)+ + & ssgradlipi*eello_t3/4.0d0*lipscale + gshieldc_t3(3,j)=gshieldc_t3(3,j)+ + & ssgradlipj*eello_t3/4.0d0*lipscale + gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ + & ssgradlipi*eello_t3/4.0d0*lipscale + gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ + & ssgradlipj*eello_t3/4.0d0*lipscale + return end C------------------------------------------------------------------------------- @@ -5043,7 +5150,7 @@ C fac_shield(i)=0.6 C fac_shield(j)=0.4 endif eello_turn4=eello_turn4-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij eello_t4=-(s1+s2+s3) & *fac_shield(i)*fac_shield(j) c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2) @@ -5091,12 +5198,6 @@ C & *2.0 & grad_shield(k,j)*eello_t4/fac_shield(j) enddo endif - - - - - - cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3), cd & ' eello_turn4_num',8*eello_turn4_num #ifdef NEWCORR @@ -5126,7 +5227,7 @@ C Derivatives in gamma(i) 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) + & *fac_shield(i)*fac_shield(j)*faclipij 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)) @@ -5135,7 +5236,7 @@ C Derivatives in gamma(i+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) + & *fac_shield(i)*fac_shield(j)*faclipij 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)) @@ -5147,7 +5248,7 @@ C Derivatives in gamma(i+2) call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij C Cartesian derivatives C Derivatives of this turn contributions in DC(i+2) if (j.lt.nres-1) then @@ -5167,7 +5268,7 @@ C Derivatives of this turn contributions in DC(i+2) 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) + & *fac_shield(i)*fac_shield(j)*faclipij enddo endif C Remaining derivatives of this turn contribution @@ -5186,7 +5287,7 @@ 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) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggi1(l,1) a_temp(1,2)=aggi1(l,2) a_temp(2,1)=aggi1(l,3) @@ -5201,7 +5302,7 @@ 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+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggj(l,1) a_temp(1,2)=aggj(l,2) a_temp(2,1)=aggj(l,3) @@ -5216,7 +5317,7 @@ 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,j)=gcorr4_turn(l,j)-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggj1(l,1) a_temp(1,2)=aggj1(l,2) a_temp(2,1)=aggj1(l,3) @@ -5232,8 +5333,16 @@ C Remaining derivatives of this turn contribution s3=0.5d0*(pizda(1,1)+pizda(2,2)) c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) - enddo + & *fac_shield(i)*fac_shield(j)*faclipij + enddo + gshieldc_t4(3,i)=gshieldc_t4(3,i)+ + & ssgradlipi*eello_t4/4.0d0*lipscale + gshieldc_t4(3,j)=gshieldc_t4(3,j)+ + & ssgradlipj*eello_t4/4.0d0*lipscale + gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ + & ssgradlipi*eello_t4/4.0d0*lipscale + gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ + & ssgradlipj*eello_t4/4.0d0*lipscale return end C----------------------------------------------------------------------------- @@ -11811,6 +11920,7 @@ C--bufliptop--- here true lipid starts C lipid C--buflipbot--- lipid ends buffore starts C--bordlipbot--buffore ends +c call cartprint eliptran=0.0 do i=ilip_start,ilip_end C do i=1,1 @@ -11865,6 +11975,8 @@ CV do i=1,1 if (itype(i).eq.ntyp1) cycle positi=(mod(c(3,i+nres),boxzsize)) if (positi.le.0) positi=positi+boxzsize +c write(iout,*) "i",i," positi",positi,bordlipbot,buflipbot, +c & bordliptop 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) @@ -11875,6 +11987,8 @@ C the energy transfer exist if (positi.lt.buflipbot) then fracinbuf=1.0d0- & ((positi-bordlipbot)/lipbufthick) +c write (iout,*) "i",i,itype(i)," fracinbuf",fracinbuf +c write (iout,*) "i",i," liptranene",liptranene(itype(i)) C lipbufthick is thickenes of lipid buffore sslip=sscalelip(fracinbuf) ssgradlip=-sscagradlip(fracinbuf)/lipbufthick @@ -13250,11 +13364,16 @@ c-------------------------------------------------------------------------- subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi) implicit none include 'DIMENSIONS' + include 'COMMON.IOUNITS' include 'COMMON.CHAIN' double precision xi,yi,zi,sslipi,ssgradlipi double precision fracinbuf double precision sscalelip,sscagradlip - +#ifdef DEBUG + write (iout,*) "bordlipbot",bordlipbot," bordliptop",bordliptop + write (iout,*) "buflipbot",buflipbot," lipbufthick",lipbufthick + write (iout,*) "xi yi zi",xi,yi,zi +#endif if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then C the energy transfer exist if (zi.lt.buflipbot) then @@ -13275,5 +13394,8 @@ C lipbufthick is thickenes of lipid buffore sslipi=0.0d0 ssgradlipi=0.0 endif +#ifdef DEBUG + write (iout,*) "sslipi",sslipi," ssgradlipi",ssgradlipi +#endif return end diff --git a/source/unres/src-HCD-5D/energy_split-sep.F b/source/unres/src-HCD-5D/energy_split-sep.F index 11ea406..34a1bd1 100644 --- a/source/unres/src-HCD-5D/energy_split-sep.F +++ b/source/unres/src-HCD-5D/energy_split-sep.F @@ -118,10 +118,10 @@ C FG slaves receive the WEIGHTS array wliptran=weights(22) wtube=weights(25) wsaxs=weights(26) - wdfa_dist=weights_(28) - wdfa_tor=weights_(29) - wdfa_nei=weights_(30) - wdfa_beta=weights_(31) + wdfa_dist=weights(28) + wdfa_tor=weights(29) + wdfa_nei=weights(30) + wdfa_beta=weights(31) endif call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) diff --git a/source/unres/src-HCD-5D/gradient_p.F b/source/unres/src-HCD-5D/gradient_p.F index adafa53..67275ed 100644 --- a/source/unres/src-HCD-5D/gradient_p.F +++ b/source/unres/src-HCD-5D/gradient_p.F @@ -278,17 +278,20 @@ cd write(iout,*) 'calling int_to_cart' #ifdef DEBUG write (iout,*) "gcart, gxcart, gloc before int_to_cart" #endif - do i=1,nct + do i=0,nct do j=1,3 gcart(j,i)=gradc(j,i,icg) gxcart(j,i)=gradx(j,i,icg) enddo #ifdef DEBUG - if((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then + if (i.eq.0) then + write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3), + & (gxcart(j,i),j=1,3) + else if((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3), & (gxcart(j,i),j=1,3),gloc(i,icg),gloc(i+nphi,icg), & gloc(ialph(i,1),icg),gloc(ialph(i,1)+nside,icg) - else + else write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3), & (gxcart(j,i),j=1,3),gloc(i,icg),gloc(i+nphi,icg) endif diff --git a/source/unres/src-HCD-5D/parmread.F b/source/unres/src-HCD-5D/parmread.F index 4da2913..7550fd5 100644 --- a/source/unres/src-HCD-5D/parmread.F +++ b/source/unres/src-HCD-5D/parmread.F @@ -69,6 +69,7 @@ C setenv LATEX YES C call getenv_loc("PRINT_PARM",lancuch) lprint = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") + & .and. (me.eq.king.or..not.out1file) .and. fg_rank.eq.0 call getenv_loc("LATEX",lancuch) LaTeX = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") C @@ -121,6 +122,7 @@ c & vbldsc0(j,i),aksc(j,i),abond0(j,i) enddo enddo + call flush(iout) endif C reading lipid parameters if (lprint) then @@ -132,6 +134,13 @@ C reading lipid parameters read(iliptranpar,*) liptranene(i) enddo close(iliptranpar) + if (lprint) then + write (iout,'(/a)') "Water-lipid transfer parameters" + write (iout,'(a3,3x,f10.5)') 'p',pepliptran + do i=1,ntyp + write (iout,'(a3,3x,f10.5)') restyp(i),liptranene(i) + enddo + endif #ifdef CRYST_THETA C C Read the parameters of the probability distribution/energy expression @@ -1452,7 +1461,7 @@ cc maxinter is maximum interaction sites #endif if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' + write (iout,'(/a/)') 'SCCor torsional constants:' do l=1,maxinter do i=1,nsccortyp do j=1,nsccortyp @@ -1469,6 +1478,7 @@ cc maxinter is maximum interaction sites enddo enddo enddo + call flush(iout) endif C @@ -1951,6 +1961,7 @@ c call reada(weightcard,'WDFAB',wdfa_beta,0.0d0) call reada(weightcard,'SCAL14',scal14,0.4D0) call reada(weightcard,'SCALSCP',scalscp,1.0d0) + call reada(weightcard,'LIPSCALE',lipscale,1.0D0) call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0) call reada(weightcard,'DELT_CORR',delt_corr,0.5d0) call reada(weightcard,'TEMP0',temp0,300.0d0) diff --git a/source/unres/src-HCD-5D/readpdb-mult.F b/source/unres/src-HCD-5D/readpdb-mult.F index 8346c4a..41fe7f6 100644 --- a/source/unres/src-HCD-5D/readpdb-mult.F +++ b/source/unres/src-HCD-5D/readpdb-mult.F @@ -342,6 +342,7 @@ c write(iout,*)"before int_from_cart nres",nres thetaref(i)=theta(i) phiref(i)=phi(i) enddo + dc(:,0)=c(:,1) do i=1,nres-1 do j=1,3 dc(j,i)=c(j,i+1)-c(j,i) diff --git a/source/unres/src-HCD-5D/readpdb.F b/source/unres/src-HCD-5D/readpdb.F deleted file mode 100644 index c56b1df..0000000 --- a/source/unres/src-HCD-5D/readpdb.F +++ /dev/null @@ -1,631 +0,0 @@ - subroutine readpdb -C Read the PDB file and convert the peptide geometry into virtual-chain -C geometry. - implicit none - 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.FRAG' - include 'COMMON.SETUP' - include 'COMMON.SBRIDGE' - character*3 seq,atom,res - character*80 card - double precision sccor(3,50) - double precision e1(3),e2(3),e3(3) - integer rescode,iterter(maxres),cou - logical fail - integer i,j,iii,ires,ires_old,ishift,ibeg - double precision dcj - bfac=0.0d0 - do i=1,maxres - iterter(i)=0 - enddo - ibeg=1 - lsecondary=.false. - nhfrag=0 - nbfrag=0 - ires=0 - do - read (ipdbin,'(a80)',end=10) card - if (card(:5).eq.'HELIX') then - nhfrag=nhfrag+1 - lsecondary=.true. - read(card(22:25),*) hfrag(1,nhfrag) - read(card(34:37),*) hfrag(2,nhfrag) - endif - if (card(:5).eq.'SHEET') then - nbfrag=nbfrag+1 - lsecondary=.true. - read(card(24:26),*) bfrag(1,nbfrag) - read(card(35:37),*) bfrag(2,nbfrag) -crc---------------------------------------- -crc to be corrected !!! - bfrag(3,nbfrag)=bfrag(1,nbfrag) - bfrag(4,nbfrag)=bfrag(2,nbfrag) -crc---------------------------------------- - endif - if (card(:3).eq.'END') then - goto 10 - else if (card(:3).eq.'TER') then -C End current chain - ires_old=ires+2 - itype(ires_old-1)=ntyp1 - iterter(ires_old-1)=1 - itype(ires_old)=ntyp1 - iterter(ires_old)=1 - ibeg=2 - write (iout,*) "Chain ended",ires,ishift,ires_old - if (unres_pdb) then - do j=1,3 - dc(j,ires)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - endif -C Fish out the ATOM cards. - if (index(card(1:4),'ATOM').gt.0) then - read (card(14:16),'(a3)') atom - if (atom.eq.'CA' .or. atom.eq.'CH3') then -C Calculate the CM of the preceding residue. - if (ibeg.eq.0) then - if (unres_pdb) then - do j=1,3 - dc(j,ires+nres)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - endif -C Start new residue. -c write (iout,'(a80)') card - read (card(23:26),*) ires - read (card(18:20),'(a3)') res - if (ibeg.eq.1) then - ishift=ires-1 - if (res.ne.'GLY' .and. res.ne. 'ACE') then - ishift=ishift-1 - itype(1)=ntyp1 - endif -c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift - ibeg=0 - else if (ibeg.eq.2) then -c Start a new chain - ishift=-ires_old+ires-1 -c write (iout,*) "New chain started",ires,ishift - ibeg=0 - endif - ires=ires-ishift -c write (2,*) "ires",ires," ishift",ishift - if (res.eq.'ACE') then - itype(ires)=10 - else - itype(ires)=rescode(ires,res,0) - endif - read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) - read(card(61:66),*) bfac(ires) -c if(me.eq.king.or..not.out1file) -c & write (iout,'(2i3,2x,a,3f8.3)') -c & ires,itype(ires),res,(c(j,ires),j=1,3) - iii=1 - do j=1,3 - sccor(j,iii)=c(j,ires) - enddo - else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. - & atom.ne.'N ' .and. atom.ne.'C ') then - iii=iii+1 - read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) - endif - endif - enddo - 10 if(me.eq.king.or..not.out1file) - & write (iout,'(a,i5)') ' Nres: ',ires -C Calculate dummy residue coordinates inside the "chain" of a multichain -C system - nres=ires - do i=2,nres-1 -c write (iout,*) i,itype(i),itype(i+1),ntyp1,iterter(i) - if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then - if (itype(i+1).eq.ntyp1.and.iterter(i+1).eq.1 ) then -C 16/01/2014 by Adasko: Adding to dummy atoms in the chain -C first is connected prevous chain (itype(i+1).eq.ntyp1)=true -C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the last dummy residue - print *,i,'tu dochodze' - call refsys(i-3,i-2,i-1,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif !fail - print *,i,'a tu?' - do j=1,3 - c(j,i)=c(j,i-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) - enddo - else !unres_pdb - do j=1,3 - dcj=(c(j,i-2)-c(j,i-3))/2.0 - if (dcj.eq.0) dcj=1.23591524223 - c(j,i)=c(j,i-1)+dcj - c(j,nres+i)=c(j,i) - enddo - endif !unres_pdb - else !itype(i+1).eq.ntyp1 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the first dummy residue - call refsys(i+1,i+2,i+3,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,i)=c(j,i+1)-1.9d0*e2(j) - enddo - else !unres_pdb - do j=1,3 - dcj=(c(j,i+3)-c(j,i+2))/2.0 - if (dcj.eq.0) dcj=1.23591524223 - c(j,i)=c(j,i+1)-dcj - c(j,nres+i)=c(j,i) - enddo - endif !unres_pdb - endif !itype(i+1).eq.ntyp1 - endif !itype.eq.ntyp1 - enddo - write (iout,*) "After loop in readpbd" -C Calculate the CM of the last side chain. - if (unres_pdb) then - do j=1,3 - dc(j,ires)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - nsup=nres - nstart_sup=1 - if (itype(nres).ne.10) then - nres=nres+1 - itype(nres)=ntyp1 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the last dummy residue - call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,nres)=c(j,nres-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) - enddo - else - do j=1,3 - dcj=(c(j,nres-2)-c(j,nres-3))/2.0 - if (dcj.eq.0) dcj=1.23591524223 - c(j,nres)=c(j,nres-1)+dcj - c(j,2*nres)=c(j,nres) - enddo - endif - endif - do i=2,nres-1 - do j=1,3 - c(j,i+nres)=dc(j,i) - enddo - enddo - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - if (itype(1).eq.ntyp1) then - nsup=nsup-1 - nstart_sup=2 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the first dummy residue - call refsys(2,3,4,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,1)=c(j,2)+1.9d0*(e1(j)-e2(j))/dsqrt(2.0d0) - enddo - else - do j=1,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 - endif - endif -C Calculate internal coordinates. - if(me.eq.king.or..not.out1file)then - do ires=1,nres - write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)') - & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3), - & (c(j,nres+ires),j=1,3) - enddo - endif - call flush(iout) -c write(iout,*)"before int_from_cart nres",nres - call int_from_cart(.true.,.false.) - do i=1,nres - thetaref(i)=theta(i) - phiref(i)=phi(i) - enddo - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo -c write (iout,*) i,(dc(j,i),j=1,3),(dc_norm(j,i),j=1,3), -c & vbld_inv(i+1) - enddo - do i=2,nres-1 - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo -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 - call sc_loc_geom(.false.) - call int_from_cart1(.false.) -c call chainbuild -C Copy the coordinates to reference coordinates - do i=1,nres - do j=1,3 - cref(j,i)=c(j,i) - cref(j,i+nres)=c(j,i+nres) - enddo - 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) -cc enddiag - do j=1,nbfrag - do i=1,4 - bfrag(i,j)=bfrag(i,j)-ishift - enddo - enddo - - do j=1,nhfrag - do i=1,2 - hfrag(i,j)=hfrag(i,j)-ishift - enddo - enddo - return - end -c--------------------------------------------------------------------------- - subroutine readpdb_template(k) -C Read the PDB file for read_constr_homology with read2sigma -C and convert the peptide geometry into virtual-chain geometry. - implicit none - 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.FRAG' - include 'COMMON.SETUP' - integer i,j,k,ibeg,ishift1,ires,iii,ires_old,ishift,ity, - & ishift_pdb,ires_ca - logical lprn /.false./,fail - double precision e1(3),e2(3),e3(3) - double precision dcj,efree_temp - character*3 seq,res - character*5 atom - character*80 card - double precision sccor(3,20) - integer rescode,iterter(maxres) - do i=1,maxres - iterter(i)=0 - enddo - ibeg=1 - ishift1=0 - ishift=0 -c write (2,*) "UNRES_PDB",unres_pdb - ires=0 - ires_old=0 - iii=0 - lsecondary=.false. - nhfrag=0 - nbfrag=0 - 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+2 - itype(ires_old-1)=ntyp1 - iterter(ires_old-1)=1 - itype(ires_old)=ntyp1 - iterter(ires_old)=1 - ibeg=2 -c write (iout,*) "Chain ended",ires,ishift,ires_old - if (unres_pdb) then - do j=1,3 - dc(j,ires)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - endif -C Fish out the ATOM cards. - if (index(card(1:4),'ATOM').gt.0) then - read (card(12:16),*) atom -c write (iout,*) "! ",atom," !",ires -c if (atom.eq.'CA' .or. atom.eq.'CH3') then - read (card(23:26),*) ires - read (card(18:20),'(a3)') res -c write (iout,*) "ires",ires,ires-ishift+ishift1, -c & " ires_old",ires_old -c write (iout,*) "ishift",ishift," ishift1",ishift1 -c write (iout,*) "IRES",ires-ishift+ishift1,ires_old - if (ires-ishift+ishift1.ne.ires_old) then -C Calculate the CM of the preceding residue. - if (ibeg.eq.0) then - if (unres_pdb) then - do j=1,3 - dc(j,ires)=sccor(j,iii) - enddo - else - call sccenter(ires_old,iii,sccor) - endif - iii=0 - endif -C Start new residue. - if (res.eq.'Cl-' .or. res.eq.'Na+') then - ires=ires_old - cycle - else if (ibeg.eq.1) then -c write (iout,*) "BEG ires",ires - ishift=ires-1 - if (res.ne.'GLY' .and. res.ne. 'ACE') then - ishift=ishift-1 - itype(1)=ntyp1 - endif - ires=ires-ishift+ishift1 - ires_old=ires -c write (iout,*) "ishift",ishift," ires",ires, -c & " ires_old",ires_old -c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift - ibeg=0 - else if (ibeg.eq.2) then -c Start a new chain - ishift=-ires_old+ires-1 - ires=ires_old+1 -c write (iout,*) "New chain started",ires,ishift - ibeg=0 - else - ishift=ishift-(ires-ishift+ishift1-ires_old-1) - ires=ires-ishift+ishift1 - ires_old=ires - endif - if (res.eq.'ACE' .or. res.eq.'NHE') then - itype(ires)=10 - else - itype(ires)=rescode(ires,res,0) - endif - else - ires=ires-ishift+ishift1 - endif -c write (iout,*) "ires_old",ires_old," ires",ires -c if (card(27:27).eq."A" .or. card(27:27).eq."B") then -c ishift1=ishift1+1 -c endif -c write (2,*) "ires",ires," res ",res," ity",ity - if (atom.eq.'CA' .or. atom.eq.'CH3' .or. - & res.eq.'NHE'.and.atom(:2).eq.'HN') then - read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) -c write (iout,*) "backbone ",atom ,ires,res, (c(j,ires),j=1,3) -#ifdef DEBUG - write (iout,'(2i3,2x,a,3f8.3)') - & ires,itype(ires),res,(c(j,ires),j=1,3) -#endif - iii=iii+1 - do j=1,3 - sccor(j,iii)=c(j,ires) - enddo - if (ishift.ne.0) then - ires_ca=ires+ishift-ishift1 - else - ires_ca=ires - endif -c write (*,*) card(23:27),ires,itype(ires) - else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and. - & atom.ne.'N' .and. atom.ne.'C' .and. - & atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and. - & atom.ne.'OXT' .and. atom(:2).ne.'3H') then -c write (iout,*) "sidechain ",atom - iii=iii+1 - read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) - endif - endif - enddo - 10 if(me.eq.king.or..not.out1file) - & write (iout,'(a,i5)') ' Nres: ',ires -C Calculate dummy residue coordinates inside the "chain" of a multichain -C system - nres=ires - do i=2,nres-1 -c write (iout,*) i,itype(i),itype(i+1) - if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then - if (itype(i+1).eq.ntyp1.and.iterter(i+1).eq.1 ) then -C 16/01/2014 by Adasko: Adding to dummy atoms in the chain -C first is connected prevous chain (itype(i+1).eq.ntyp1)=true -C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the last dummy residue - call refsys(i-3,i-2,i-1,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif !fail - do j=1,3 - c(j,i)=c(j,i-1)-1.9d0*e2(j) - enddo - else !unres_pdb - do j=1,3 - dcj=(c(j,i-2)-c(j,i-3))/2.0 - if (dcj.eq.0) dcj=1.23591524223 - c(j,i)=c(j,i-1)+dcj - c(j,nres+i)=c(j,i) - enddo - endif !unres_pdb - else !itype(i+1).eq.ntyp1 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the first dummy residue - call refsys(i+1,i+2,i+3,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,i)=c(j,i+1)-1.9d0*e2(j) - enddo - else !unres_pdb - do j=1,3 - dcj=(c(j,i+3)-c(j,i+2))/2.0 - if (dcj.eq.0) dcj=1.23591524223 - c(j,i)=c(j,i+1)-dcj - c(j,nres+i)=c(j,i) - enddo - endif !unres_pdb - endif !itype(i+1).eq.ntyp1 - endif !itype.eq.ntyp1 - enddo -C Calculate the CM of the last side chain. - if (unres_pdb) then - do j=1,3 - dc(j,ires)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - nsup=nres - nstart_sup=1 - if (itype(nres).ne.10) then - nres=nres+1 - itype(nres)=ntyp1 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the last dummy residue - call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,nres)=c(j,nres-1)-1.9d0*e2(j) - enddo - else - do j=1,3 - dcj=(c(j,nres-2)-c(j,nres-3))/2.0 - if (dcj.eq.0) dcj=1.23591524223 - c(j,nres)=c(j,nres-1)+dcj - c(j,2*nres)=c(j,nres) - enddo - endif - endif - do i=2,nres-1 - do j=1,3 - c(j,i+nres)=dc(j,i) - enddo - enddo - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - if (itype(1).eq.ntyp1) then - nsup=nsup-1 - nstart_sup=2 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the first dummy residue - call refsys(2,3,4,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,1)=c(j,2)-1.9d0*e2(j) - enddo - else - do j=1,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 - endif - endif -C Copy the coordinates to reference coordinates -c do i=1,2*nres -c do j=1,3 -c cref(j,i)=c(j,i) -c enddo -c enddo -C Calculate internal coordinates. - if (out_template_coord) then - write (iout,'(/a)') - & "Cartesian coordinates of the reference structure" - write (iout,'(a,3(3x,a5),5x,3(3x,a5))') - & "Residue ","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" - do ires=1,nres - write (iout,'(a3,1x,i4,3f8.3,5x,3f8.3)') - & restyp(itype(ires)),ires,(c(j,ires),j=1,3), - & (c(j,ires+nres),j=1,3) - enddo - endif -C Calculate internal coordinates. - call int_from_cart(.true.,.true.) - call sc_loc_geom(.false.) - do i=1,nres - thetaref(i)=theta(i) - phiref(i)=phi(i) - enddo - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=2,nres-1 - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo -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 - do j=1,3 - cref(j,i)=c(j,i) - cref(j,i+nres)=c(j,i+nres) - enddo - enddo - do i=1,2*nres - do j=1,3 - chomo(j,i,k)=c(j,i) - enddo - enddo - - return - end - diff --git a/source/unres/src-HCD-5D/readrtns_CSA.F b/source/unres/src-HCD-5D/readrtns_CSA.F index f120ec7..da28aa3 100644 --- a/source/unres/src-HCD-5D/readrtns_CSA.F +++ b/source/unres/src-HCD-5D/readrtns_CSA.F @@ -1215,8 +1215,6 @@ c write (iout,*) "After read_dist_constr nhpb",nhpb C endif -c write (iout,*) "iranconf",iranconf," extconf",extconf, -c & " start_from_models",start_from_model if (indpdb.eq.0 .and. modecalc.ne.2 .and. modecalc.ne.4 & .and. modecalc.ne.8 .and. modecalc.ne.9 .and. & modecalc.ne.10) then @@ -1230,11 +1228,16 @@ C initial geometry. read(inp,'(8f10.5)',end=36,err=36) & ((c(l,k),l=1,3),k=1,nres), & ((c(l,k+nres),l=1,3),k=nnt,nct) + if (nnt.gt.1) c(:,nres+1)=c(:,1) + if (nct.lt.nres) c(:,2*nres)=c(:,nres) c write (iout,*) "Exit READ_CART" c write (iout,'(8f10.5)') c & ((c(l,k),l=1,3),k=1,nres), c & ((c(l,k+nres),l=1,3),k=nnt,nct) call cartprint + do j=1,3 + dc(j,0)=c(j,1) + enddo do i=1,nres-1 do j=1,3 dc(j,i)=c(j,i+1)-c(j,i) diff --git a/source/unres/src-HCD-5D/unres.F b/source/unres/src-HCD-5D/unres.F index be40e75..978fa59 100644 --- a/source/unres/src-HCD-5D/unres.F +++ b/source/unres/src-HCD-5D/unres.F @@ -59,7 +59,8 @@ c call memmon_print_usage() C Read force field parameters and job setup data call readrtns C -c write (iout,*) "After readrtns" + write (iout,*) "After readrtns" + call flush(iout) call cartprint call intout if (me.eq.king .or. .not. out1file) then @@ -86,9 +87,14 @@ C Fine-grain slaves just do energy and gradient components. call ergastulum ! slave workhouse in Latin else #endif + if (indpdb.eq.0 .and. .not.read_cart) call chainbuild + if (indpdb.ne.0 .or. read_cart) then + dc(1,0)=c(1,1) + dc(2,0)=c(2,1) + dc(3,0)=c(3,1) + endif if (modecalc.eq.0) then write (iout,*) "Calling exec_eeval_or_minim" - call cartprint call exec_eeval_or_minim else if (modecalc.eq.1) then call exec_regularize @@ -223,8 +229,8 @@ c include 'COMMON.CONTACTS' common /lbfgstat/ status,niter,nfun #endif integer ilen - if (indpdb.eq.0) call chainbuild - if (indpdb.ne.0) then + if (indpdb.eq.0 .and. .not.read_cart) call chainbuild + if (indpdb.ne.0 .or. read_cart) then dc(1,0)=c(1,1) dc(2,0)=c(2,1) dc(3,0)=c(3,1) @@ -331,16 +337,7 @@ c print *,'Calling MINIMIZE.' call etotal(energy(0)) etot = energy(0) call enerprint(energy(0)) - call intout - if (out_int) call briefout(0,etot) - if (out_cart) then - cartname=prefix(:ilen(prefix))//'.x' - potE=etot - call cartoutx(0.0d0) - endif - if (outpdb) call pdbout(etot,titel(:50),ipdb) - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) #ifdef LBFGS write (iout,'(a,a9)') 'LBFGS return code:',status write (iout,'(a,i20)') '# of energy evaluations:',nfun+1 @@ -350,10 +347,13 @@ c print *,'Calling MINIMIZE.' write (iout,'(a,i20)') '# of energy evaluations:',nfun+1 write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals #endif - else - print *,'refstr=',refstr - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - call briefout(0,etot) + endif + if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) + if (out_int) call briefout(0,etot) + if (out_cart) then + cartname=prefix(:ilen(prefix))//'.x' + potE=etot + call cartoutx(0.0d0) endif if (outpdb) call pdbout(etot,titel(:50),ipdb) if (outmol2) call mol2out(etot,titel(:32)) diff --git a/source/wham/src-HCD/Makefile b/source/wham/src-HCD/Makefile index ee054bf..8453cdd 120000 --- a/source/wham/src-HCD/Makefile +++ b/source/wham/src-HCD/Makefile @@ -1 +1 @@ -Makefile_MPICH_ifort-okeanos \ No newline at end of file +Makefile_MPICH_ifort \ No newline at end of file diff --git a/source/wham/src-HCD/Makefile_MPICH_ifort b/source/wham/src-HCD/Makefile_MPICH_ifort index 9a83c35..a04725d 100644 --- a/source/wham/src-HCD/Makefile_MPICH_ifort +++ b/source/wham/src-HCD/Makefile_MPICH_ifort @@ -1,10 +1,13 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +INSTALL_DIR = /users/software/mpich2-1.4.1p1_intel +OPT = -mcmodel=medium -shared-intel -O3 -dynamic BIN = ../../../bin/wham -FC= ifort -OPT = -mcmodel=medium -O3 -ip -w -#OPT = -mcmodel=medium -g -CB +FC= ${INSTALL_DIR}/bin/mpif90 +OPT = -mcmodel=medium -O3 -ip -w +#OPT = -O3 -intel-static -mcmodel=medium +#OPT = -O3 -ip -w +#OPT = -g -CB -mcmodel=medium -shared-intel -dynamic FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a +LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a .f.o: ${FC} ${FFLAGS} $*.f @@ -24,20 +27,24 @@ objects = \ molread_zs.o \ openunits.o \ readrtns.o \ + read_constr_homology.o \ arcos.o \ - cartder.o \ cartprint.o \ chainbuild.o \ geomout.o \ icant.o \ intcor.o \ int_from_cart.o \ + refsys.o \ make_ensemble1.o \ matmult.o \ misc.o \ mygetenv.o \ parmread.o \ permut.o \ + seq2chains.o \ + chain_symmetry.o \ + iperm.o \ pinorm.o \ printmat.o \ proc_proc.o \ @@ -47,7 +54,10 @@ objects = \ store_parm.o \ timing.o \ wham_calc1.o \ - ssMD.o + PMFprocess.o \ + ssMD.o \ + boxshift.o \ + oligomer.o objects_compar = \ readrtns_compar.o \ @@ -57,43 +67,93 @@ objects_compar = \ rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o all: no_option - @echo "Specify force field: GAB, 4P or E0LL2Y" + @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR" no_option: GAB: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DWHAM + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM GAB: ${objects} ${objects_compar} xdrf/libxdrf.a - cc -o compinfo compinfo.c + gcc -o compinfo compinfo.c ./compinfo ${FC} -c ${FFLAGS} cinfo.f $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH_GAB.exe + ${LIBS} -o ${BIN}/wham_ifort_MPICH-GAB-HCD.exe + +GAB_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM -DDFA +GAB_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-GAB-HCD-DFA.exe 4P: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPGI -DISNAN -DAMD64 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DWHAM + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM 4P: ${objects} ${objects_compar} xdrf/libxdrf.a - cc -o compinfo compinfo.c + gcc -o compinfo compinfo.c ./compinfo ${FC} -c ${FFLAGS} cinfo.f $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH_4P.exe + ${LIBS} -o ${BIN}/wham_ifort_MPICH-4P-HCD.exe + +4P_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY -DWHAM -DDFA +4P_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-4P-HCD-DFA.exe -E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 -DWHAM +E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DFOURBODY -DAMD64 -DWHAM E0LL2Y: ${objects} ${objects_compar} xdrf/libxdrf.a - cc -o compinfo compinfo.c + gcc -o compinfo compinfo.c ./compinfo ${FC} -c ${FFLAGS} cinfo.f $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH_E0LL2Y.exe + ${LIBS} -o ${BIN}/wham_ifort_MPICH-E0LL2Y-HCD.exe -NEWCORR: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DPGI -DISNAN -DAMD64 -DWHAM +E0LL2Y_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DFOURBODY -DAMD64 -DWHAM -DDFA +E0LL2Y_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-E0LL2Y-HCD-DFA.exe + +NEWCORR: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DPGI -DISNAN -DAMD64 -DWHAM NEWCORR: ${objects} ${objects_compar} xdrf/libxdrf.a - cc -o compinfo compinfo.c + gcc -o compinfo compinfo.c ./compinfo ${FC} -c ${FFLAGS} cinfo.f $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH_NEWCORR.exe + ${LIBS} -o ${BIN}/wham_ifort_MPICH-SC-HCD.exe + +NEWCORR5D: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DPGI -DISNAN -DAMD64 -DWHAM -DFIVEDIAG +NEWCORR5D: ${objects} ${objects_compar} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-SC-HCD5.exe + +NEWCORR_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DDFA -DPGI -DISNAN -DAMD64 -DWHAM -DDFA +NEWCORR_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-SC-HCD-DFA-D.exe + +NEWCORR5D_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DDFA -DPGI -DISNAN -DAMD64 -DWHAM -DFIVEDIAG -DDFA +NEWCORR5D_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-SC-HCD5-DFA.exe xdrf/libxdrf.a: cd xdrf && make diff --git a/source/wham/src-HCD/energy_p_new.F b/source/wham/src-HCD/energy_p_new.F index ce7a6a7..e72d558 100644 --- a/source/wham/src-HCD/energy_p_new.F +++ b/source/wham/src-HCD/energy_p_new.F @@ -1216,6 +1216,9 @@ C returning jth atom to box & +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,*) "tu,", i,j,aa_lip(itypi,itypj),bb_lip(itypi,itypj) +c if (aa.ne.aa_aq(itypi,itypj)) write(iout,'(2e15.5)') +c &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj)) xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) @@ -1278,8 +1281,8 @@ c#define DEBUG #endif c#undef DEBUG c endif - if (energy_dec) write (iout,'(a,2i5,3f10.5)') - & 'r sss evdw',i,j,1.0d0/rij,sss,evdwij + if (energy_dec) write (iout,'(a,2i5,4f10.5,e15.5)') + & 'r sss evdw',i,j,1.0d0/rij,sss,sslipi,sslipj,evdwij if (calc_grad) then C Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 @@ -1288,6 +1291,12 @@ C Calculate gradient components. fac=rij*fac fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij C Calculate the radial part of the gradient + gg_lipi(3)=eps1*(eps2rt*eps2rt) + & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))) + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac @@ -1457,6 +1466,12 @@ C Calculate gradient components. fac=rij*fac-2*expon*rrij*e_augm fac=fac+(evdwij+e_augm)*sssgrad/sss*rij C Calculate the radial part of the gradient + gg_lipi(3)=eps1*(eps2rt*eps2rt) + & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))) + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac @@ -2110,6 +2125,8 @@ C common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 + double precision sslipi,sslipj,ssgradlipi,ssgradlipj + common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions #ifdef MOMENT double precision scal_el /1.0d0/ @@ -2217,6 +2234,7 @@ c end if ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) num_conti=0 call eelecij(i,i+2,ees,evdw1,eel_loc) if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) @@ -2247,6 +2265,7 @@ c & .or. itype(i-1).eq.ntyp1 ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -2287,6 +2306,7 @@ c & .or. itype(i-1).eq.ntyp1 ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) #ifdef FOURBODY num_conti=num_cont_hb(i) #endif @@ -2358,6 +2378,9 @@ C------------------------------------------------------------------------------- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 + double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij, + & faclipij2 + common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions #ifdef MOMENT double precision scal_el /1.0d0/ @@ -2393,6 +2416,9 @@ C zj=c(3,j)+0.5D0*dzj-zmedi yj=c(2,j)+0.5D0*dyj zj=c(3,j)+0.5D0*dzj call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0 + faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0 xj=boxshift(xj-xmedi,boxxsize) yj=boxshift(yj-ymedi,boxysize) zj=boxshift(zj-zmedi,boxzsize) @@ -2432,25 +2458,25 @@ C fac_shield(j)=0.6 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 + ees=ees+eesij*faclipij2 else fac_shield(i)=1.0 fac_shield(j)=1.0 eesij=(el1+el2) - ees=ees+eesij + ees=ees+eesij*faclipij2 endif - evdw1=evdw1+evdwij*sss + evdw1=evdw1+evdwij*sss*faclipij2 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, cd & 1.0D0/dsqrt(rrmij),evdwij,eesij, cd & xmedi,ymedi,zmedi,xj,yj,zj if (energy_dec) then - write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)') - &'evdw1',i,j,evdwij - &,iteli,itelj,aaa,evdw1,sss - write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij, - &fac_shield(i),fac_shield(j) + write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)') + &' evdw1',i,j,evdwij,iteli,itelj,aaa,evdw1,sss + write (iout,'(a6,2i5,0pf7.3,6f8.5)') 'ees',i,j,eesij, + & fac_shield(i),fac_shield(j),sslipi,sslipj,faclipij, + & faclipij2 endif C @@ -2468,9 +2494,10 @@ C * Radial derivatives. First process both termini of the fragment (i,j) * if (calc_grad) then - ggg(1)=facel*xj - ggg(2)=facel*yj - ggg(3)=facel*zj + aux=(facel*sss+rmij*sssgrad*eesij)*faclipij2 + ggg(1)=aux*xj + ggg(2)=aux*yj + ggg(3)=aux*zj if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. & (shield_mode.gt.0)) then C print *,i,j @@ -2556,6 +2583,11 @@ C gelc_long(k,i-1)=gelc_long(k,i-1) C & +grad_shield(k,i)*eesij/fac_shield(i) C gelc_long(k,j-1)=gelc_long(k,j-1) C & +grad_shield(k,j)*eesij/fac_shield(j) + gelc_long(3,j)=gelc_long(3,j)+ + & ssgradlipj*eesij/2.0d0*lipscale**2*sss + + gelc_long(3,i)=gelc_long(3,i)+ + & ssgradlipi*eesij/2.0d0*lipscale**2*sss enddo C print *,"bafter", gelc_long(1,i), gelc_long(1,j) @@ -2568,7 +2600,7 @@ cgrad gelc(l,k)=gelc(l,k)+ggg(l) cgrad enddo cgrad enddo if (sss.gt.0.0) then - facvdw=facvdw+sssgrad*rmij*evdwij + facvdw=(facvdw+sssgrad*rmij*evdwij)*faclipij2 ggg(1)=facvdw*xj ggg(2)=facvdw*yj ggg(3)=facvdw*zj @@ -2587,6 +2619,11 @@ c 9/28/08 AL Gradient compotents will be summed only at the end gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo +!C Lipidic part for scaling weight + gvdwpp(3,j)=gvdwpp(3,j)+ + & sss*ssgradlipj*evdwij/2.0d0*lipscale**2 + gvdwpp(3,i)=gvdwpp(3,i)+ + & sss*ssgradlipi*evdwij/2.0d0*lipscale**2 * * Loop over residues i+1 thru j-1. * @@ -2598,7 +2635,7 @@ cgrad enddo endif ! calc_grad #else C MARYSIA - facvdw=(ev1+evdwij) + facvdw=(ev1+evdwij)*faclipij2 facel=(el1+eesij) fac1=fac fac=-3*rrmij*(facvdw+facvdw+facel)*sss @@ -2642,6 +2679,10 @@ c 9/28/08 AL Gradient compotents will be summed only at the end gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo + gvdwpp(3,j)=gvdwpp(3,j)+ + & sss*ssgradlipj*evdwij/2.0d0*lipscale**2 + gvdwpp(3,i)=gvdwpp(3,i)+ + & sss*ssgradlipi*evdwij/2.0d0*lipscale**2 endif ! calc_grad #endif * @@ -2661,7 +2702,7 @@ cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), cd & (dcosg(k),k=1,3) do k=1,3 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))* - & fac_shield(i)**2*fac_shield(j)**2 + & fac_shield(i)**2*fac_shield(j)**2*sss*faclipij2 enddo c do k=1,3 c ghalf=0.5D0*ggg(k) @@ -2682,11 +2723,11 @@ C print *,"before22", gelc_long(1,i), gelc_long(1,j) gelc(k,i)=gelc(k,i) & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)) - & *fac_shield(i)**2*fac_shield(j)**2 + & *fac_shield(i)**2*fac_shield(j)**2*faclipij2 gelc(k,j)=gelc(k,j) & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)) - & *fac_shield(i)**2*fac_shield(j)**2 + & *fac_shield(i)**2*fac_shield(j)**2*faclipij2 gelc_long(k,j)=gelc_long(k,j)+ggg(k) gelc_long(k,i)=gelc_long(k,i)-ggg(k) enddo @@ -2918,7 +2959,7 @@ 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)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & 'eelloc',i,j,eel_loc_ij c if (eel_loc_ij.ne.0) @@ -2982,7 +3023,7 @@ C Calculate patrial derivative for theta angle & +a23*gmuij1(2) & +a32*gmuij1(3) & +a33*gmuij1(4)) - & *fac_shield(i)*fac_shield(j)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij c write(iout,*) "derivative over thatai" c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3), c & a33*gmuij1(4) @@ -2998,7 +3039,7 @@ c & a33*gmuij2(4) & +a33*gmuij2(4) gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ & geel_loc_ij*wel_loc - & *fac_shield(i)*fac_shield(j)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij c Derivative over j residue geel_loc_ji=a22*gmuji1(1) @@ -3011,7 +3052,7 @@ c & a33*gmuji1(4) gloc(nphi+j,icg)=gloc(nphi+j,icg)+ & geel_loc_ji*wel_loc - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*sss*faclipij geel_loc_ji= & +a22*gmuji2(1) @@ -3023,7 +3064,7 @@ c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3), c & a33*gmuji2(4) gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+ & geel_loc_ji*wel_loc - & *fac_shield(i)*fac_shield(j)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij #endif cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij @@ -3032,12 +3073,12 @@ C Partial derivatives in virtual-bond dihedral angles gamma & 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) + & *fac_shield(i)*fac_shield(j)*sss*faclipij 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) + & *fac_shield(i)*fac_shield(j)*sss*faclipij C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) aux=eel_loc_ij/sss*sssgrad*rmij ggg(1)=aux*xj @@ -3046,13 +3087,18 @@ C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) do l=1,3 ggg(l)=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)*sss + & *fac_shield(i)*fac_shield(j)*sss*faclipij gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) cgrad ghalf=0.5d0*ggg(l) cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf enddo + gel_loc_long(3,j)=gel_loc_long(3,j)+ + & ssgradlipj*eel_loc_ij/2.0d0*lipscale/faclipij + + gel_loc_long(3,i)=gel_loc_long(3,i)+ + & ssgradlipi*eel_loc_ij/2.0d0*lipscale/faclipij cgrad do k=i+1,j2 cgrad do l=1,3 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l) @@ -3062,19 +3108,19 @@ C Remaining derivatives of eello do l=1,3 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*sss*faclipij 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) + & *fac_shield(i)*fac_shield(j)*sss*faclipij 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) + & *fac_shield(i)*fac_shield(j)*sss*faclipij 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) + & *fac_shield(i)*fac_shield(j)*sss*faclipij enddo endif ! calc_grad @@ -3342,6 +3388,8 @@ C Third- and fourth-order contributions from turns common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 + double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij + common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij j=i+2 c write (iout,*) "eturn3",i,j,j1,j2 a_temp(1,1)=a22 @@ -3379,7 +3427,7 @@ 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) + & *fac_shield(i)*fac_shield(j)*faclipij eello_t3=0.5d0*(pizda(1,1)+pizda(2,2)) & *fac_shield(i)*fac_shield(j) if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2, @@ -3389,10 +3437,10 @@ C#ifdef NEWCORR C Derivatives in theta gloc(nphi+i,icg)=gloc(nphi+i,icg) & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3 - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg) & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3 - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij C#endif C Derivatives in shield mode @@ -3447,14 +3495,14 @@ C Derivatives in gamma(i) call transpose2(auxmat2(1,1),auxmat3(1,1)) call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2)) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij C Derivatives in gamma(i+1) call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1)) call transpose2(auxmat2(1,1),auxmat3(1,1)) call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) gel_loc_turn3(i+1)=gel_loc_turn3(i+1) & +0.5d0*(pizda(1,1)+pizda(2,2)) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij C Cartesian derivatives do l=1,3 c ghalf1=0.5d0*agg(l,1) @@ -3468,7 +3516,7 @@ c ghalf4=0.5d0*agg(l,4) 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) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggi1(l,1)!+agg(l,1) a_temp(1,2)=aggi1(l,2)!+agg(l,2) @@ -3477,7 +3525,7 @@ c ghalf4=0.5d0*agg(l,4) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) & +0.5d0*(pizda(1,1)+pizda(2,2)) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggj(l,1)!+ghalf1 a_temp(1,2)=aggj(l,2)!+ghalf2 a_temp(2,1)=aggj(l,3)!+ghalf3 @@ -3485,7 +3533,7 @@ c ghalf4=0.5d0*agg(l,4) 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) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggj1(l,1) a_temp(1,2)=aggj1(l,2) a_temp(2,1)=aggj1(l,3) @@ -3493,7 +3541,7 @@ c ghalf4=0.5d0*agg(l,4) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,j1)=gcorr3_turn(l,j1) & +0.5d0*(pizda(1,1)+pizda(2,2)) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij enddo endif ! calc_grad @@ -3628,7 +3676,7 @@ C fac_shield(i)=0.6 C fac_shield(j)=0.4 endif eello_turn4=eello_turn4-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij eello_t4=-(s1+s2+s3) & *fac_shield(i)*fac_shield(j) c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2) @@ -3705,7 +3753,7 @@ C Derivatives in gamma(i) 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) + & *fac_shield(i)*fac_shield(j)*faclipij 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)) @@ -3714,7 +3762,7 @@ C Derivatives in gamma(i+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) + & *fac_shield(i)*fac_shield(j)*faclipij 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)) @@ -3726,7 +3774,7 @@ C Derivatives in gamma(i+2) call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij if (calc_grad) then C Cartesian derivatives C Derivatives of this turn contributions in DC(i+2) @@ -3747,7 +3795,7 @@ C Derivatives of this turn contributions in DC(i+2) 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) + & *fac_shield(i)*fac_shield(j)*faclipij enddo endif C Remaining derivatives of this turn contribution @@ -3766,7 +3814,7 @@ 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) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggi1(l,1) a_temp(1,2)=aggi1(l,2) a_temp(2,1)=aggi1(l,3) @@ -3781,7 +3829,7 @@ 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+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggj(l,1) a_temp(1,2)=aggj(l,2) a_temp(2,1)=aggj(l,3) @@ -3796,7 +3844,7 @@ 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,j)=gcorr4_turn(l,j)-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij a_temp(1,1)=aggj1(l,1) a_temp(1,2)=aggj1(l,2) a_temp(2,1)=aggj1(l,3) @@ -3812,7 +3860,7 @@ C Remaining derivatives of this turn contribution s3=0.5d0*(pizda(1,1)+pizda(2,2)) c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) - & *fac_shield(i)*fac_shield(j) + & *fac_shield(i)*fac_shield(j)*faclipij enddo endif ! calc_grad @@ -9492,6 +9540,8 @@ C--bufliptop--- here true lipid starts C lipid C--buflipbot--- lipid ends buffore starts C--bordlipbot--buffore ends +c call cartprint +c write (iout,*) "Eliptransfer peplipran",pepliptran eliptran=0.0 do i=1,nres C do i=1,1 @@ -9543,6 +9593,8 @@ CV do i=1,1 if (itype(i).eq.ntyp1) cycle positi=(mod(c(3,i+nres),boxzsize)) if (positi.le.0) positi=positi+boxzsize +c write(iout,*) "i",i," positi",positi,bordlipbot,buflipbot, +c & bordliptop 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) @@ -9553,8 +9605,11 @@ C the energy transfer exist if (positi.lt.buflipbot) then fracinbuf=1.0d0- & ((positi-bordlipbot)/lipbufthick) +c write (iout,*) "i",i,itype(i)," fracinbuf",fracinbuf +c write (iout,*) "i",i," liptranene",liptranene(itype(i)) C lipbufthick is thickenes of lipid buffore sslip=sscalelip(fracinbuf) +c write (iout,*) "sslip",sslip ssgradlip=-sscagradlip(fracinbuf)/lipbufthick eliptran=eliptran+sslip*liptranene(itype(i)) gliptranx(3,i)=gliptranx(3,i) @@ -9580,6 +9635,7 @@ C print *,"I am in true lipid" endif ! if in lipid or buffor C else C eliptran=elpitran+0.0 ! I am in water +c write (iout,*) "eliptran",eliptran enddo return end diff --git a/source/wham/src-HCD/include_unres/COMMON.INTERACT b/source/wham/src-HCD/include_unres/COMMON.INTERACT index 7d6b59f..c929acb 100644 --- a/source/wham/src-HCD/include_unres/COMMON.INTERACT +++ b/source/wham/src-HCD/include_unres/COMMON.INTERACT @@ -30,7 +30,9 @@ c 12/5/03 modified 09/18/03 Bond stretching parameters. & distchainmax,nbondterm(ntyp) &,vbldpDUM C 01/29/15 Lipidic parameters - double precision pepliptran,liptranene - common /lipid/ pepliptran,liptranene(ntyp) + double precision pepliptran,liptranene,lipscale,tubetranene, + & tubetranenepep + common /lipid/ pepliptran,liptranene(ntyp),lipscale + common /tubepar/ tubetranene(ntyp), tubetranenepep diff --git a/source/wham/src-HCD/initialize_p.F b/source/wham/src-HCD/initialize_p.F index a2281e5..8217663 100644 --- a/source/wham/src-HCD/initialize_p.F +++ b/source/wham/src-HCD/initialize_p.F @@ -304,7 +304,7 @@ c------------------------------------------------------------------------- ! 15 16 17 18 19 20 21 & "WHPB ","WVDWPP","WSCP14","WBOND","WSCCOR","WDIHC","WSC", ! 22 23 24 25 26 27 28 - & "WLIPTRAN","WAFM","WTHETC","WSHIELD","WSAXS","WHOMO","WDFAD", + & "WLT ","WAFM","WTHETC","WSHIELD","WSAXS","WHOMO","WDFAD", ! 29 30 31 & "WDFAT","WDFAN","WDFAB"/ data ww0 / diff --git a/source/wham/src-HCD/oligomer.F b/source/wham/src-HCD/oligomer.F index c63ea47..44dddcf 100644 --- a/source/wham/src-HCD/oligomer.F +++ b/source/wham/src-HCD/oligomer.F @@ -40,7 +40,8 @@ c print *,i,c(:,i) sumodl_min=1.0d10 do i=0,3**nchain-1 ii=i - do ichain=1,nchain + lshift(1)=0 + do ichain=2,nchain lshift(ichain)=mod(ii,3)-1 ii=ii/3 enddo @@ -133,6 +134,7 @@ c coordinate system enddo #endif do ichain=1,nchain +c write (iout,*) "shift_coord",shift_coord(:,ichain) do i=chain_border1(1,ichain),chain_border1(2,ichain) do j=1,3 c(j,i)=c(j,i)+shift_coord(j,ichain) diff --git a/source/wham/src-HCD/parmread.F b/source/wham/src-HCD/parmread.F index b21acb2..4636b60 100644 --- a/source/wham/src-HCD/parmread.F +++ b/source/wham/src-HCD/parmread.F @@ -63,6 +63,8 @@ C Assign virtual-bond length call reada(controlcard,'SCALSCP',scalscp,1.0d0) call reada(controlcard,'CUTOFF',cutoff_corr,7.0d0) call reada(controlcard,'DELT_CORR',delt_corr,0.5d0) + call reada(controlcard,'LIPSCALE',lipscale,1.0D0) +c write (iout,*) "lipscale",lipscale r0_corr=cutoff_corr-delt_corr write (iout,*) "iparm",iparm," myparm",myparm diff --git a/source/wham/src-HCD/proc_cont.f b/source/wham/src-HCD/proc_cont.f index 9269496..c70652a 100644 --- a/source/wham/src-HCD/proc_cont.f +++ b/source/wham/src-HCD/proc_cont.f @@ -15,10 +15,10 @@ include 'COMMON.GEO' write (iout,*) "proc_cont: nlevel",nlevel if (nlevel.lt.0) then - write (iout,*) "call define_fragments" +c write (iout,*) "call define_fragments" call define_fragments else - write (iout,*) "call secondary2" +c write (iout,*) "call secondary2" call secondary2(.true.,.false.,ncont_pept_ref,icont_pept_ref, & isec_ref) endif -- 1.7.9.5 From 86a362122bd1be5017363503cccd66c93698acdb Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Mon, 15 Jun 2020 23:38:20 +0200 Subject: [PATCH 07/16] dfa & multichain cluster --- source/cluster/wham/src-HCD/COMMON.DFA | 2 +- source/cluster/wham/src-HCD/DIMENSIONS | 2 +- source/unres/src-HCD-5D/COMMON.LOCAL | 9 +- source/unres/src-HCD-5D/DIMENSIONS | 6 +- .../unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos | 34 +++--- .../src-HCD-5D/Makefile_MPICH_ifort-prometheus | 118 ++++++++++++++------ .../unres/src-HCD-5D/Makefile_MPICH_ifort-tryton | 33 +++--- source/unres/src-HCD-5D/chainbuild.F | 82 +++++++++++++- source/unres/src-HCD-5D/dfa.F | 2 + source/unres/src-HCD-5D/gen_rand_conf.F | 6 +- source/unres/src-HCD-5D/readrtns_CSA.F | 3 +- source/wham/src-HCD/COMMON.DFA | 2 +- source/wham/src-HCD/DIMENSIONS | 2 +- 13 files changed, 222 insertions(+), 79 deletions(-) diff --git a/source/cluster/wham/src-HCD/COMMON.DFA b/source/cluster/wham/src-HCD/COMMON.DFA index c6add4f..064a7ce 100644 --- a/source/cluster/wham/src-HCD/COMMON.DFA +++ b/source/cluster/wham/src-HCD/COMMON.DFA @@ -11,7 +11,7 @@ C Total : ~ 11 * Nres restraints C C INTEGER IDFAMAX,IDFAMX2,IDFACMD,IDMAXMIN, MAXN - PARAMETER(IDFAMAX=4000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) + PARAMETER(IDFAMAX=10000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) PARAMETER(MAXN=4) real*8 wwdist,wwangle,wwnei parameter(wwdist=1.0d0,wwangle=1.0d0,wwnei=1.0d0) diff --git a/source/cluster/wham/src-HCD/DIMENSIONS b/source/cluster/wham/src-HCD/DIMENSIONS index e6a29b3..247819a 100644 --- a/source/cluster/wham/src-HCD/DIMENSIONS +++ b/source/cluster/wham/src-HCD/DIMENSIONS @@ -26,7 +26,7 @@ C Max number of symetric chains integer maxchain parameter (maxchain=50) integer maxperm - parameter (maxperm=120) + parameter (maxperm=5040) C Max. number of derivatives of virtual-bond and side-chain vectors in theta C or phi. integer maxdim diff --git a/source/unres/src-HCD-5D/COMMON.LOCAL b/source/unres/src-HCD-5D/COMMON.LOCAL index 1c1ed2f..f4828fc 100644 --- a/source/unres/src-HCD-5D/COMMON.LOCAL +++ b/source/unres/src-HCD-5D/COMMON.LOCAL @@ -2,10 +2,11 @@ & sigc0,dsc,dsc_inv,bsc,censc,gaussc,dsc0 integer nlob C Parameters of the virtual-bond-angle probability distribution - 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) + common /thetas/ a0thet(-ntyp1:ntyp1), + & athet(2,-ntyp1:ntyp1,-1:1,-1:1), + & bthet(2,-ntyp1:ntyp1,-1:1,-1:1),polthet(0:3,-ntyp1:ntyp1), + & gthet(3,-ntyp1:ntyp1),theta0(-ntyp1:ntyp1),sig0(-ntyp1:ntyp1), + & sigc0(-ntyp1:ntyp1) C Parameters of the side-chain probability distribution common /sclocal/ dsc(ntyp1),dsc_inv(ntyp1),bsc(maxlob,ntyp), & censc(3,maxlob,-ntyp:ntyp),gaussc(3,3,maxlob,-ntyp:ntyp), diff --git a/source/unres/src-HCD-5D/DIMENSIONS b/source/unres/src-HCD-5D/DIMENSIONS index 9803b23..ed21dfe 100644 --- a/source/unres/src-HCD-5D/DIMENSIONS +++ b/source/unres/src-HCD-5D/DIMENSIONS @@ -16,10 +16,10 @@ C Max. number of coarse-grain processors parameter (max_cg_procs=maxprocs) C Max. number of AA residues integer maxres - parameter (maxres=2000) + parameter (maxres=10000) C Max. number of AA residues per chain integer maxres_chain - parameter (maxres_chain=800) + parameter (maxres_chain=1200) C Max. number of cysteines and other bridging residues integer max_cyst parameter (max_cyst=100) @@ -32,7 +32,7 @@ C Max number of symetric chains integer maxchain parameter (maxchain=50) integer maxperm - parameter (maxperm=120) + parameter (maxperm=5040) C Max. number of variables integer maxvar parameter (maxvar=6*maxres) diff --git a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos index b851430..853e319 100644 --- a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos +++ b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos @@ -4,20 +4,17 @@ FC = ftn -OPT = -O3 -ip -mcmodel=medium -shared-intel -dynamic -#OPT = -g -CA -CB -mcmodel=medium -shared-intel -dynamic -OPT2 = -g -O0 -mcmodel=medium -shared-intel -dynamic +OPT = -O3 -ip -mcmodel=medium -shared-intel -dynamic OPTE = -c -O3 -ipo -mcmodel=medium -shared-intel -dynamic -#OPTE = ${OPT} -c - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -#FFLAGS1 = -c -g -CA -CB -I$(INSTALL_DIR)/include -#FFLAGS = ${FFLAGS1} -FFLAGS1 = ${FFLAGS} -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = ${OPTE} -I$(INSTALL_DIR)/include -#FFLAGSE = ${FFLAGS} +OPT2 = -O2 -ip -mcmodel=medium -shared-intel -dynamic +OPT0 = -g -O0 -mcmodel=medium -shared-intel -dynamic +OPT1 = -g -CA -CB -mcmodel=medium -shared-intel -dynamic +FFLAGS = -c ${OPT} +FFLAGSE = -c ${OPTE} +FFLAGS2 = -c ${OPT2} +FFLAGS1 = -c ${OPT1} +FFLAGS0 = -c ${OPT0} LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a #/opt/cray/mpt/7.3.2/gni/mpich-intel/15.0/lib/libmpich.a @@ -162,7 +159,7 @@ chainbuild.o: chainbuild.F ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F djacob.o: djacob.f - ${FC} ${FFLAGS2} djacob.f + ${FC} ${FFLAGS0} djacob.f matmult.o: matmult.f ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f @@ -177,10 +174,10 @@ cartder.o : cartder.F ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F + ${FC} ${FFLAGS0} ${CPPFLAGS} readpdb.F readpdb-mult.o : readpdb-mult.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb-mult.F + ${FC} ${FFLAGS0} ${CPPFLAGS} readpdb-mult.F sumsld.o : sumsld.f ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f @@ -213,10 +210,13 @@ add.o : add.f ${FC} ${FFLAGS1} add.f eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f + ${FC} ${FFLAGS0} eigen.f dfa.o: dfa.F - ${FC} ${FFLAGS2} dfa.F + ${FC} ${CPPFLAGS} ${FFLAGS} dfa.F + +rmscalc.o: rmscalc.F + ${FC} ${FFLAGS2} ${CPPFLAGS} rmscalc.F proc_proc.o: proc_proc.c ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-prometheus b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-prometheus index 6d4851b..e51973e 100644 --- a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-prometheus +++ b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-prometheus @@ -4,20 +4,19 @@ FC = mpif90 -fc=ifort -OPT = -O3 -ip -mcmodel=medium -shared-intel -#OPT = -O3 -#OPT = -g -CA -CB -mcmodel=medium -shared-intel - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -g -CA -CB -mcmodel=medium -shared-intel -#FFLAGS = ${FFLAGS1} -FFLAGS2 = -c -g -O0 -mcmodel=medium -shared-intel -FFLAGSE = -c -O3 -ipo -mcmodel=medium -shared-intel -#FFLAGSE = ${FFLAGS} - - -#LIBS = -L$(INSTALL_DIR)/lib -lmpi xdrf/libxdrf.a -LIBS = -lmpi xdrf/libxdrf.a +OPT = -O3 -ip -mcmodel=medium -shared-intel +OPTE = -O3 -ipo -mcmodel=medium -shared-intel +OPT2 = -O2 -ip -mcmodel=medium -shared-intel +OPT0 = -g -O0 -mcmodel=medium -shared-intel +OPT1 = -g -CA -CB -mcmodel=medium -shared-intel + +FFLAGS = -c ${OPT} +FFLAGSE = -c ${OPTE} +FFLAGS2 = -c ${OPT2} +FFLAGS1 = -c ${OPT1} +FFLAGS0 = -c ${OPT0} + +LIBS = -L$(INSTALL_DIR)/lib -lmpi xdrf/libxdrf.a #/opt/cray/mpt/7.3.2/gni/mpich-intel/15.0/lib/libmpich.a ARCH = LINUX @@ -25,7 +24,7 @@ PP = /lib/cpp -P all: no_option - @echo "Specify force field: GAB, 4P or E0LL2Y" + @echo "Specify force field: GAB, 4P, E0LL2Y or NEWCORR" .SUFFIXES: .F .F.o: @@ -34,26 +33,31 @@ all: no_option object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o econstr_qlike.o econstrq-PMF.o PMFprocess.o energy_p_new_barrier.o \ + pinorm.o randgens.o rescode.o intcor.o timing.o misc.o \ + cart2intgrad.o checkder_p.o contact_cp econstr_local.o econstr_qlike.o \ + econstrq-PMF.o PMFprocess.o energy_p_new_barrier.o make_xx_list.o \ energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o permut.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ + cored.o rmdd.o geomout.o readpdb-mult.o int_from_cart.o regularize.o \ + thread.o fitsq.o mcm.o \ + mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o \ eigen.o blas.o add.o entmcm.o minim_mcmf.o \ together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ + banach.o distfit.o rmsd.o rmscalc.o elecont.o dihed_cons.o \ + sc_move.o local_move.o djacob.o \ intcartderiv.o lagrangian_lesyng.o\ + chain_symmetry.o permut.o seq2chains.o iperm.o\ stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o ssMD.o + q_measure.o gnmr1.o mygauss.o ssMD.o + +object_lbfgs = inform.o iounit.o keys.o linmin.o math.o minima.o scales.o output.o lbfgs.o search.o optsave_dum.o no_option: GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = ../../../bin/unres/MD/unres-mult-symetr_KCC_ifort_MPICH-prometheus_GAB.exe + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY +GAB: BIN = ~/unres/bin/unres_ifort_MPICH-prometheus_GAB-HCD.exe GAB: ${object} xdrf/libxdrf.a gcc -o compinfo compinfo.c ./compinfo | true @@ -61,8 +65,8 @@ GAB: ${object} xdrf/libxdrf.a ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} 4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -4P: BIN = ../../../bin/unres/MD/unres-mult-symetr_KCC_ifort_MPICH-prometheus_4P.exe + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY +4P: BIN = ~/unres/bin/unres_ifort_MPICH-prometheus_4P-HCD.exe 4P: ${object} xdrf/libxdrf.a gcc -o compinfo compinfo.c ./compinfo | true @@ -70,22 +74,58 @@ GAB: ${object} xdrf/libxdrf.a ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -E0LL2Y: BIN = ../../../bin/unres/MD/unres-mult-symetr_KCC_ifort_MPICH-prometheus_E0LL2Y.exe + -DSPLITELE -DLANG0 -DFOURBODY +E0LL2Y: BIN = ~/unres/bin/unres_ifort_MPICH-prometheus_E0LL2Y-HCD.exe E0LL2Y: ${object} xdrf/libxdrf.a gcc -o compinfo compinfo.c ./compinfo | true ${FC} ${FFLAGS} cinfo.f ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} +E0LL2Y_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DFOURBODY -DDFA +E0LL2Y_DFA: BIN = ~/bin/bin/unres_ifort_MPICH-prometheus_E0LL2Y-HCD-DFA.exe +E0LL2Y_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + NEWCORR: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -NEWCORR: BIN = ~/unres/bin/unres-mult-symetr_KCC_ifort_MPICH-prometheus_NEWCORR-SAXS-NMRAMB.exe + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD #-DFOURBODY #-DMYGAUSS #-DTIMING +NEWCORR: BIN = ~/unres/bin/unres_ifort_MPICH-prometheus_SC-HCD.exe NEWCORR: ${object} xdrf/libxdrf.a gcc -o compinfo compinfo.c ./compinfo | true ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DFIVEDIAG -DLBFGS #-DMYGAUSS #-DTIMING +NEWCORR5D: BIN = ~/unres/bin/unres_ifort_MPICH-prometheus_SC-HCD5.exe +NEWCORR5D: ${object_lbfgs} ${object} fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} ${object_lbfgs} fdisy.o fdiag.o machpd.o kinetic_CASC.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DDFA #-DMYGAUSS #-DTIMING +NEWCORR_DFA: BIN = ~/unres/bin/unres_ifort_MPICH-prometheus_SC-HCD-DFA.exe +NEWCORR_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DFIVEDIAG -DLBFGS -DDFA #-DMYGAUSS #-DTIMING +NEWCORR5D_DFA: BIN = ~/unres/bin/unres_ifort_MPICH-prometheus_SC-HCD5-DFA.exe +NEWCORR5D_DFA: ${object_lbfgs} ${object} dfa.o fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object_lbfgs} ${object} fdisy.o fdiag.o machpd.o dfa.o kinetic_CASC.o cinfo.o ${LIBS} -o ${BIN} xdrf/libxdrf.a: cd xdrf && make @@ -100,6 +140,9 @@ test.o: test.F chainbuild.o: chainbuild.F ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F +djacob.o: djacob.f + ${FC} ${FFLAGS0} djacob.f + matmult.o: matmult.f ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f @@ -113,7 +156,10 @@ cartder.o : cartder.F ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F + ${FC} ${FFLAGS0} ${CPPFLAGS} readpdb.F + +readpdb-mult.o : readpdb-mult.F + ${FC} ${FFLAGS0} ${CPPFLAGS} readpdb-mult.F sumsld.o : sumsld.f ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f @@ -146,7 +192,13 @@ add.o : add.f ${FC} ${FFLAGS1} add.f eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f + ${FC} ${FFLAGS0} eigen.f + +dfa.o: dfa.F + ${FC} ${CPPFLAGS} ${FFLAGS} dfa.F + +rmscalc.o: rmscalc.F + ${FC} ${FFLAGS2} ${CPPFLAGS} rmscalc.F proc_proc.o: proc_proc.c ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton index c6a571b..1ca2bbc 100644 --- a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton +++ b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-tryton @@ -3,14 +3,17 @@ FC = mpif90 -fc=ifort -OPT = -O3 -ip -mcmodel=medium -shared-intel -#OPT = -g -CA -CB -mcmodel=medium -shared-intel - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -g -CA -CB -mcmodel=medium -shared-intel -#FFLAGS1 = ${FFLAGS} -FFLAGS2 = -c -g -O0 -mcmodel=medium -shared-intel -FFLAGSE = -c -O3 -ipo -mcmodel=medium -shared-intel +OPT = -O3 -ip -mcmodel=medium -shared-intel +OPTE = -O3 -ipo -mcmodel=medium -shared-intel +OPT2 = -O2 -ip -mcmodel=medium -shared-intel +OPT0 = -g -O0 -mcmodel=medium -shared-intel +OPT1 = -g -CA -CB -mcmodel=medium -shared-intel + +FFLAGS = -c ${OPT} +FFLAGSE = -c ${OPTE} +FFLAGS2 = -c ${OPT2} +FFLAGS1 = -c ${OPT1} +FFLAGS0 = -c ${OPT0} #FFLAGSE = ${FFLAGS} @@ -140,7 +143,7 @@ chainbuild.o: chainbuild.F ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F djacob.o: djacob.f - ${FC} ${FFLAGS2} djacob.f + ${FC} ${FFLAGS0} djacob.f matmult.o: matmult.f ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f @@ -154,11 +157,8 @@ intcor.o : intcor.f cartder.o : cartder.F ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - readpdb-mult.o : readpdb-mult.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb-mult.F + ${FC} ${FFLAGS0} ${CPPFLAGS} readpdb-mult.F sumsld.o : sumsld.f ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f @@ -191,10 +191,13 @@ add.o : add.f ${FC} ${FFLAGS1} add.f eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f + ${FC} ${FFLAGS0} eigen.f dfa.o: dfa.F - ${FC} ${FFLAGS2} dfa.F + ${FC} ${FFLAGS} ${CPPFLAGS} dfa.F + +rmscalc.o: rmscalc.F + ${FC} ${FFLAGS2} ${CPPFLAGS} rmscalc.F proc_proc.o: proc_proc.c ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src-HCD-5D/chainbuild.F b/source/unres/src-HCD-5D/chainbuild.F index 51419ef..7902f15 100644 --- a/source/unres/src-HCD-5D/chainbuild.F +++ b/source/unres/src-HCD-5D/chainbuild.F @@ -240,6 +240,86 @@ C return end c----------------------------------------------------------------------------- + subroutine sc_coord_rebuild(i) +C +C Locate the side-chain centroid i, 1 < i < NRES. Put in C(*,NRES+i). +C + implicit none + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.LOCAL' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.IOUNITS' + include 'COMMON.NAMES' + include 'COMMON.INTERACT' + integer i,j,k + double precision xx(3) + double precision dsci,dsci_inv,alphi,omegi,cosalphi,sinalphi, + & cosomegi,sinomegi,rp(3),theta2,cost2,sint2,rj + double precision scalar + double precision ref(3,3),scalp,sscalp,refnorm + double precision alpha,beta +c dsci=dsc(itype(i)) +c dsci_inv=dsc_inv(itype(i)) + dsci=vbld(i+nres) + dsci_inv=vbld_inv(i+nres) +#ifdef OSF + alphi=alph(i) + omegi=omeg(i) + if (alphi.ne.alphi) alphi=100.0 + if (omegi.ne.omegi) omegi=-100.0 +#else + alphi=alph(i) + omegi=omeg(i) +#endif + cosalphi=dcos(alphi) + sinalphi=dsin(alphi) + cosomegi=dcos(omegi) + sinomegi=dsin(omegi) + rp(1)= cosalphi + rp(2)= sinalphi*cosomegi + rp(3)=-sinalphi*sinomegi +c Build the reference system + do j=1,3 + ref(j,1)=-dc_norm(j,i-1)+dc_norm(j,i) + enddo + refnorm=dsqrt(scalar(ref(1,1),ref(1,1))) + do j=1,3 + ref(j,1)=ref(j,1)/refnorm + enddo + scalp=scalar(ref(1,1),dc_norm(1,i)) + sscalp=1.0d0/dsqrt(1.0d0-scalp*scalp) + do j=1,3 + ref(j,2)=(dc_norm(j,i)-scalp*ref(j,1))*sscalp + enddo + ref(1,3)= ref(2,1)*ref(3,2)-ref(3,1)*ref(2,2) + ref(2,3)=-ref(1,1)*ref(3,2)+ref(3,1)*ref(1,2) + ref(3,3)= ref(1,1)*ref(2,2)-ref(2,1)*ref(1,2) +c do j=1,3 +c write (iout,*) j,scalar(ref(1,j),ref(1,1)), +c & scalar(ref(1,j),ref(1,2)),scalar(ref(1,j),ref(1,3)) +c enddo +c Bring the coordinates to the global reference system + do j=1,3 + dc_norm(j,nres+i)=0.0d0 + do k=1,3 + dc_norm(j,nres+i)=dc_norm(j,nres+i)+ref(j,k)*rp(k) + enddo + dc(j,nres+i)=dc_norm(j,nres+i)*dsci + c(j,nres+i)=c(j,i)+dc(j,nres+i) + enddo +c write (iout,*) scalar(dc_norm(1,i+nres),dc_norm(1,i+nres)), +c & dsqrt(scalar(dc(1,i+nres),dc(1,i+nres))) +c Check the internal coordinates +c c(:,2*nres+1)=ref(:,1)+c(:,i) +c write (iout,*) "alpha",rad2deg*alphi, +c & rad2deg*alpha(nres+i,i,2*nres+1) +c write (iout,*) "omega",rad2deg*omegi, +c & rad2deg*beta(nres+i,i,2*nres+1,i+1) + return + end +c----------------------------------------------------------------------------- subroutine locate_side_chain(i) C C Locate the side-chain centroid i, 1 < i < NRES. Put in C(*,NRES+i). @@ -296,7 +376,7 @@ cd & xp,yp,zp,(xx(k),k=1,3) xx(2)=xloc(2,i)*r(2,2,i-1)+xloc(3,i)*r(2,3,i-1) xx(3)=xloc(2,i)*r(3,2,i-1)+xloc(3,i)*r(3,3,i-1) do j=1,3 - xrot(j,i)=xx(j) + xrot(j,i)=xx(j) enddo do j=1,3 rj=0.0D0 diff --git a/source/unres/src-HCD-5D/dfa.F b/source/unres/src-HCD-5D/dfa.F index 62e8892..7de4015 100644 --- a/source/unres/src-HCD-5D/dfa.F +++ b/source/unres/src-HCD-5D/dfa.F @@ -270,6 +270,7 @@ C BETA is not parallel ! & "idfaphi ",idfaphi,idfaphi_start,idfaphi_end, & "idfathe ",idfathe,idfathe_start,idfathe_end, & "idfanei ",idfanei,idfanei_start,idfanei_end + if (nfgprocs.gt.1) then do i=0,max_fg_procs-1 idfadis_start_all(j)=0 idfadis_end_all(j)=0 @@ -308,6 +309,7 @@ C BETA is not parallel ! & idfanei_end_all(i) enddo endif + endif #else idfadis_start=1 idfadis_end=idfadis diff --git a/source/unres/src-HCD-5D/gen_rand_conf.F b/source/unres/src-HCD-5D/gen_rand_conf.F index 9f5567d..ea009b6 100644 --- a/source/unres/src-HCD-5D/gen_rand_conf.F +++ b/source/unres/src-HCD-5D/gen_rand_conf.F @@ -144,6 +144,7 @@ C Check for SC-SC overlaps. cd print *,'nnt=',nnt,' nct=',nct do j=nnt,i-1 itj=iabs(itype(j)) + if (itj.eq.ntyp1) cycle if (j.lt.i-1 .or. ipot.ne.4) then rcomp=sigmaii(iti,itj) else @@ -798,13 +799,16 @@ c overlapping residues left, or false otherwise (success) fail=.true. do while (fail.and.nsi.le.maxsi) call gen_side(iti,theta(i+1),alph(i),omeg(i),fail) + call sc_coord_rebuild(i) nsi=nsi+1 enddo if(fail) goto 999 endif enddo - call chainbuild_extconf +c write (iout,*) "before chaincuild overlap_sc_list: dc0",dc(:,0) +c call chainbuild_extconf +c write (iout,*) "after chaincuild overlap_sc_list: dc0",dc(:,0) call overlap_sc_list(ioverlap,ioverlap_last) write (iout,*) 'Overlaping residues ',ioverlap_last, & (ioverlap(j),j=1,ioverlap_last) diff --git a/source/unres/src-HCD-5D/readrtns_CSA.F b/source/unres/src-HCD-5D/readrtns_CSA.F index da28aa3..e5f0b41 100644 --- a/source/unres/src-HCD-5D/readrtns_CSA.F +++ b/source/unres/src-HCD-5D/readrtns_CSA.F @@ -1297,7 +1297,7 @@ c return enddo call bond_regular call chainbuild_extconf - else + else if (.not. start_from_model) then if(me.eq.king.or..not.out1file) & write (iout,'(a)') 'Random-generated initial geometry.' call bond_regular @@ -3654,6 +3654,7 @@ c call getenv("FRAGFILE",fragfile) open(ientin,file=fragfile,status="old",err=10) read(ientin,*) constr_homology,nclust + nmodel_start=constr_homology l_homo = .false. sigma_theta=0.0 sigma_d=0.0 diff --git a/source/wham/src-HCD/COMMON.DFA b/source/wham/src-HCD/COMMON.DFA index c6add4f..064a7ce 100644 --- a/source/wham/src-HCD/COMMON.DFA +++ b/source/wham/src-HCD/COMMON.DFA @@ -11,7 +11,7 @@ C Total : ~ 11 * Nres restraints C C INTEGER IDFAMAX,IDFAMX2,IDFACMD,IDMAXMIN, MAXN - PARAMETER(IDFAMAX=4000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) + PARAMETER(IDFAMAX=10000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) PARAMETER(MAXN=4) real*8 wwdist,wwangle,wwnei parameter(wwdist=1.0d0,wwangle=1.0d0,wwnei=1.0d0) diff --git a/source/wham/src-HCD/DIMENSIONS b/source/wham/src-HCD/DIMENSIONS index 65b3e75..c360026 100644 --- a/source/wham/src-HCD/DIMENSIONS +++ b/source/wham/src-HCD/DIMENSIONS @@ -27,7 +27,7 @@ c Max. number of chains parameter (maxchain=50) C Max number of symetries integer maxsym,maxperm - parameter (maxsym=maxchain,maxperm=120) + parameter (maxsym=maxchain,maxperm=5040) C Max. number of variables integer maxvar parameter (maxvar=4*maxres) -- 1.7.9.5 From 8d43c6830c2eb4067bc7538f70dfd11e62a3557a Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Tue, 16 Jun 2020 01:29:29 +0200 Subject: [PATCH 08/16] cluster correction --- .../wham/src-HCD/Makefile-MPICH-ifort-okeanos | 7 ++++- source/cluster/wham/src-HCD/srtclust.f | 32 ++++++++++++++------ source/cluster/wham/src-HCD/wrtclust.f | 17 ++++++----- 3 files changed, 39 insertions(+), 17 deletions(-) diff --git a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos index 425bed2..7ce5b9c 100644 --- a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos +++ b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos @@ -1,8 +1,11 @@ #INSTALL_DIR = /opt/cray/mpt/7.3.2/gni/mpich-intel/15.0 FC = ftn -OPT = -O3 -ip -mcmodel=medium -shared-intel -dynamic +OPT = -O2 -ip -mcmodel=medium -shared-intel -dynamic +OPTE = -O3 -ip -mcmodel=medium -shared-intel -dynamic #OPT = -CB -g -mcmodel=medium -shared-intel -dynamic +#OPTE = ${OPT} FFLAGS = ${OPT} -c -I. -Iinclude_unres -I$(INSTALL_DIR)/include +FFLAGSE = ${OPTE} -c -I. -Iinclude_unres -I$(INSTALL_DIR)/include LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a .c.o: @@ -113,6 +116,8 @@ NEWCORR5D_DFA: ${object} dfa.o xdrf/libxdrf.a xdrf/libxdrf.a: cd xdrf && make +energy_p_new.o: energy_p_new.F + ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F clean: /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean diff --git a/source/cluster/wham/src-HCD/srtclust.f b/source/cluster/wham/src-HCD/srtclust.f index 5d8b064..bf1d7e3 100644 --- a/source/cluster/wham/src-HCD/srtclust.f +++ b/source/cluster/wham/src-HCD/srtclust.f @@ -86,10 +86,8 @@ c---------------------------------------------------------------------- include 'COMMON.CLUSTER' include 'COMMON.FREE' include 'COMMON.IOUNITS' + include 'COMMON.CONTROL' double precision prob(maxgr) - write (iout, - & '("Free energies, probabilities and rmsds of clusters at", - & f6.1," K")') 1.0d0/(1.987d-3*beta_h(ib)) prob(1)=1.0d0 sumprob=1.0d0 do i=2,ngr @@ -100,18 +98,34 @@ c---------------------------------------------------------------------- prob(i)=prob(i)/sumprob enddo sumprob=0.0d0 - write(iout,'(/7x,4a20)') " RMSD","TMscore","GDT_TS","GDT_HA" - write(iout,'(a5,2x,a6,10a10)')"clust","efree","cl.ave.", + write (iout,*) + if (refstr) then + write (iout, + & '("Free energies, probabilities and rmsds of clusters at", + & f6.1," K")') 1.0d0/(1.987d-3*beta_h(ib)) + write(iout,'(/7x,4a20)') " RMSD","TMscore","GDT_TS","GDT_HA" + write(iout,'(a5,2x,a6,10a10)')"clust","efree","cl.ave.", & "ave.str.", & "cl.ave.","ave.str","cl.ave","ave.str.","cl.ave","ave.str.", & "prob","sumprob" - do i=1,ngr - sumprob=sumprob+prob(i) - write (iout,'(i3,2x,f8.1,2f10.3,6f10.4,2f10.4)') + do i=1,ngr + sumprob=sumprob+prob(i) + write (iout,'(i3,2x,f8.1,2f10.3,6f10.4,2f10.4)') & i,totfree_gr(i)/beta_h(ib), & rmsave(i),rms_closest(i),tmscore_ave(i),tmscore_closest(i), & gdt_ts_ave(i),gdt_ts_closest(i),gdt_ha_ave(i), & gdt_ha_closest(i),prob(i),sumprob - enddo + enddo + else + write (iout, + & '("Free energies and probabilities of clusters at", + & f6.1," K")') 1.0d0/(1.987d-3*beta_h(ib)) + write(iout,'(a5,2x,a6,3a10)')"clust","efree","prob","sumprob" + do i=1,ngr + sumprob=sumprob+prob(i) + write (iout,'(i3,2x,f8.1,2f10.4)') + & i,totfree_gr(i)/beta_h(ib),prob(i),sumprob + enddo + endif RETURN END diff --git a/source/cluster/wham/src-HCD/wrtclust.f b/source/cluster/wham/src-HCD/wrtclust.f index 91fc05e..e21494a 100644 --- a/source/cluster/wham/src-HCD/wrtclust.f +++ b/source/cluster/wham/src-HCD/wrtclust.f @@ -186,7 +186,7 @@ c Write out a number of conformations from each family in PDB format and c create InsightII command file for their displaying in different colors cfname=prefixp(:ilen(prefixp))//"_T"//ctemper(:ilen(ctemper)) & //"K_"//'ave'//exten - write (iout,*) "cfname",cfname +c write (iout,*) "cfname",cfname OPEN(ipdb,FILE=CFNAME,STATUS='UNKNOWN',FORM='FORMATTED') write (ipdb,'(a,f8.2)') & "REMAR AVERAGE CONFORMATIONS AT TEMPERATURE",temper @@ -248,13 +248,14 @@ c Average structures and structures closest to average else call closest_coord(i) endif + if (refstr) then c write (iout,*) "Calling rmsnat" - rms_closest(i) = rmsnat(i) - - write (iout,*) "Cluster",i - call TMscore_sub(rmsd,gdt_ts_closest(i),gdt_ha_closest(i), + rms_closest(i) = rmsnat(i) +c write (iout,*) "Cluster",i + call TMscore_sub(rmsd,gdt_ts_closest(i),gdt_ha_closest(i), & tmscore_closest(i),cfname,.true.) -c write (iout,*) "WRTCLUST: nsaxs",nsaxs," i",i +c write (iout,*) "WRTCLUST: nsaxs",nsaxs," i",i + endif if (nsaxs.gt.0 .and. saxs_mode.eq.0) then call e_saxs(Esaxs_constr) Cnorm=0.0d0 @@ -590,6 +591,8 @@ c------------------------------------------------------------------------------ double precision rmscalc rmsmin=1.0d10 jconmin=nconf(igr,1) +c write (iout,*) "CLOSEST_COORD: Average coords" +c call cartprint DO K=1,LICZ(IGR) jcon=nconf(igr,k) do i=1,2*nres @@ -607,7 +610,7 @@ c write (iout,*) "jcon",jcon," rms",rms," rmsmin",rmsmin endif ENDDO ! K c write (iout,*) "rmsmin",rmsmin," rms",rms -c call flush(iout) + call flush(iout) do i=1,2*nres do j=1,3 c(j,i)=allcart(j,i,jconmin) -- 1.7.9.5 From 38a3f56b6bf92cc9f8db7902fe44cae0211b808f Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Tue, 23 Jun 2020 09:56:31 +0200 Subject: [PATCH 09/16] readpdb-mult --- source/cluster/wham/src-HCD/DIMENSIONS | 3 +- .../wham/src-HCD/Makefile-MPICH-ifort-okeanos | 2 +- source/cluster/wham/src-HCD/readpdb-mult.F | 956 +++++++++++++++++++ source/unres/src-HCD-5D/COMMON.DFA | 2 +- .../unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos | 1 + .../unres/src-HCD-5D/Makefile_MPICH_ifort-piasek | 190 ++++ source/unres/src-HCD-5D/dfa.F | 2 +- source/unres/src-HCD-5D/parmread.F | 1 + source/unres/src-HCD-5D/readpdb-mult.F | 43 +- source/unres/src-HCD-5D/readpdb.F | 392 ++++++++ source/unres/src-HCD-5D/readpdb_template.F | 324 +++++++ source/unres/src-HCD-5D/readrtns_CSA.F | 3 +- source/wham/src-HCD/DIMENSIONS | 3 +- source/wham/src-HCD/Makefile_MPICH_ifort-okeanos | 11 +- source/wham/src-HCD/readpdb-mult.F | 960 ++++++++++++++++++++ 15 files changed, 2873 insertions(+), 20 deletions(-) create mode 100644 source/cluster/wham/src-HCD/readpdb-mult.F create mode 100644 source/unres/src-HCD-5D/Makefile_MPICH_ifort-piasek create mode 100644 source/unres/src-HCD-5D/readpdb.F create mode 100644 source/unres/src-HCD-5D/readpdb_template.F create mode 100644 source/wham/src-HCD/readpdb-mult.F diff --git a/source/cluster/wham/src-HCD/DIMENSIONS b/source/cluster/wham/src-HCD/DIMENSIONS index 247819a..c5928d8 100644 --- a/source/cluster/wham/src-HCD/DIMENSIONS +++ b/source/cluster/wham/src-HCD/DIMENSIONS @@ -46,7 +46,8 @@ C include in template-based/contact distance restraints. parameter (maxcont_res=200) C Max. number of distance/contact-distance restraints integer maxdim_cont - parameter (maxdim_cont=maxres*maxcont_res) +c parameter (maxdim_cont=maxres*maxcont_res) + parameter (maxdim_cont=maxres*1000) C Number of AA types (at present only natural AA's will be handled integer ntyp,ntyp1 parameter (ntyp=24,ntyp1=ntyp+1) diff --git a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos index 7ce5b9c..c2d84d8 100644 --- a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos +++ b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos @@ -19,7 +19,7 @@ LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a object = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ - geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ + geomout.o readpdb-mult.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ int_from_cart1.o energy_p_new.o boxshift.o icant.o proc_proc.o \ work_partition.o setup_var.o read_ref_str.o gnmr1.o permut.o \ diff --git a/source/cluster/wham/src-HCD/readpdb-mult.F b/source/cluster/wham/src-HCD/readpdb-mult.F new file mode 100644 index 0000000..c6139ee --- /dev/null +++ b/source/cluster/wham/src-HCD/readpdb-mult.F @@ -0,0 +1,956 @@ + subroutine readpdb +C Read the PDB file and convert the peptide geometry into virtual-chain +C geometry. + implicit none + include 'DIMENSIONS' + include 'COMMON.CONTROL' + include 'COMMON.LOCAL' + include 'COMMON.VAR' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.NAMES' + include 'COMMON.SBRIDGE' + include 'COMMON.FRAG' + character*3 seq,atom,res + character*80 card + double precision e1(3),e2(3),e3(3) + double precision sccor(3,50) + integer i,j,iii,ibeg,ishift,ishift1,ity,ires,ires_old + double precision dcj + integer rescode,kkk,lll,icha,cou,kupa,iprzes + logical lsecondary,sccalc,fail,zero + integer iterter(maxres) + double precision efree_temp + iii=0 + ibeg=1 + ishift1=0 + sccalc=.false. + bfac=0.0d0 + do i=1,maxres + iterter(i)=0 + enddo + ibeg=1 + ishift1=0 + lsecondary=.false. + nhfrag=0 + nbfrag=0 + iii=0 + sccalc=.false. + do + read (ipdbin,'(a80)',end=10) card +c write (iout,'(a)') card +c call flush(iout) + if (card(:5).eq.'HELIX') then + nhfrag=nhfrag+1 + lsecondary=.true. + read(card(22:25),*) hfrag(1,nhfrag) + read(card(34:37),*) hfrag(2,nhfrag) + endif + if (card(:5).eq.'SHEET') then + nbfrag=nbfrag+1 + lsecondary=.true. + read(card(24:26),*) bfrag(1,nbfrag) + read(card(35:37),*) bfrag(2,nbfrag) +!rc---------------------------------------- +!rc to be corrected !!! + bfrag(3,nbfrag)=bfrag(1,nbfrag) + bfrag(4,nbfrag)=bfrag(2,nbfrag) +!rc---------------------------------------- + endif + if (card(:3).eq.'END') then + goto 10 + else if (card(:3).eq.'TER') then +! End current chain + ires_old=ires+2 + itype(ires_old-1)=ntyp1 + iterter(ires_old-1)=1 + itype(ires_old)=ntyp1 + iterter(ires_old)=1 +c ishift1=ishift1+1 + ibeg=2 + write (iout,*) "Chain ended",ires,ishift,ires_old,ibeg + if (unres_pdb) then + do j=1,3 + dc(j,ires)=sccor(j,iii) + enddo + else + call sccenter(ires,iii,sccor) + endif + iii=0 + sccalc=.true. + endif +! Read free energy +c if (index(card,"FREE ENERGY").gt.0) then +c ifree=index(card,"FREE ENERGY")+12 +c read(card(ifree:),*,err=1115,end=1115) efree_temp +c 1115 continue +c endif +! Fish out the ATOM cards. + if (index(card(1:4),'ATOM').gt.0) then + sccalc=.false. + read (card(12:16),*) atom +c write (2,'(a)') card +c write (iout,*) "ibeg",ibeg +c write (iout,*) "! ",atom," !",ires +! if (atom.eq.'CA' .or. atom.eq.'CH3') then + read (card(23:26),*) ires + read (card(18:20),'(a3)') res +c write (iout,*) "ires",ires,ires-ishift+ishift1, +c & " ires_old",ires_old +c write (iout,*) "ishift",ishift," ishift1",ishift1 +c write (iout,*) "IRES",ires-ishift+ishift1,ires_old + if (ires-ishift+ishift1.ne.ires_old) then +! Calculate the CM of the preceding residue. +! if (ibeg.eq.0) call sccenter(ires,iii,sccor) + if (ibeg.eq.0) then +c write (iout,*) "Calculating sidechain center iii",iii +c write (iout,*) "ires",ires + if (unres_pdb) then +c write (iout,'(i5,3f10.5)') ires,(sccor(j,iii),j=1,3) + do j=1,3 + dc(j,ires_old)=sccor(j,iii) + enddo + else + call sccenter(ires_old,iii,sccor) + endif + iii=0 + sccalc=.true. + endif +! Start new residue. +c write (iout,*) "ibeg",ibeg + if (res.eq.'Cl-' .or. res.eq.'Na+') then + ires=ires_old + cycle + else if (ibeg.eq.1) then +c write (iout,*) "BEG ires",ires + ishift=ires-1 + if (res.ne.'GLY' .and. res.ne. 'ACE') then + ishift=ishift-1 + itype(1)=ntyp1 + endif + ires=ires-ishift+ishift1 + ires_old=ires +! write (iout,*) "ishift",ishift," ires",ires,& +! " ires_old",ires_old + ibeg=0 + else if (ibeg.eq.2) then +! Start a new chain + ishift=-ires_old+ires-1 !!!!! +c ishift1=ishift1-1 !!!!! +c write (iout,*) "New chain started",ires,ires_old,ishift, +c & ishift1 + ires=ires-ishift+ishift1 + write (iout,*) "New chain started ires",ires + ires_old=ires +c ires=ires_old+1 + ibeg=0 + else + ishift=ishift-(ires-ishift+ishift1-ires_old-1) + ires=ires-ishift+ishift1 + ires_old=ires + endif + if (res.eq.'ACE' .or. res.eq.'NHE') then + itype(ires)=10 + else + itype(ires)=rescode(ires,res,0) + endif + else + ires=ires-ishift+ishift1 + endif +c write (iout,*) "ires_old",ires_old," ires",ires + if (card(27:27).eq."A" .or. card(27:27).eq."B") then +! ishift1=ishift1+1 + endif +c write (2,*) "ires",ires," res ",res!," ity"!,ity + if (atom.eq.'CA' .or. atom.eq.'CH3' .or. + & res.eq.'NHE'.and.atom(:2).eq.'HN') then + read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) +c write (iout,*) "backbone ",atom +c write (iout,*) ires,res,(c(j,ires),j=1,3) +#ifdef DEBUG + write (iout,'(i6,i3,2x,a,3f8.3)') + & ires,itype(ires),res,(c(j,ires),j=1,3) +#endif + iii=iii+1 + do j=1,3 + sccor(j,iii)=c(j,ires) + enddo +c write (2,*) card(23:27),ires,itype(ires),iii + else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and. + & atom.ne.'N' .and. atom.ne.'C' .and. + & atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and. + & atom.ne.'OXT' .and. atom(:2).ne.'3H') then +! write (iout,*) "sidechain ",atom + iii=iii+1 + read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) +c write (2,*) "iii",iii + endif + endif + enddo + 10 write (iout,'(a,i5)') ' Nres: ',ires +c write (iout,*) "iii",iii +C Calculate dummy residue coordinates inside the "chain" of a multichain +C system + nres=ires +c write (iout,*) "dc" +c do i=1,nres +c write (iout,'(i5,3f10.5)') i,(dc(j,i),j=1,3) +c enddo + do i=2,nres-1 +c write (iout,*) i,itype(i),itype(i+1),ntyp1,iterter(i) + if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then + if (itype(i+1).eq.ntyp1.and.iterter(i+1).eq.1 ) then +C 16/01/2014 by Adasko: Adding to dummy atoms in the chain +C first is connected prevous chain (itype(i+1).eq.ntyp1)=true +C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue +c print *,i,'tu dochodze' + call refsys(i-3,i-2,i-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif !fail +c print *,i,'a tu?' + do j=1,3 + c(j,i)=c(j,i-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i-2)-c(j,i-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i-1)+dcj + c(j,nres+i)=c(j,i) + dC(j,i)=c(j,i) + enddo + endif !unres_pdb + else !itype(i+1).eq.ntyp1 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue + call refsys(i+1,i+2,i+3,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,i)=c(j,i+1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i+3)-c(j,i+2))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i+1)-dcj + c(j,nres+i)=c(j,i) + dC(j,i)=c(j,i) + enddo + endif !unres_pdb + endif !itype(i+1).eq.ntyp1 + endif !itype.eq.ntyp1 + enddo + write (iout,*) "After loop in readpbd" +C Calculate the CM of the last side chain. + if (.not. sccalc) then + if (unres_pdb) then + do j=1,3 + dc(j,ires)=sccor(j,iii) + enddo + else +c write (iout,*) "Calling sccenter iii",iii + call sccenter(ires,iii,sccor) + endif + endif + nsup=nres + nstart_sup=1 + if (itype(nres).ne.10) then + nres=nres+1 + itype(nres)=ntyp1 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue + call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,nres)=c(j,nres-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + enddo + else + do j=1,3 + dcj=(c(j,nres-2)-c(j,nres-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,nres)=c(j,nres-1)+dcj + c(j,2*nres)=c(j,nres) + enddo + endif + endif + do i=2,nres-1 + do j=1,3 + c(j,i+nres)=dc(j,i) + enddo + enddo + do j=1,3 + c(j,nres+1)=c(j,1) + c(j,2*nres)=c(j,nres) + enddo + if (itype(1).eq.ntyp1) then + nsup=nsup-1 + nstart_sup=2 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue + call refsys(2,3,4,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,1)=c(j,2)+1.9d0*(e1(j)-e2(j))/dsqrt(2.0d0) + enddo + else + do j=1,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 + endif + endif +C Calculate internal coordinates. + write (iout,'(/a)') + & "Cartesian coordinates of the reference structure" + write (iout,'(a,3(3x,a5),5x,3(3x,a5))') + & "Residue ","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" + do ires=1,nres + write (iout,'(a3,1x,i4,3f8.3,5x,3f8.3)') + & restyp(itype(ires)),ires,(c(j,ires),j=1,3), + & (c(j,ires+nres),j=1,3) + zero=.false. + enddo + do ires=1,nres + zero=zero.or.itype(ires).eq.0 + enddo + if (zero) then + write (iout,'(2a)') "Gaps in PDB coordinates detected;", + & " look for ZERO in the control output above." + write (iout,'(2a)') "Repair the PDB file using MODELLER", + & " or other softwared and resubmit." + call flush(iout) + stop + endif +c write(iout,*)"before int_from_cart nres",nres + call int_from_cart(.true.,.false.) + do i=1,nres + thetaref(i)=theta(i) + phiref(i)=phi(i) + enddo + dc(:,0)=c(:,1) + do i=1,nres-1 + do j=1,3 + dc(j,i)=c(j,i+1)-c(j,i) + dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) + enddo +c write (iout,*) i,(dc(j,i),j=1,3),(dc_norm(j,i),j=1,3), +c & vbld_inv(i+1) + enddo + do i=2,nres-1 + do j=1,3 + dc(j,i+nres)=c(j,i+nres)-c(j,i) + dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) + enddo +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 + call sc_loc_geom(.false.) + call int_from_cart1(.false.) +c call chainbuild +C Copy the coordinates to reference coordinates + do i=1,nres + do j=1,3 + cref(j,i)=c(j,i) + cref(j,i+nres)=c(j,i+nres) + enddo + enddo + 100 format (//' alpha-carbon coordinates ', + & ' centroid coordinates'/ + 1 ' ', 7X,'X',11X,'Y',11X,'Z', + & 10X,'X',11X,'Y',11X,'Z') + 110 format (a,'(',i4,')',6f12.5) +cc enddiag + do j=1,nbfrag + do i=1,4 + bfrag(i,j)=bfrag(i,j)-ishift + enddo + enddo + + do j=1,nhfrag + do i=1,2 + hfrag(i,j)=hfrag(i,j)-ishift + enddo + enddo + return + end +c--------------------------------------------------------------------------- + subroutine readpdb_template(k) +C Read the PDB file for read_constr_homology with read2sigma +C and convert the peptide geometry into virtual-chain geometry. + 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' + integer i,j,ibeg,ishift1,ires,iii,ires_old,ishift,ity + logical lprn /.false./,fail + double precision e1(3),e2(3),e3(3) + double precision dcj,efree_temp + character*3 seq,res + character*5 atom + character*80 card + double precision sccor(3,20) + integer rescode,iterter(maxres) + logical zero + do i=1,maxres + iterter(i)=0 + enddo + ibeg=1 + ishift1=0 + ishift=0 +c write (2,*) "UNRES_PDB",unres_pdb + ires=0 + ires_old=0 + iii=0 + lsecondary=.false. + nhfrag=0 + nbfrag=0 + 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+2 + itype(ires_old-1)=ntyp1 + iterter(ires_old-1)=1 + itype(ires_old)=ntyp1 + iterter(ires_old)=1 + ibeg=2 +c write (iout,*) "Chain ended",ires,ishift,ires_old + if (unres_pdb) then + do j=1,3 + dc(j,ires)=sccor(j,iii) + enddo + else + call sccenter(ires,iii,sccor) + endif + endif +C Fish out the ATOM cards. + if (index(card(1:4),'ATOM').gt.0) then + read (card(12:16),*) atom +c write (iout,*) "! ",atom," !",ires +c if (atom.eq.'CA' .or. atom.eq.'CH3') then + read (card(23:26),*) ires + read (card(18:20),'(a3)') res +c write (iout,*) "ires",ires,ires-ishift+ishift1, +c & " ires_old",ires_old +c write (iout,*) "ishift",ishift," ishift1",ishift1 +c write (iout,*) "IRES",ires-ishift+ishift1,ires_old + if (ires-ishift+ishift1.ne.ires_old) then +C Calculate the CM of the preceding residue. + if (ibeg.eq.0) then + if (unres_pdb) then + do j=1,3 + dc(j,ires_old)=sccor(j,iii) + enddo + else + call sccenter(ires_old,iii,sccor) + endif + iii=0 + endif +C Start new residue. + if (res.eq.'Cl-' .or. res.eq.'Na+') then + ires=ires_old + cycle + else if (ibeg.eq.1) then +c write (iout,*) "BEG ires",ires + ishift=ires-1 + if (res.ne.'GLY' .and. res.ne. 'ACE') then + ishift=ishift-1 + itype(1)=ntyp1 + endif + ires=ires-ishift+ishift1 + ires_old=ires +c write (iout,*) "ishift",ishift," ires",ires, +c & " ires_old",ires_old +c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift + ibeg=0 + else if (ibeg.eq.2) then +c Start a new chain + ishift=-ires_old+ires-1 + ires=ires_old+1 +c write (iout,*) "New chain started",ires,ishift + ibeg=0 + else + ishift=ishift-(ires-ishift+ishift1-ires_old-1) + ires=ires-ishift+ishift1 + ires_old=ires + endif + if (res.eq.'ACE' .or. res.eq.'NHE') then + itype(ires)=10 + else + itype(ires)=rescode(ires,res,0) + endif + else + ires=ires-ishift+ishift1 + endif +c write (iout,*) "ires_old",ires_old," ires",ires +c if (card(27:27).eq."A" .or. card(27:27).eq."B") then +c ishift1=ishift1+1 +c endif +c write (2,*) "ires",ires," res ",res," ity",ity + if (atom.eq.'CA' .or. atom.eq.'CH3' .or. + & res.eq.'NHE'.and.atom(:2).eq.'HN') then + read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) +c write (iout,*) "backbone ",atom ,ires,res, (c(j,ires),j=1,3) +#ifdef DEBUG + write (iout,'(2i3,2x,a,3f8.3)') + & ires,itype(ires),res,(c(j,ires),j=1,3) +#endif + iii=iii+1 + do j=1,3 + sccor(j,iii)=c(j,ires) + enddo + if (ishift.ne.0) then + ires_ca=ires+ishift-ishift1 + else + ires_ca=ires + endif +c write (*,*) card(23:27),ires,itype(ires) + else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and. + & atom.ne.'N' .and. atom.ne.'C' .and. + & atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and. + & atom.ne.'OXT' .and. atom(:2).ne.'3H') then +c write (iout,*) "sidechain ",atom + iii=iii+1 + read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) + endif + endif + enddo + 10 write (iout,'(a,i5)') ' Nres: ',ires +C Calculate dummy residue coordinates inside the "chain" of a multichain +C system + nres=ires + do i=2,nres-1 +c write (iout,*) i,itype(i),itype(i+1) + if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then + if (itype(i+1).eq.ntyp1.and.iterter(i+1).eq.1 ) then +C 16/01/2014 by Adasko: Adding to dummy atoms in the chain +C first is connected prevous chain (itype(i+1).eq.ntyp1)=true +C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue + call refsys(i-3,i-2,i-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif !fail + do j=1,3 + c(j,i)=c(j,i-1)-1.9d0*e2(j) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i-2)-c(j,i-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i-1)+dcj + c(j,nres+i)=c(j,i) + enddo + endif !unres_pdb + else !itype(i+1).eq.ntyp1 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue + call refsys(i+1,i+2,i+3,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,i)=c(j,i+1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i+3)-c(j,i+2))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i+1)-dcj + c(j,nres+i)=c(j,i) + enddo + endif !unres_pdb + endif !itype(i+1).eq.ntyp1 + endif !itype.eq.ntyp1 + enddo +C Calculate the CM of the last side chain. + if (unres_pdb) then + do j=1,3 + dc(j,ires)=sccor(j,iii) + enddo + else + call sccenter(ires,iii,sccor) + endif + nsup=nres + nstart_sup=1 + if (itype(nres).ne.10) then + nres=nres+1 + itype(nres)=ntyp1 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue + call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,nres)=c(j,nres-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + enddo + else + do j=1,3 + dcj=(c(j,nres-2)-c(j,nres-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,nres)=c(j,nres-1)+dcj + c(j,2*nres)=c(j,nres) + enddo + endif + endif + do i=2,nres-1 + do j=1,3 + c(j,i+nres)=dc(j,i) + enddo + enddo + do j=1,3 + c(j,nres+1)=c(j,1) + c(j,2*nres)=c(j,nres) + enddo + if (itype(1).eq.ntyp1) then + nsup=nsup-1 + nstart_sup=2 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue + call refsys(2,3,4,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,1)=c(j,2)+1.9d0*(e1(j)-e2(j))/dsqrt(2.0d0) + enddo + else + do j=1,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 + endif + endif +C Copy the coordinates to reference coordinates +c do i=1,2*nres +c do j=1,3 +c cref(j,i)=c(j,i) +c enddo +c enddo +C Calculate internal coordinates. + if (out_template_coord) then + write (iout,'(/a)') + & "Cartesian coordinates of the reference structure" + write (iout,'(a,3(3x,a5),5x,3(3x,a5))') + & "Residue ","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" + do ires=1,nres + write (iout,'(a3,1x,i4,3f8.3,5x,3f8.3)') + & restyp(itype(ires)),ires,(c(j,ires),j=1,3), + & (c(j,ires+nres),j=1,3) + enddo + endif + zero=.false. + do ires=1,nres + zero=zero.or.itype(ires).eq.0 + enddo + if (zero) then + write (iout,'(2a)') "Gaps in PDB coordinates detected;", + & " look for ZERO in the control output above." + write (iout,'(2a)') "Repair the PDB file using MODELLER", + & " or other softwared and resubmit." + call flush(iout) + stop + endif +C Calculate internal coordinates. + call int_from_cart(.true.,out_template_coord) + call sc_loc_geom(.false.) + do i=1,nres + thetaref(i)=theta(i) + phiref(i)=phi(i) + enddo + dc(:,0)=c(:,1) + do i=1,nres-1 + do j=1,3 + dc(j,i)=c(j,i+1)-c(j,i) + dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) + enddo + enddo + do i=2,nres-1 + do j=1,3 + dc(j,i+nres)=c(j,i+nres)-c(j,i) + dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) + enddo +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 + do j=1,3 + cref(j,i)=c(j,i) + cref(j,i+nres)=c(j,i+nres) + enddo + enddo + do i=1,2*nres + do j=1,3 + chomo(j,i,k)=c(j,i) + enddo + enddo + + return + end +c--------------------------------------------------------------------------- + subroutine int_from_cart(lside,lprn) + implicit none + include 'DIMENSIONS' + include 'COMMON.LOCAL' + include 'COMMON.VAR' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.NAMES' + character*3 seq,atom,res + character*80 card + double precision sccor(3,50) + integer rescode + double precision dist,alpha,beta,di + integer i,j,iti + logical lside,lprn + if (lprn) then + write (iout,'(/a)') + & 'Internal coordinates calculated from crystal structure.' + if (lside) then + write (iout,'(8a)') ' Res ',' dvb',' Theta', + & ' Phi',' Dsc_id',' Dsc',' Alpha', + & ' Omega' + else + write (iout,'(4a)') ' Res ',' dvb',' Theta', + & ' Phi' + endif + endif + do i=2,nres + iti=itype(i) +c 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.ntyp1 .and. itype(i).ne.ntyp1 .and. + & (dist(i,i-1).lt.1.0D0 .or. dist(i,i-1).gt.6.0D0)) then + write (iout,'(a,i4)') 'Bad Cartesians for residue',i +c stop + endif + vbld(i)=dist(i-1,i) + vbld_inv(i)=1.0d0/vbld(i) + 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 +c if (itype(1).eq.ntyp1) then +c do j=1,3 +c c(j,1)=c(j,2)+(c(j,3)-c(j,4)) +c enddo +c endif +c if (itype(nres).eq.ntyp1) then +c do j=1,3 +c c(j,nres)=c(j,nres-1)+(c(j,nres-2)-c(j,nres-3)) +c enddo +c endif + if (lside) then + do i=2,nres-1 + do j=1,3 + c(j,maxres2)=0.5D0*(c(j,i-1)+c(j,i+1)) + enddo + iti=itype(i) + di=dist(i,nres+i) + vbld(i+nres)=di + if (itype(i).ne.10) then + vbld_inv(i+nres)=1.0d0/di + else + vbld_inv(i+nres)=0.0d0 + endif + if (iti.ne.10) then + alph(i)=alpha(nres+i,i,maxres2) + omeg(i)=beta(nres+i,i,maxres2,i+1) + endif + if (iti.ne.10) then + alph(i)=alpha(nres+i,i,maxres2) + omeg(i)=beta(nres+i,i,maxres2,i+1) + endif + if (lprn) + & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), + & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),di, + & rad2deg*alph(i),rad2deg*omeg(i) + enddo + else if (lprn) then + do i=2,nres + iti=itype(i) + write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), + & rad2deg*theta(i),rad2deg*phi(i) + enddo + endif + return + end +c--------------------------------------------------------------------------- + subroutine sccenter(ires,nscat,sccor) + implicit none + include 'DIMENSIONS' + include 'COMMON.CHAIN' + integer ires,nscat,i,j + double precision sccor(3,50),sccmj + do j=1,3 + sccmj=0.0D0 + do i=1,nscat + sccmj=sccmj+sccor(j,i) + enddo + dc(j,ires)=sccmj/nscat + enddo + 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 +c write (iout,*) "x_prime",(x_prime(j),j=1,3) +c write (iout,*) "y_prime",(y_prime(j),j=1,3) + call vecpr(x_prime,y_prime,z_prime) +c write (iout,*) "z_prime",(z_prime(j),j=1,3) +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 + write (iout,*) "xxref,yyref,zzref" + do i=2,nres + iti=itype(i) + write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i),yyref(i), + & zzref(i) + enddo + endif + return + end +c--------------------------------------------------------------------------- + subroutine bond_regular + implicit none + include 'DIMENSIONS' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.INTERACT' + include 'COMMON.CHAIN' + integer i,i1,i2 + do i=1,nres-1 + vbld(i+1)=vbl + vbld_inv(i+1)=vblinv + vbld(i+1+nres)=dsc(iabs(itype(i+1))) + vbld_inv(i+1+nres)=dsc_inv(iabs(itype(i+1))) +c print *,vbld(i+1),vbld(i+1+nres) + enddo +c Adam 2/26/20 Alter virtual bonds for non-blocking end groups of each chain + do i=1,nchain + i1=chain_border(1,i) + i2=chain_border(2,i) + if (i1.gt.1) then + vbld(i1)=vbld(i1)/2 + vbld_inv(i1)=vbld_inv(i1)*2 + endif + if (i2.lt.nres) then + vbld(i2+1)=vbld(i2+1)/2 + vbld_inv(i2+1)=vbld_inv(i2+1)*2 + endif + enddo + return + end + diff --git a/source/unres/src-HCD-5D/COMMON.DFA b/source/unres/src-HCD-5D/COMMON.DFA index 6759f8b..818c024 100644 --- a/source/unres/src-HCD-5D/COMMON.DFA +++ b/source/unres/src-HCD-5D/COMMON.DFA @@ -11,7 +11,7 @@ C Total : ~ 11 * Nres restraints C C INTEGER IDFAMAX,IDFAMX2,IDFACMD,IDMAXMIN, MAXN - PARAMETER(IDFAMAX=4000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) + PARAMETER(IDFAMAX=10000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) PARAMETER(MAXN=4) real*8 wwdist,wwangle,wwnei parameter(wwdist=1.0d0,wwangle=1.0d0,wwnei=1.0d0) diff --git a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos index 853e319..3fcb971 100644 --- a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos +++ b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos @@ -9,6 +9,7 @@ OPTE = -c -O3 -ipo -mcmodel=medium -shared-intel -dynamic OPT2 = -O2 -ip -mcmodel=medium -shared-intel -dynamic OPT0 = -g -O0 -mcmodel=medium -shared-intel -dynamic OPT1 = -g -CA -CB -mcmodel=medium -shared-intel -dynamic +#OPT = -g -CA -CB -mcmodel=medium -shared-intel -dynamic FFLAGS = -c ${OPT} FFLAGSE = -c ${OPTE} diff --git a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-piasek b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-piasek new file mode 100644 index 0000000..29bdc58 --- /dev/null +++ b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-piasek @@ -0,0 +1,190 @@ +INSTALL_DIR = /users/local/mpich-3.3.1_intel + +FC= ${INSTALL_DIR}/bin/mpif90 + +OPT = -O3 -ip -mcmodel=medium +OPTE = -O3 -ipo -mcmodel=medium +OPT2 = -O2 -ip -mcmodel=medium +OPT0 = -g -O0 -mcmodel=medium +OPTE = -c -O3 -ipo -mcmodel=medium -shared-intel -dynamic + +FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include +FFLAGSE = ${OPTE} -I$(INSTALL_DIR)/include +FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include +FFLAGS1 = ${FFLAGS} +FFLAGS0 = -c ${OPT0} -I$(INSTALL_DIR)/include + +LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a +#/opt/cray/mpt/7.3.2/gni/mpich-intel/15.0/lib/libmpich.a + +ARCH = LINUX +PP = /lib/cpp -P + + +all: no_option + @echo "Specify force field: GAB, 4P or E0LL2Y" + +.SUFFIXES: .F +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + + +object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ + matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ + pinorm.o randgens.o rescode.o intcor.o timing.o misc.o \ + cart2intgrad.o checkder_p.o contact_cp.o econstr_local.o econstr_qlike.o \ + econstrq-PMF.o PMFprocess.o energy_p_new_barrier.o make_xx_list.o \ + energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ + cored.o rmdd.o geomout.o readpdb-mult.o int_from_cart.o regularize.o \ + thread.o fitsq.o mcm.o rmscalc.o \ + mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o \ + eigen.o blas.o add.o entmcm.o minim_mcmf.o \ + together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ + indexx.o MP.o compare_s1.o prng_32.o \ + banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ + sc_move.o local_move.o djacob.o \ + intcartderiv.o lagrangian_lesyng.o\ + chain_symmetry.o permut.o seq2chains.o iperm.o\ + stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ + surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ + q_measure.o gnmr1.o mygauss.o ssMD.o + +object_lbfgs = inform.o iounit.o keys.o linmin.o math.o minima.o scales.o output.o lbfgs.o search.o optsave_dum.o + +no_option: + +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY +GAB: BIN = ~/bin/unres-ms_ifort_MPICH_GAB-HCD.exe +GAB: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY +4P: BIN = ~/bin/unres-ms_KCC_ifort_MPICH_4P-HCD.exe +4P: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DFOURBODY +E0LL2Y: BIN = ~/bin/unres-ms_ifort_MPICH_E0LL2Y-HCD.exe +E0LL2Y: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +NEWCORR: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD #-DFOURBODY #-DMYGAUSS #-DTIMING +NEWCORR: BIN = ~/bin/unres-ms_ifort_MPICH_SC-HCD.exe +NEWCORR: ${object} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DFIVEDIAG -DLBFGS #-DMYGAUSS #-DTIMING +NEWCORR5D: BIN = ~/bin/unres-ms_ifort_MPICH_SC-HCD5.exe +NEWCORR5D: ${object_lbfgs} ${object} fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} ${object_lbfgs} fdisy.o fdiag.o machpd.o kinetic_CASC.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DDFA #-DMYGAUSS #-DTIMING +NEWCORR_DFA: BIN = ~/bin/unres-ms_ifort_MPICH_SC-HCD-DFA.exe +NEWCORR_DFA: ${object} dfa.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN} + +NEWCORR5D_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DFIVEDIAG -DLBFGS -DDFA #-DMYGAUSS #-DTIMING +NEWCORR5D_DFA: BIN = ~/bin/unres-ms_ifort_MPICH_SC-HCD5-DFA.exe +NEWCORR5D_DFA: ${object_lbfgs} ${object} dfa.o fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object_lbfgs} ${object} fdisy.o fdiag.o machpd.o dfa.o kinetic_CASC.o cinfo.o ${LIBS} -o ${BIN} + +xdrf/libxdrf.a: + cd xdrf && make + + +clean: + /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean + +test.o: test.F + ${FC} ${FFLAGS} ${CPPFLAGS} test.F + +chainbuild.o: chainbuild.F + ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F + +djacob.o: djacob.f + ${FC} ${FFLAGS0} djacob.f + +matmult.o: matmult.f + ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f + +parmread.o : parmread.F + ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F + +intcor.o : intcor.f + ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f + +cartder.o : cartder.F + ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F + +readpdb-mult.o : readpdb-mult.F + ${FC} ${FFLAGS0} ${CPPFLAGS} readpdb-mult.F + +sumsld.o : sumsld.f + ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f + +rmscalc.o : rmscalc.F + ${FC} ${FFLAGS2} ${CPPFLAGS} rmscalc.F + +cored.o : cored.f + ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f + +rmdd.o : rmdd.f + ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f + +energy_p_new_barrier.o : energy_p_new_barrier.F + ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F + +gradient_p.o : gradient_p.F + ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F + +energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F + ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F + +lagrangian_lesyng.o : lagrangian_lesyng.F + ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F + +MD_A-MTS.o : MD_A-MTS.F + ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F + +blas.o : blas.f + ${FC} ${FFLAGS1} blas.f + +add.o : add.f + ${FC} ${FFLAGS1} add.f + +eigen.o : eigen.f + ${FC} ${FFLAGS0} eigen.f + +dfa.o: dfa.F + ${FC} ${CPPFLAGS} ${FFLAGS} dfa.F + +proc_proc.o: proc_proc.c + ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src-HCD-5D/dfa.F b/source/unres/src-HCD-5D/dfa.F index 7de4015..3982b6d 100644 --- a/source/unres/src-HCD-5D/dfa.F +++ b/source/unres/src-HCD-5D/dfa.F @@ -270,7 +270,7 @@ C BETA is not parallel ! & "idfaphi ",idfaphi,idfaphi_start,idfaphi_end, & "idfathe ",idfathe,idfathe_start,idfathe_end, & "idfanei ",idfanei,idfanei_start,idfanei_end - if (nfgprocs.gt.1) then + if (nfgtasks.gt.1) then do i=0,max_fg_procs-1 idfadis_start_all(j)=0 idfadis_end_all(j)=0 diff --git a/source/unres/src-HCD-5D/parmread.F b/source/unres/src-HCD-5D/parmread.F index 7550fd5..721d05b 100644 --- a/source/unres/src-HCD-5D/parmread.F +++ b/source/unres/src-HCD-5D/parmread.F @@ -462,6 +462,7 @@ C here will be the apropriate recalibrating for D-aminoacid c write (2,*) "Start reading THETA_PDB",ithep_pdb do i=1,ntyp c write (2,*) 'i=',i + call flush(iout) read (ithep_pdb,*,err=111,end=111) & a0thet(i),(athet(j,i,1,1),j=1,2), & (bthet(j,i,1,1),j=1,2) diff --git a/source/unres/src-HCD-5D/readpdb-mult.F b/source/unres/src-HCD-5D/readpdb-mult.F index 41fe7f6..76cb6b6 100644 --- a/source/unres/src-HCD-5D/readpdb-mult.F +++ b/source/unres/src-HCD-5D/readpdb-mult.F @@ -64,9 +64,9 @@ c call flush(iout) iterter(ires_old-1)=1 itype(ires_old)=ntyp1 iterter(ires_old)=1 - ishift1=ishift1+1 +c ishift1=ishift1+1 ibeg=2 - write (iout,*) "Chain ended",ires,ishift,ires_old + write (iout,*) "Chain ended",ires,ishift,ires_old,ibeg if (unres_pdb) then do j=1,3 dc(j,ires)=sccor(j,iii) @@ -95,8 +95,8 @@ c write (iout,*) "! ",atom," !",ires read (card(18:20),'(a3)') res c write (iout,*) "ires",ires,ires-ishift+ishift1, c & " ires_old",ires_old -c write (iout,*) "ishift",ishift," ishift1",ishift1 -c write (iout,*) "IRES",ires-ishift+ishift1,ires_old +c write (iout,*) "ishift",ishift," ishift1",ishift1 +c write (iout,*) "IRES",ires-ishift+ishift1,ires_old if (ires-ishift+ishift1.ne.ires_old) then ! Calculate the CM of the preceding residue. ! if (ibeg.eq.0) call sccenter(ires,iii,sccor) @@ -115,6 +115,7 @@ c write (iout,'(i5,3f10.5)') ires,(sccor(j,iii),j=1,3) sccalc=.true. endif ! Start new residue. +c write (iout,*) "ibeg",ibeg if (res.eq.'Cl-' .or. res.eq.'Na+') then ires=ires_old cycle @@ -133,10 +134,13 @@ c write (iout,*) "BEG ires",ires else if (ibeg.eq.2) then ! Start a new chain ishift=-ires_old+ires-1 !!!!! - ishift1=ishift1-1 !!!!! -c write (iout,*) "New chain started",ires,ishift,ishift1,"!" +c ishift1=ishift1-1 !!!!! +c write (iout,*) "New chain started",ires,ires_old,ishift, +c & ishift1 ires=ires-ishift+ishift1 + write (iout,*) "New chain started ires",ires ires_old=ires +c ires=ires_old+1 ibeg=0 else ishift=ishift-(ires-ishift+ishift1-ires_old-1) @@ -159,7 +163,8 @@ c write (2,*) "ires",ires," res ",res!," ity"!,ity if (atom.eq.'CA' .or. atom.eq.'CH3' .or. & res.eq.'NHE'.and.atom(:2).eq.'HN') then read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) -! write (iout,*) "backbone ",atom +c write (iout,*) "backbone ",atom +c write (iout,*) ires,res,(c(j,ires),j=1,3) #ifdef DEBUG write (iout,'(i6,i3,2x,a,3f8.3)') & ires,itype(ires),res,(c(j,ires),j=1,3) @@ -229,7 +234,7 @@ C 2/15/2013 by Adam: corrected insertion of the first dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,i)=c(j,i+1)-1.9d0*e2(j) + c(j,i)=c(j,i+1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) enddo else !unres_pdb do j=1,3 @@ -412,8 +417,9 @@ C and convert the peptide geometry into virtual-chain geometry. character*3 seq,res character*5 atom character*80 card - double precision sccor(3,20) + double precision sccor(3,50) integer rescode,iterter(maxres) + logical zero do i=1,maxres iterter(i)=0 enddo @@ -581,7 +587,7 @@ C 2/15/2013 by Adam: corrected insertion of the first dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,i)=c(j,i+1)-1.9d0*e2(j) + c(j,i)=c(j,i+1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) enddo else !unres_pdb do j=1,3 @@ -616,7 +622,7 @@ C 2/15/2013 by Adam: corrected insertion of the last dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,nres)=c(j,nres-1)-1.9d0*e2(j) + c(j,nres)=c(j,nres-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) enddo else do j=1,3 @@ -648,7 +654,7 @@ C 2/15/2013 by Adam: corrected insertion of the first dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,1)=c(j,2)-1.9d0*e2(j) + c(j,1)=c(j,2)+1.9d0*(e1(j)-e2(j))/dsqrt(2.0d0) enddo else do j=1,3 @@ -676,6 +682,18 @@ C Calculate internal coordinates. & (c(j,ires+nres),j=1,3) enddo endif + zero=.false. + do ires=1,nres + zero=zero.or.itype(ires).eq.0 + enddo + if (zero) then + write (iout,'(2a)') "Gaps in PDB coordinates detected;", + & " look for ZERO in the control output above." + write (iout,'(2a)') "Repair the PDB file using MODELLER", + & " or other softwared and resubmit." + call flush(iout) + stop + endif C Calculate internal coordinates. call int_from_cart(.true.,out_template_coord) call sc_loc_geom(.false.) @@ -683,6 +701,7 @@ C Calculate internal coordinates. thetaref(i)=theta(i) phiref(i)=phi(i) enddo + dc(:,0)=c(:,1) do i=1,nres-1 do j=1,3 dc(j,i)=c(j,i+1)-c(j,i) diff --git a/source/unres/src-HCD-5D/readpdb.F b/source/unres/src-HCD-5D/readpdb.F new file mode 100644 index 0000000..94fe78f --- /dev/null +++ b/source/unres/src-HCD-5D/readpdb.F @@ -0,0 +1,392 @@ + subroutine readpdb +C Read the PDB file and convert the peptide geometry into virtual-chain +C geometry. + implicit none + 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.FRAG' + include 'COMMON.SETUP' + include 'COMMON.SBRIDGE' + character*3 seq,atom,res + character*80 card + double precision sccor(3,50) + double precision e1(3),e2(3),e3(3) + integer rescode,iterter(maxres),cou + logical fail,sccalc + integer i,j,iii,ires,ires_old,ishift,ishift1,ibeg,ifree + double precision dcj!,efree_temp + logical zero + bfac=0.0d0 + do i=1,maxres + iterter(i)=0 + enddo + ibeg=1 + ishift1=0 + lsecondary=.false. + nhfrag=0 + nbfrag=0 + iii=0 + sccalc=.false. + do + read (ipdbin,'(a80)',end=10) card +c write (iout,'(a)') card +c call flush(iout) + if (card(:5).eq.'HELIX') then + nhfrag=nhfrag+1 + lsecondary=.true. + read(card(22:25),*) hfrag(1,nhfrag) + read(card(34:37),*) hfrag(2,nhfrag) + endif + if (card(:5).eq.'SHEET') then + nbfrag=nbfrag+1 + lsecondary=.true. + read(card(24:26),*) bfrag(1,nbfrag) + read(card(35:37),*) bfrag(2,nbfrag) +!rc---------------------------------------- +!rc to be corrected !!! + bfrag(3,nbfrag)=bfrag(1,nbfrag) + bfrag(4,nbfrag)=bfrag(2,nbfrag) +!rc---------------------------------------- + endif + if (card(:3).eq.'END') then + goto 10 + else if (card(:3).eq.'TER') then +! End current chain + ires_old=ires+2 + itype(ires_old-1)=ntyp1 + iterter(ires_old-1)=1 + itype(ires_old)=ntyp1 + iterter(ires_old)=1 + ishift1=ishift1+1 + ibeg=2 + write (iout,*) "Chain ended",ires,ishift,ires_old + if (unres_pdb) then + do j=1,3 + dc(j,ires)=sccor(j,iii) + enddo + else + call sccenter(ires,iii,sccor) + endif + iii=0 + sccalc=.true. + endif +! Read free energy +c if (index(card,"FREE ENERGY").gt.0) then +c ifree=index(card,"FREE ENERGY")+12 +c read(card(ifree:),*,err=1115,end=1115) efree_temp +c 1115 continue +c endif +! Fish out the ATOM cards. + if (index(card(1:4),'ATOM').gt.0) then + sccalc=.false. + read (card(12:16),*) atom +c write (2,'(a)') card +c write (iout,*) "ibeg",ibeg +c write (iout,*) "! ",atom," !",ires +! if (atom.eq.'CA' .or. atom.eq.'CH3') then + read (card(23:26),*) ires + read (card(18:20),'(a3)') res +c write (iout,*) "ires",ires,ires-ishift+ishift1, +c & " ires_old",ires_old +c write (iout,*) "ishift",ishift," ishift1",ishift1 +c write (iout,*) "IRES",ires-ishift+ishift1,ires_old + if (ires-ishift+ishift1.ne.ires_old) then +! Calculate the CM of the preceding residue. +! if (ibeg.eq.0) call sccenter(ires,iii,sccor) + if (ibeg.eq.0) then +c write (iout,*) "Calculating sidechain center iii",iii +c write (iout,*) "ires",ires + if (unres_pdb) then +c write (iout,'(i5,3f10.5)') ires,(sccor(j,iii),j=1,3) + do j=1,3 + dc(j,ires_old)=sccor(j,iii) + enddo + else + call sccenter(ires_old,iii,sccor) + endif + iii=0 + sccalc=.true. + endif +! Start new residue. + if (res.eq.'Cl-' .or. res.eq.'Na+') then + ires=ires_old + cycle + else if (ibeg.eq.1) then +c write (iout,*) "BEG ires",ires + ishift=ires-1 + if (res.ne.'GLY' .and. res.ne. 'ACE') then + ishift=ishift-1 + itype(1)=ntyp1 + endif + ires=ires-ishift+ishift1 + ires_old=ires +! write (iout,*) "ishift",ishift," ires",ires,& +! " ires_old",ires_old + ibeg=0 + else if (ibeg.eq.2) then +! Start a new chain + ishift=-ires_old+ires-1 !!!!! + ishift1=ishift1-1 !!!!! +c write (iout,*) "New chain started",ires,ishift,ishift1,"!" + ires=ires-ishift+ishift1 + ires_old=ires + ibeg=0 + else + ishift=ishift-(ires-ishift+ishift1-ires_old-1) + ires=ires-ishift+ishift1 + ires_old=ires + endif + if (res.eq.'ACE' .or. res.eq.'NHE') then + itype(ires)=10 + else + itype(ires)=rescode(ires,res,0) + endif + else + ires=ires-ishift+ishift1 + endif +c write (iout,*) "ires_old",ires_old," ires",ires + if (card(27:27).eq."A" .or. card(27:27).eq."B") then +! ishift1=ishift1+1 + endif +c write (2,*) "ires",ires," res ",res!," ity"!,ity + if (atom.eq.'CA' .or. atom.eq.'CH3' .or. + & res.eq.'NHE'.and.atom(:2).eq.'HN') then + read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) + write (iout,*) "backbone ",atom + write (iout,*) ires,res,(c(j,ires),j=1,3) +#ifdef DEBUG + write (iout,'(i6,i3,2x,a,3f8.3)') + & ires,itype(ires),res,(c(j,ires),j=1,3) +#endif + iii=iii+1 + do j=1,3 + sccor(j,iii)=c(j,ires) + enddo +c write (2,*) card(23:27),ires,itype(ires),iii + else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and. + & atom.ne.'N' .and. atom.ne.'C' .and. + & atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and. + & atom.ne.'OXT' .and. atom(:2).ne.'3H') then +! write (iout,*) "sidechain ",atom + iii=iii+1 + read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) +c write (2,*) "iii",iii + endif + endif + enddo + 10 if(me.eq.king.or..not.out1file) + & write (iout,'(a,i5)') ' Nres: ',ires +c write (iout,*) "iii",iii +C Calculate dummy residue coordinates inside the "chain" of a multichain +C system + nres=ires +c write (iout,*) "dc" +c do i=1,nres +c write (iout,'(i5,3f10.5)') i,(dc(j,i),j=1,3) +c enddo + do i=2,nres-1 +c write (iout,*) i,itype(i),itype(i+1),ntyp1,iterter(i) + if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then + if (itype(i+1).eq.ntyp1.and.iterter(i+1).eq.1 ) then +C 16/01/2014 by Adasko: Adding to dummy atoms in the chain +C first is connected prevous chain (itype(i+1).eq.ntyp1)=true +C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue +c print *,i,'tu dochodze' + call refsys(i-3,i-2,i-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif !fail +c print *,i,'a tu?' + do j=1,3 + c(j,i)=c(j,i-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i-2)-c(j,i-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i-1)+dcj + c(j,nres+i)=c(j,i) + dC(j,i)=c(j,i) + enddo + endif !unres_pdb + else !itype(i+1).eq.ntyp1 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue + call refsys(i+1,i+2,i+3,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,i)=c(j,i+1)-1.9d0*e2(j) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i+3)-c(j,i+2))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i+1)-dcj + c(j,nres+i)=c(j,i) + dC(j,i)=c(j,i) + enddo + endif !unres_pdb + endif !itype(i+1).eq.ntyp1 + endif !itype.eq.ntyp1 + enddo + write (iout,*) "After loop in readpbd" +C Calculate the CM of the last side chain. + if (.not. sccalc) then + if (unres_pdb) then + do j=1,3 + dc(j,ires)=sccor(j,iii) + enddo + else +c write (iout,*) "Calling sccenter iii",iii + call sccenter(ires,iii,sccor) + endif + endif + nsup=nres + nstart_sup=1 + if (itype(nres).ne.10) then + nres=nres+1 + itype(nres)=ntyp1 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue + call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,nres)=c(j,nres-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + enddo + else + do j=1,3 + dcj=(c(j,nres-2)-c(j,nres-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,nres)=c(j,nres-1)+dcj + c(j,2*nres)=c(j,nres) + enddo + endif + endif + do i=2,nres-1 + do j=1,3 + c(j,i+nres)=dc(j,i) + enddo + enddo + do j=1,3 + c(j,nres+1)=c(j,1) + c(j,2*nres)=c(j,nres) + enddo + if (itype(1).eq.ntyp1) then + nsup=nsup-1 + nstart_sup=2 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue + call refsys(2,3,4,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,1)=c(j,2)+1.9d0*(e1(j)-e2(j))/dsqrt(2.0d0) + enddo + else + do j=1,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 + endif + endif +C Calculate internal coordinates. + if(me.eq.king.or..not.out1file)then + write (iout,'(/a)') + & "Cartesian coordinates of the reference structure" + write (iout,'(a,3(3x,a5),5x,3(3x,a5))') + & "Residue ","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" + do ires=1,nres + write (iout,'(a3,1x,i4,3f8.3,5x,3f8.3)') + & restyp(itype(ires)),ires,(c(j,ires),j=1,3), + & (c(j,ires+nres),j=1,3) + enddo + call flush(iout) + endif + zero=.false. + do ires=1,nres + zero=zero.or.itype(ires).eq.0 + enddo + if (zero) then + write (iout,'(2a)') "Gaps in PDB coordinates detected;", + & " look for ZERO in the control output above." + write (iout,'(2a)') "Repair the PDB file using MODELLER", + & " or other softwared and resubmit." + call flush(iout) + stop + endif +c write(iout,*)"before int_from_cart nres",nres + call int_from_cart(.true.,.false.) + do i=1,nres + thetaref(i)=theta(i) + phiref(i)=phi(i) + enddo + dc(:,0)=c(:,1) + do i=1,nres-1 + do j=1,3 + dc(j,i)=c(j,i+1)-c(j,i) + dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) + enddo +c write (iout,*) i,(dc(j,i),j=1,3),(dc_norm(j,i),j=1,3), +c & vbld_inv(i+1) + enddo + do i=2,nres-1 + do j=1,3 + dc(j,i+nres)=c(j,i+nres)-c(j,i) + dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) + enddo +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 + call sc_loc_geom(.false.) + call int_from_cart1(.false.) +c call chainbuild +C Copy the coordinates to reference coordinates + do i=1,nres + do j=1,3 + cref(j,i)=c(j,i) + cref(j,i+nres)=c(j,i+nres) + enddo + enddo + 100 format (//' alpha-carbon coordinates ', + & ' centroid coordinates'/ + 1 ' ', 7X,'X',11X,'Y',11X,'Z', + & 10X,'X',11X,'Y',11X,'Z') + 110 format (a,'(',i4,')',6f12.5) +cc enddiag + do j=1,nbfrag + do i=1,4 + bfrag(i,j)=bfrag(i,j)-ishift + enddo + enddo + + do j=1,nhfrag + do i=1,2 + hfrag(i,j)=hfrag(i,j)-ishift + enddo + enddo + return + end + diff --git a/source/unres/src-HCD-5D/readpdb_template.F b/source/unres/src-HCD-5D/readpdb_template.F new file mode 100644 index 0000000..217c34d --- /dev/null +++ b/source/unres/src-HCD-5D/readpdb_template.F @@ -0,0 +1,324 @@ + subroutine readpdb_template(k) +C Read the PDB file for read_constr_homology with read2sigma +C and convert the peptide geometry into virtual-chain geometry. + implicit none + 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.FRAG' + include 'COMMON.SETUP' + integer i,j,k,ibeg,ishift1,ires,iii,ires_old,ishift,ity, + & ishift_pdb,ires_ca + logical lprn /.false./,fail + double precision e1(3),e2(3),e3(3) + double precision dcj,efree_temp + character*3 seq,res + character*5 atom + character*80 card + double precision sccor(3,20) + integer rescode,iterter(maxres) + do i=1,maxres + iterter(i)=0 + enddo + ibeg=1 + ishift1=0 + ishift=0 +c write (2,*) "UNRES_PDB",unres_pdb + ires=0 + ires_old=0 + iii=0 + lsecondary=.false. + nhfrag=0 + nbfrag=0 + 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+2 + itype(ires_old-1)=ntyp1 + iterter(ires_old-1)=1 + itype(ires_old)=ntyp1 + iterter(ires_old)=1 + ibeg=2 +c write (iout,*) "Chain ended",ires,ishift,ires_old + if (unres_pdb) then + do j=1,3 + dc(j,ires)=sccor(j,iii) + enddo + else + call sccenter(ires,iii,sccor) + endif + endif +C Fish out the ATOM cards. + if (index(card(1:4),'ATOM').gt.0) then + read (card(12:16),*) atom +c write (iout,*) "! ",atom," !",ires +c if (atom.eq.'CA' .or. atom.eq.'CH3') then + read (card(23:26),*) ires + read (card(18:20),'(a3)') res +c write (iout,*) "ires",ires,ires-ishift+ishift1, +c & " ires_old",ires_old +c write (iout,*) "ishift",ishift," ishift1",ishift1 +c write (iout,*) "IRES",ires-ishift+ishift1,ires_old + if (ires-ishift+ishift1.ne.ires_old) then +C Calculate the CM of the preceding residue. + if (ibeg.eq.0) then + if (unres_pdb) then + do j=1,3 + dc(j,ires_old)=sccor(j,iii) + enddo + else + call sccenter(ires_old,iii,sccor) + endif + iii=0 + endif +C Start new residue. + if (res.eq.'Cl-' .or. res.eq.'Na+') then + ires=ires_old + cycle + else if (ibeg.eq.1) then +c write (iout,*) "BEG ires",ires + ishift=ires-1 + if (res.ne.'GLY' .and. res.ne. 'ACE') then + ishift=ishift-1 + itype(1)=ntyp1 + endif + ires=ires-ishift+ishift1 + ires_old=ires +c write (iout,*) "ishift",ishift," ires",ires, +c & " ires_old",ires_old +c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift + ibeg=0 + else if (ibeg.eq.2) then +c Start a new chain + ishift=-ires_old+ires-1 + ires=ires_old+1 +c write (iout,*) "New chain started",ires,ishift + ibeg=0 + else + ishift=ishift-(ires-ishift+ishift1-ires_old-1) + ires=ires-ishift+ishift1 + ires_old=ires + endif + if (res.eq.'ACE' .or. res.eq.'NHE') then + itype(ires)=10 + else + itype(ires)=rescode(ires,res,0) + endif + else + ires=ires-ishift+ishift1 + endif +c write (iout,*) "ires_old",ires_old," ires",ires +c if (card(27:27).eq."A" .or. card(27:27).eq."B") then +c ishift1=ishift1+1 +c endif +c write (2,*) "ires",ires," res ",res," ity",ity + if (atom.eq.'CA' .or. atom.eq.'CH3' .or. + & res.eq.'NHE'.and.atom(:2).eq.'HN') then + read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) +c write (iout,*) "backbone ",atom ,ires,res, (c(j,ires),j=1,3) +#ifdef DEBUG + write (iout,'(2i3,2x,a,3f8.3)') + & ires,itype(ires),res,(c(j,ires),j=1,3) +#endif + iii=iii+1 + do j=1,3 + sccor(j,iii)=c(j,ires) + enddo + if (ishift.ne.0) then + ires_ca=ires+ishift-ishift1 + else + ires_ca=ires + endif +c write (*,*) card(23:27),ires,itype(ires) + else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and. + & atom.ne.'N' .and. atom.ne.'C' .and. + & atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and. + & atom.ne.'OXT' .and. atom(:2).ne.'3H') then +c write (iout,*) "sidechain ",atom + iii=iii+1 + read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) + endif + endif + enddo + 10 if(me.eq.king.or..not.out1file) + & write (iout,'(a,i5)') ' Nres: ',ires +C Calculate dummy residue coordinates inside the "chain" of a multichain +C system + nres=ires + do i=2,nres-1 +c write (iout,*) i,itype(i),itype(i+1) + if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then + if (itype(i+1).eq.ntyp1.and.iterter(i+1).eq.1 ) then +C 16/01/2014 by Adasko: Adding to dummy atoms in the chain +C first is connected prevous chain (itype(i+1).eq.ntyp1)=true +C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue + call refsys(i-3,i-2,i-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif !fail + do j=1,3 + c(j,i)=c(j,i-1)-1.9d0*e2(j) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i-2)-c(j,i-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i-1)+dcj + c(j,nres+i)=c(j,i) + enddo + endif !unres_pdb + else !itype(i+1).eq.ntyp1 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue + call refsys(i+1,i+2,i+3,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,i)=c(j,i+1)-1.9d0*e2(j) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i+3)-c(j,i+2))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i+1)-dcj + c(j,nres+i)=c(j,i) + enddo + endif !unres_pdb + endif !itype(i+1).eq.ntyp1 + endif !itype.eq.ntyp1 + enddo +C Calculate the CM of the last side chain. + if (unres_pdb) then + do j=1,3 + dc(j,ires)=sccor(j,iii) + enddo + else + call sccenter(ires,iii,sccor) + endif + nsup=nres + nstart_sup=1 + if (itype(nres).ne.10) then + nres=nres+1 + itype(nres)=ntyp1 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue + call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,nres)=c(j,nres-1)-1.9d0*e2(j) + enddo + else + do j=1,3 + dcj=(c(j,nres-2)-c(j,nres-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,nres)=c(j,nres-1)+dcj + c(j,2*nres)=c(j,nres) + enddo + endif + endif + do i=2,nres-1 + do j=1,3 + c(j,i+nres)=dc(j,i) + enddo + enddo + do j=1,3 + c(j,nres+1)=c(j,1) + c(j,2*nres)=c(j,nres) + enddo + if (itype(1).eq.ntyp1) then + nsup=nsup-1 + nstart_sup=2 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue + call refsys(2,3,4,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,1)=c(j,2)-1.9d0*e2(j) + enddo + else + do j=1,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 + endif + endif +C Copy the coordinates to reference coordinates +c do i=1,2*nres +c do j=1,3 +c cref(j,i)=c(j,i) +c enddo +c enddo +C Calculate internal coordinates. + if (out_template_coord) then + write (iout,'(/a)') + & "Cartesian coordinates of the reference structure" + write (iout,'(a,3(3x,a5),5x,3(3x,a5))') + & "Residue ","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" + do ires=1,nres + write (iout,'(a3,1x,i4,3f8.3,5x,3f8.3)') + & restyp(itype(ires)),ires,(c(j,ires),j=1,3), + & (c(j,ires+nres),j=1,3) + enddo + endif +C Calculate internal coordinates. + call int_from_cart(.true.,out_template_coord) + call sc_loc_geom(.false.) + do i=1,nres + thetaref(i)=theta(i) + phiref(i)=phi(i) + enddo + do i=1,nres-1 + do j=1,3 + dc(j,i)=c(j,i+1)-c(j,i) + dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) + enddo + enddo + do i=2,nres-1 + do j=1,3 + dc(j,i+nres)=c(j,i+nres)-c(j,i) + dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) + enddo +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 + do j=1,3 + cref(j,i)=c(j,i) + cref(j,i+nres)=c(j,i+nres) + enddo + enddo + do i=1,2*nres + do j=1,3 + chomo(j,i,k)=c(j,i) + enddo + enddo + + return + end + + diff --git a/source/unres/src-HCD-5D/readrtns_CSA.F b/source/unres/src-HCD-5D/readrtns_CSA.F index e5f0b41..eeaf74c 100644 --- a/source/unres/src-HCD-5D/readrtns_CSA.F +++ b/source/unres/src-HCD-5D/readrtns_CSA.F @@ -1184,7 +1184,8 @@ c write (iout,*) "After read_dist_constr nhpb",nhpb 335 continue unres_pdb=.false. nres_temp=nres - call readpdb +c call readpdb + call readpdb_template(nmodel_start+1) close(ipdbin) if (nres.ge.nres_temp) then nmodel_start=nmodel_start+1 diff --git a/source/wham/src-HCD/DIMENSIONS b/source/wham/src-HCD/DIMENSIONS index c360026..fb93081 100644 --- a/source/wham/src-HCD/DIMENSIONS +++ b/source/wham/src-HCD/DIMENSIONS @@ -54,7 +54,8 @@ C include in template-based/contact distance restraints. parameter (maxcont_res=200) C Max. number of distance/contact-distance restraints integer maxdim_cont - parameter (maxdim_cont=maxres*maxcont_res) +c parameter (maxdim_cont=maxres*maxcont_res) + parameter (maxdim_cont=maxres*1000) C Number of AA types (at present only natural AA's will be handled integer ntyp,ntyp1 parameter (ntyp=24,ntyp1=ntyp+1) diff --git a/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos b/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos index b04295c..c5e3133 100644 --- a/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos +++ b/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos @@ -1,10 +1,12 @@ BIN = ~/bin FC = ftn -OPT = -mcmodel=medium -shared-intel -O3 -dynamic +OPT = -mcmodel=medium -shared-intel -O2 -dynamic +OPTE = -mcmodel=medium -shared-intel -O3 -dynamic #OPT = -O3 -intel-static -mcmodel=medium #OPT = -O3 -ip -w #OPT = -g -CB -mcmodel=medium -shared-intel -dynamic FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include +FFLAGSE = ${OPTE} -c -I. -I./include_unres -I$(INSTALL_DIR)/include LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a .f.o: @@ -59,7 +61,7 @@ objects = \ objects_compar = \ readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ + readpdb-mult.o fitsq.o contact.o \ elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o @@ -156,6 +158,11 @@ NEWCORR5D_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a xdrf/libxdrf.a: cd xdrf && make +energy_p_new.o: energy_p_new.F + ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F + +wham_calc1.o: wham_calc1.F + ${FC} ${FFLAGSE} ${CPPFLAGS} wham_calc1.F clean: /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean diff --git a/source/wham/src-HCD/readpdb-mult.F b/source/wham/src-HCD/readpdb-mult.F new file mode 100644 index 0000000..37b15c1 --- /dev/null +++ b/source/wham/src-HCD/readpdb-mult.F @@ -0,0 +1,960 @@ + subroutine readpdb +C Read the PDB file and convert the peptide geometry into virtual-chain +C geometry. + implicit none + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'COMMON.CONTROL' + include 'COMMON.LOCAL' + include 'COMMON.VAR' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.NAMES' + include 'COMMON.SBRIDGE' + include 'COMMON.FRAG' + character*3 seq,atom,res + character*80 card + double precision e1(3),e2(3),e3(3) + double precision sccor(3,50) + integer i,j,iii,ibeg,ishift,ishift1,ity,ires,ires_old + double precision dcj + integer rescode,kkk,lll,icha,cou,kupa,iprzes + logical lsecondary,sccalc,fail,zero + integer iterter(maxres) + double precision efree_temp + iii=0 + ibeg=1 + ishift1=0 + sccalc=.false. + bfac=0.0d0 + do i=1,maxres + iterter(i)=0 + enddo + ibeg=1 + ishift1=0 + lsecondary=.false. + nhfrag=0 + nbfrag=0 + iii=0 + sccalc=.false. + do + read (ipdbin,'(a80)',end=10) card +c write (iout,'(a)') card +c call flush(iout) + if (card(:5).eq.'HELIX') then + nhfrag=nhfrag+1 + lsecondary=.true. + read(card(22:25),*) hfrag(1,nhfrag) + read(card(34:37),*) hfrag(2,nhfrag) + endif + if (card(:5).eq.'SHEET') then + nbfrag=nbfrag+1 + lsecondary=.true. + read(card(24:26),*) bfrag(1,nbfrag) + read(card(35:37),*) bfrag(2,nbfrag) +!rc---------------------------------------- +!rc to be corrected !!! + bfrag(3,nbfrag)=bfrag(1,nbfrag) + bfrag(4,nbfrag)=bfrag(2,nbfrag) +!rc---------------------------------------- + endif + if (card(:3).eq.'END') then + goto 10 + else if (card(:3).eq.'TER') then +! End current chain + ires_old=ires+2 + itype(ires_old-1)=ntyp1 + iterter(ires_old-1)=1 + itype(ires_old)=ntyp1 + iterter(ires_old)=1 +c ishift1=ishift1+1 + ibeg=2 + write (iout,*) "Chain ended",ires,ishift,ires_old,ibeg + if (unres_pdb) then + do j=1,3 + dc(j,ires)=sccor(j,iii) + enddo + else + call sccenter(ires,iii,sccor) + endif + iii=0 + sccalc=.true. + endif +! Read free energy +c if (index(card,"FREE ENERGY").gt.0) then +c ifree=index(card,"FREE ENERGY")+12 +c read(card(ifree:),*,err=1115,end=1115) efree_temp +c 1115 continue +c endif +! Fish out the ATOM cards. + if (index(card(1:4),'ATOM').gt.0) then + sccalc=.false. + read (card(12:16),*) atom +c write (2,'(a)') card +c write (iout,*) "ibeg",ibeg +c write (iout,*) "! ",atom," !",ires +! if (atom.eq.'CA' .or. atom.eq.'CH3') then + read (card(23:26),*) ires + read (card(18:20),'(a3)') res +c write (iout,*) "ires",ires,ires-ishift+ishift1, +c & " ires_old",ires_old +c write (iout,*) "ishift",ishift," ishift1",ishift1 +c write (iout,*) "IRES",ires-ishift+ishift1,ires_old + if (ires-ishift+ishift1.ne.ires_old) then +! Calculate the CM of the preceding residue. +! if (ibeg.eq.0) call sccenter(ires,iii,sccor) + if (ibeg.eq.0) then +c write (iout,*) "Calculating sidechain center iii",iii +c write (iout,*) "ires",ires + if (unres_pdb) then +c write (iout,'(i5,3f10.5)') ires,(sccor(j,iii),j=1,3) + do j=1,3 + dc(j,ires_old)=sccor(j,iii) + enddo + else + call sccenter(ires_old,iii,sccor) + endif + iii=0 + sccalc=.true. + endif +! Start new residue. +c write (iout,*) "ibeg",ibeg + if (res.eq.'Cl-' .or. res.eq.'Na+') then + ires=ires_old + cycle + else if (ibeg.eq.1) then +c write (iout,*) "BEG ires",ires + ishift=ires-1 + if (res.ne.'GLY' .and. res.ne. 'ACE') then + ishift=ishift-1 + itype(1)=ntyp1 + endif + ires=ires-ishift+ishift1 + ires_old=ires +! write (iout,*) "ishift",ishift," ires",ires,& +! " ires_old",ires_old + ibeg=0 + else if (ibeg.eq.2) then +! Start a new chain + ishift=-ires_old+ires-1 !!!!! +c ishift1=ishift1-1 !!!!! +c write (iout,*) "New chain started",ires,ires_old,ishift, +c & ishift1 + ires=ires-ishift+ishift1 + write (iout,*) "New chain started ires",ires + ires_old=ires +c ires=ires_old+1 + ibeg=0 + else + ishift=ishift-(ires-ishift+ishift1-ires_old-1) + ires=ires-ishift+ishift1 + ires_old=ires + endif + if (res.eq.'ACE' .or. res.eq.'NHE') then + itype(ires)=10 + else + itype(ires)=rescode(ires,res,0) + endif + else + ires=ires-ishift+ishift1 + endif +c write (iout,*) "ires_old",ires_old," ires",ires + if (card(27:27).eq."A" .or. card(27:27).eq."B") then +! ishift1=ishift1+1 + endif +c write (2,*) "ires",ires," res ",res!," ity"!,ity + if (atom.eq.'CA' .or. atom.eq.'CH3' .or. + & res.eq.'NHE'.and.atom(:2).eq.'HN') then + read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) +c write (iout,*) "backbone ",atom +c write (iout,*) ires,res,(c(j,ires),j=1,3) +#ifdef DEBUG + write (iout,'(i6,i3,2x,a,3f8.3)') + & ires,itype(ires),res,(c(j,ires),j=1,3) +#endif + iii=iii+1 + do j=1,3 + sccor(j,iii)=c(j,ires) + enddo +c write (2,*) card(23:27),ires,itype(ires),iii + else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and. + & atom.ne.'N' .and. atom.ne.'C' .and. + & atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and. + & atom.ne.'OXT' .and. atom(:2).ne.'3H') then +! write (iout,*) "sidechain ",atom + iii=iii+1 + read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) +c write (2,*) "iii",iii + endif + endif + enddo + 10 write (iout,'(a,i5)') ' Nres: ',ires +c write (iout,*) "iii",iii +C Calculate dummy residue coordinates inside the "chain" of a multichain +C system + nres=ires +c write (iout,*) "dc" +c do i=1,nres +c write (iout,'(i5,3f10.5)') i,(dc(j,i),j=1,3) +c enddo + do i=2,nres-1 +c write (iout,*) i,itype(i),itype(i+1),ntyp1,iterter(i) + if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then + if (itype(i+1).eq.ntyp1.and.iterter(i+1).eq.1 ) then +C 16/01/2014 by Adasko: Adding to dummy atoms in the chain +C first is connected prevous chain (itype(i+1).eq.ntyp1)=true +C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue +c print *,i,'tu dochodze' + call refsys(i-3,i-2,i-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif !fail +c print *,i,'a tu?' + do j=1,3 + c(j,i)=c(j,i-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i-2)-c(j,i-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i-1)+dcj + c(j,nres+i)=c(j,i) + dC(j,i)=c(j,i) + enddo + endif !unres_pdb + else !itype(i+1).eq.ntyp1 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue + call refsys(i+1,i+2,i+3,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,i)=c(j,i+1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i+3)-c(j,i+2))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i+1)-dcj + c(j,nres+i)=c(j,i) + dC(j,i)=c(j,i) + enddo + endif !unres_pdb + endif !itype(i+1).eq.ntyp1 + endif !itype.eq.ntyp1 + enddo + write (iout,*) "After loop in readpbd" +C Calculate the CM of the last side chain. + if (.not. sccalc) then + if (unres_pdb) then + do j=1,3 + dc(j,ires)=sccor(j,iii) + enddo + else +c write (iout,*) "Calling sccenter iii",iii + call sccenter(ires,iii,sccor) + endif + endif + nsup=nres + nstart_sup=1 + if (itype(nres).ne.10) then + nres=nres+1 + itype(nres)=ntyp1 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue + call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,nres)=c(j,nres-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + enddo + else + do j=1,3 + dcj=(c(j,nres-2)-c(j,nres-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,nres)=c(j,nres-1)+dcj + c(j,2*nres)=c(j,nres) + enddo + endif + endif + do i=2,nres-1 + do j=1,3 + c(j,i+nres)=dc(j,i) + enddo + enddo + do j=1,3 + c(j,nres+1)=c(j,1) + c(j,2*nres)=c(j,nres) + enddo + if (itype(1).eq.ntyp1) then + nsup=nsup-1 + nstart_sup=2 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue + call refsys(2,3,4,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,1)=c(j,2)+1.9d0*(e1(j)-e2(j))/dsqrt(2.0d0) + enddo + else + do j=1,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 + endif + endif +C Calculate internal coordinates. + write (iout,'(/a)') + & "Cartesian coordinates of the reference structure" + write (iout,'(a,3(3x,a5),5x,3(3x,a5))') + & "Residue ","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" + do ires=1,nres + write (iout,'(a3,1x,i4,3f8.3,5x,3f8.3)') + & restyp(itype(ires)),ires,(c(j,ires),j=1,3), + & (c(j,ires+nres),j=1,3) + zero=.false. + enddo + do ires=1,nres + zero=zero.or.itype(ires).eq.0 + enddo + if (zero) then + write (iout,'(2a)') "Gaps in PDB coordinates detected;", + & " look for ZERO in the control output above." + write (iout,'(2a)') "Repair the PDB file using MODELLER", + & " or other softwared and resubmit." + call flush(iout) + stop + endif +c write(iout,*)"before int_from_cart nres",nres + call int_from_cart(.true.,.false.) + do i=1,nres + thetaref(i)=theta(i) + phiref(i)=phi(i) + enddo + dc(:,0)=c(:,1) + do i=1,nres-1 + do j=1,3 + dc(j,i)=c(j,i+1)-c(j,i) + dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) + enddo +c write (iout,*) i,(dc(j,i),j=1,3),(dc_norm(j,i),j=1,3), +c & vbld_inv(i+1) + enddo + do i=2,nres-1 + do j=1,3 + dc(j,i+nres)=c(j,i+nres)-c(j,i) + dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) + enddo +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 + call sc_loc_geom(.false.) + call int_from_cart1(.false.) +c call chainbuild +C Copy the coordinates to reference coordinates + do i=1,nres + do j=1,3 + cref(j,i)=c(j,i) + cref(j,i+nres)=c(j,i+nres) + enddo + enddo + 100 format (//' alpha-carbon coordinates ', + & ' centroid coordinates'/ + 1 ' ', 7X,'X',11X,'Y',11X,'Z', + & 10X,'X',11X,'Y',11X,'Z') + 110 format (a,'(',i4,')',6f12.5) +cc enddiag + do j=1,nbfrag + do i=1,4 + bfrag(i,j)=bfrag(i,j)-ishift + enddo + enddo + + do j=1,nhfrag + do i=1,2 + hfrag(i,j)=hfrag(i,j)-ishift + enddo + enddo + return + end +c--------------------------------------------------------------------------- + subroutine readpdb_template(k) +C Read the PDB file for read_constr_homology with read2sigma +C and convert the peptide geometry into virtual-chain geometry. + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + 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' + integer i,j,ibeg,ishift1,ires,iii,ires_old,ishift,ity + logical lprn /.false./,fail + double precision e1(3),e2(3),e3(3) + double precision dcj,efree_temp + character*3 seq,res + character*5 atom + character*80 card + double precision sccor(3,20) + integer rescode,iterter(maxres) + logical zero + do i=1,maxres + iterter(i)=0 + enddo + ibeg=1 + ishift1=0 + ishift=0 +c write (2,*) "UNRES_PDB",unres_pdb + ires=0 + ires_old=0 + iii=0 + lsecondary=.false. + nhfrag=0 + nbfrag=0 + 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+2 + itype(ires_old-1)=ntyp1 + iterter(ires_old-1)=1 + itype(ires_old)=ntyp1 + iterter(ires_old)=1 + ibeg=2 +c write (iout,*) "Chain ended",ires,ishift,ires_old + if (unres_pdb) then + do j=1,3 + dc(j,ires)=sccor(j,iii) + enddo + else + call sccenter(ires,iii,sccor) + endif + endif +C Fish out the ATOM cards. + if (index(card(1:4),'ATOM').gt.0) then + read (card(12:16),*) atom +c write (iout,*) "! ",atom," !",ires +c if (atom.eq.'CA' .or. atom.eq.'CH3') then + read (card(23:26),*) ires + read (card(18:20),'(a3)') res +c write (iout,*) "ires",ires,ires-ishift+ishift1, +c & " ires_old",ires_old +c write (iout,*) "ishift",ishift," ishift1",ishift1 +c write (iout,*) "IRES",ires-ishift+ishift1,ires_old + if (ires-ishift+ishift1.ne.ires_old) then +C Calculate the CM of the preceding residue. + if (ibeg.eq.0) then + if (unres_pdb) then + do j=1,3 + dc(j,ires_old)=sccor(j,iii) + enddo + else + call sccenter(ires_old,iii,sccor) + endif + iii=0 + endif +C Start new residue. + if (res.eq.'Cl-' .or. res.eq.'Na+') then + ires=ires_old + cycle + else if (ibeg.eq.1) then +c write (iout,*) "BEG ires",ires + ishift=ires-1 + if (res.ne.'GLY' .and. res.ne. 'ACE') then + ishift=ishift-1 + itype(1)=ntyp1 + endif + ires=ires-ishift+ishift1 + ires_old=ires +c write (iout,*) "ishift",ishift," ires",ires, +c & " ires_old",ires_old +c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift + ibeg=0 + else if (ibeg.eq.2) then +c Start a new chain + ishift=-ires_old+ires-1 + ires=ires_old+1 +c write (iout,*) "New chain started",ires,ishift + ibeg=0 + else + ishift=ishift-(ires-ishift+ishift1-ires_old-1) + ires=ires-ishift+ishift1 + ires_old=ires + endif + if (res.eq.'ACE' .or. res.eq.'NHE') then + itype(ires)=10 + else + itype(ires)=rescode(ires,res,0) + endif + else + ires=ires-ishift+ishift1 + endif +c write (iout,*) "ires_old",ires_old," ires",ires +c if (card(27:27).eq."A" .or. card(27:27).eq."B") then +c ishift1=ishift1+1 +c endif +c write (2,*) "ires",ires," res ",res," ity",ity + if (atom.eq.'CA' .or. atom.eq.'CH3' .or. + & res.eq.'NHE'.and.atom(:2).eq.'HN') then + read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) +c write (iout,*) "backbone ",atom ,ires,res, (c(j,ires),j=1,3) +#ifdef DEBUG + write (iout,'(2i3,2x,a,3f8.3)') + & ires,itype(ires),res,(c(j,ires),j=1,3) +#endif + iii=iii+1 + do j=1,3 + sccor(j,iii)=c(j,ires) + enddo + if (ishift.ne.0) then + ires_ca=ires+ishift-ishift1 + else + ires_ca=ires + endif +c write (*,*) card(23:27),ires,itype(ires) + else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and. + & atom.ne.'N' .and. atom.ne.'C' .and. + & atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and. + & atom.ne.'OXT' .and. atom(:2).ne.'3H') then +c write (iout,*) "sidechain ",atom + iii=iii+1 + read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) + endif + endif + enddo + 10 write (iout,'(a,i5)') ' Nres: ',ires +C Calculate dummy residue coordinates inside the "chain" of a multichain +C system + nres=ires + do i=2,nres-1 +c write (iout,*) i,itype(i),itype(i+1) + if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then + if (itype(i+1).eq.ntyp1.and.iterter(i+1).eq.1 ) then +C 16/01/2014 by Adasko: Adding to dummy atoms in the chain +C first is connected prevous chain (itype(i+1).eq.ntyp1)=true +C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue + call refsys(i-3,i-2,i-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif !fail + do j=1,3 + c(j,i)=c(j,i-1)-1.9d0*e2(j) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i-2)-c(j,i-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i-1)+dcj + c(j,nres+i)=c(j,i) + enddo + endif !unres_pdb + else !itype(i+1).eq.ntyp1 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue + call refsys(i+1,i+2,i+3,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,i)=c(j,i+1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i+3)-c(j,i+2))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i+1)-dcj + c(j,nres+i)=c(j,i) + enddo + endif !unres_pdb + endif !itype(i+1).eq.ntyp1 + endif !itype.eq.ntyp1 + enddo +C Calculate the CM of the last side chain. + if (unres_pdb) then + do j=1,3 + dc(j,ires)=sccor(j,iii) + enddo + else + call sccenter(ires,iii,sccor) + endif + nsup=nres + nstart_sup=1 + if (itype(nres).ne.10) then + nres=nres+1 + itype(nres)=ntyp1 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue + call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,nres)=c(j,nres-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + enddo + else + do j=1,3 + dcj=(c(j,nres-2)-c(j,nres-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,nres)=c(j,nres-1)+dcj + c(j,2*nres)=c(j,nres) + enddo + endif + endif + do i=2,nres-1 + do j=1,3 + c(j,i+nres)=dc(j,i) + enddo + enddo + do j=1,3 + c(j,nres+1)=c(j,1) + c(j,2*nres)=c(j,nres) + enddo + if (itype(1).eq.ntyp1) then + nsup=nsup-1 + nstart_sup=2 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue + call refsys(2,3,4,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,1)=c(j,2)+1.9d0*(e1(j)-e2(j))/dsqrt(2.0d0) + enddo + else + do j=1,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 + endif + endif +C Copy the coordinates to reference coordinates +c do i=1,2*nres +c do j=1,3 +c cref(j,i)=c(j,i) +c enddo +c enddo +C Calculate internal coordinates. + if (out_template_coord) then + write (iout,'(/a)') + & "Cartesian coordinates of the reference structure" + write (iout,'(a,3(3x,a5),5x,3(3x,a5))') + & "Residue ","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" + do ires=1,nres + write (iout,'(a3,1x,i4,3f8.3,5x,3f8.3)') + & restyp(itype(ires)),ires,(c(j,ires),j=1,3), + & (c(j,ires+nres),j=1,3) + enddo + endif + zero=.false. + do ires=1,nres + zero=zero.or.itype(ires).eq.0 + enddo + if (zero) then + write (iout,'(2a)') "Gaps in PDB coordinates detected;", + & " look for ZERO in the control output above." + write (iout,'(2a)') "Repair the PDB file using MODELLER", + & " or other softwared and resubmit." + call flush(iout) + stop + endif +C Calculate internal coordinates. + call int_from_cart(.true.,out_template_coord) + call sc_loc_geom(.false.) + do i=1,nres + thetaref(i)=theta(i) + phiref(i)=phi(i) + enddo + dc(:,0)=c(:,1) + do i=1,nres-1 + do j=1,3 + dc(j,i)=c(j,i+1)-c(j,i) + dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) + enddo + enddo + do i=2,nres-1 + do j=1,3 + dc(j,i+nres)=c(j,i+nres)-c(j,i) + dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) + enddo +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 + do j=1,3 + cref(j,i)=c(j,i) + cref(j,i+nres)=c(j,i+nres) + enddo + enddo + do i=1,2*nres + do j=1,3 + chomo(j,i,k)=c(j,i) + enddo + enddo + + return + end +c--------------------------------------------------------------------------- + subroutine int_from_cart(lside,lprn) + implicit none + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'COMMON.LOCAL' + include 'COMMON.VAR' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.NAMES' + character*3 seq,atom,res + character*80 card + double precision sccor(3,50) + integer rescode + double precision dist,alpha,beta,di + integer i,j,iti + logical lside,lprn + if (lprn) then + write (iout,'(/a)') + & 'Internal coordinates calculated from crystal structure.' + if (lside) then + write (iout,'(8a)') ' Res ',' dvb',' Theta', + & ' Phi',' Dsc_id',' Dsc',' Alpha', + & ' Omega' + else + write (iout,'(4a)') ' Res ',' dvb',' Theta', + & ' Phi' + endif + endif + do i=2,nres + iti=itype(i) +c 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.ntyp1 .and. itype(i).ne.ntyp1 .and. + & (dist(i,i-1).lt.1.0D0 .or. dist(i,i-1).gt.6.0D0)) then + write (iout,'(a,i4)') 'Bad Cartesians for residue',i +c stop + endif + vbld(i)=dist(i-1,i) + vbld_inv(i)=1.0d0/vbld(i) + 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 +c if (itype(1).eq.ntyp1) then +c do j=1,3 +c c(j,1)=c(j,2)+(c(j,3)-c(j,4)) +c enddo +c endif +c if (itype(nres).eq.ntyp1) then +c do j=1,3 +c c(j,nres)=c(j,nres-1)+(c(j,nres-2)-c(j,nres-3)) +c enddo +c endif + if (lside) then + do i=2,nres-1 + do j=1,3 + c(j,maxres2)=0.5D0*(c(j,i-1)+c(j,i+1)) + enddo + iti=itype(i) + di=dist(i,nres+i) + vbld(i+nres)=di + if (itype(i).ne.10) then + vbld_inv(i+nres)=1.0d0/di + else + vbld_inv(i+nres)=0.0d0 + endif + if (iti.ne.10) then + alph(i)=alpha(nres+i,i,maxres2) + omeg(i)=beta(nres+i,i,maxres2,i+1) + endif + if (iti.ne.10) then + alph(i)=alpha(nres+i,i,maxres2) + omeg(i)=beta(nres+i,i,maxres2,i+1) + endif + if (lprn) + & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), + & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),di, + & rad2deg*alph(i),rad2deg*omeg(i) + enddo + else if (lprn) then + do i=2,nres + iti=itype(i) + write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), + & rad2deg*theta(i),rad2deg*phi(i) + enddo + endif + return + end +c--------------------------------------------------------------------------- + subroutine sccenter(ires,nscat,sccor) + implicit none + include 'DIMENSIONS' + include 'COMMON.CHAIN' + integer ires,nscat,i,j + double precision sccor(3,50),sccmj + do j=1,3 + sccmj=0.0D0 + do i=1,nscat + sccmj=sccmj+sccor(j,i) + enddo + dc(j,ires)=sccmj/nscat + enddo + return + end +c--------------------------------------------------------------------------- + subroutine sc_loc_geom(lprn) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + 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 +c write (iout,*) "x_prime",(x_prime(j),j=1,3) +c write (iout,*) "y_prime",(y_prime(j),j=1,3) + call vecpr(x_prime,y_prime,z_prime) +c write (iout,*) "z_prime",(z_prime(j),j=1,3) +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 + write (iout,*) "xxref,yyref,zzref" + do i=2,nres + iti=itype(i) + write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i),yyref(i), + & zzref(i) + enddo + endif + return + end +c--------------------------------------------------------------------------- + subroutine bond_regular + implicit none + include 'DIMENSIONS' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.INTERACT' + include 'COMMON.CHAIN' + integer i,i1,i2 + do i=1,nres-1 + vbld(i+1)=vbl + vbld_inv(i+1)=vblinv + vbld(i+1+nres)=dsc(iabs(itype(i+1))) + vbld_inv(i+1+nres)=dsc_inv(iabs(itype(i+1))) +c print *,vbld(i+1),vbld(i+1+nres) + enddo +c Adam 2/26/20 Alter virtual bonds for non-blocking end groups of each chain + do i=1,nchain + i1=chain_border(1,i) + i2=chain_border(2,i) + if (i1.gt.1) then + vbld(i1)=vbld(i1)/2 + vbld_inv(i1)=vbld_inv(i1)*2 + endif + if (i2.lt.nres) then + vbld(i2+1)=vbld(i2+1)/2 + vbld_inv(i2+1)=vbld_inv(i2+1)*2 + endif + enddo + return + end + -- 1.7.9.5 From d8ee9f2b7fc2a4cb79e268f3b6a0429fa1233fa7 Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Sun, 19 Jul 2020 19:32:07 +0200 Subject: [PATCH 10/16] changes --- source/unres/src-HCD-5D/COMMON.DFA | 2 +- source/unres/src-HCD-5D/DIMENSIONS | 7 ++-- source/unres/src-HCD-5D/boxshift.f | 12 ++++++- source/unres/src-HCD-5D/chain_symmetry.F | 3 ++ source/unres/src-HCD-5D/dfa.F | 1 + source/unres/src-HCD-5D/energy_p_new_barrier.F | 3 +- source/unres/src-HCD-5D/readpdb-mult.F | 43 +++++++----------------- source/unres/src-HCD-5D/readrtns_CSA.F | 18 +++++++--- source/unres/src-HCD-5D/ssMD.F | 29 +++++++++++++--- source/wham/src-HCD/bxread.F | 2 +- source/wham/src-HCD/cxread.F | 2 +- source/wham/src-HCD/enecalc1.F | 4 +-- source/wham/src-HCD/readrtns.F | 4 +-- source/wham/src-HCD/xread.F | 2 +- 14 files changed, 80 insertions(+), 52 deletions(-) diff --git a/source/unres/src-HCD-5D/COMMON.DFA b/source/unres/src-HCD-5D/COMMON.DFA index 818c024..51a7af7 100644 --- a/source/unres/src-HCD-5D/COMMON.DFA +++ b/source/unres/src-HCD-5D/COMMON.DFA @@ -11,7 +11,7 @@ C Total : ~ 11 * Nres restraints C C INTEGER IDFAMAX,IDFAMX2,IDFACMD,IDMAXMIN, MAXN - PARAMETER(IDFAMAX=10000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) + PARAMETER(IDFAMAX=25000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) PARAMETER(MAXN=4) real*8 wwdist,wwangle,wwnei parameter(wwdist=1.0d0,wwangle=1.0d0,wwnei=1.0d0) diff --git a/source/unres/src-HCD-5D/DIMENSIONS b/source/unres/src-HCD-5D/DIMENSIONS index ed21dfe..4236776 100644 --- a/source/unres/src-HCD-5D/DIMENSIONS +++ b/source/unres/src-HCD-5D/DIMENSIONS @@ -16,7 +16,7 @@ C Max. number of coarse-grain processors parameter (max_cg_procs=maxprocs) C Max. number of AA residues integer maxres - parameter (maxres=10000) + parameter (maxres=20000) C Max. number of AA residues per chain integer maxres_chain parameter (maxres_chain=1200) @@ -53,14 +53,15 @@ C Max. number of contacts per residue c parameter (maxconts=50) C Max. number of interactions within cutoff per residue integer maxint_res - parameter (maxint_res=200) + parameter (maxint_res=250) C Max. number od residues within distance cufoff from a given residue to C include in template-based/contact distance restraints. integer maxcont_res parameter (maxcont_res=200) C Max. number of distance/contact-distance restraints integer maxdim_cont - parameter (maxdim_cont=maxres*maxcont_res) +c parameter (maxdim_cont=maxres*maxcont_res) + parameter (maxdim_cont=maxres*1000) C Number of AA types (at present only natural AA's will be handled integer ntyp,ntyp1 parameter (ntyp=24,ntyp1=ntyp+1) diff --git a/source/unres/src-HCD-5D/boxshift.f b/source/unres/src-HCD-5D/boxshift.f index 29d3406..070d9c9 100644 --- a/source/unres/src-HCD-5D/boxshift.f +++ b/source/unres/src-HCD-5D/boxshift.f @@ -72,11 +72,17 @@ c-------------------------------------------------------------------------- subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi) implicit none include 'DIMENSIONS' + include 'COMMON.IOUNITS' include 'COMMON.CHAIN' double precision xi,yi,zi,sslipi,ssgradlipi double precision fracinbuf double precision sscalelip,sscagradlip - +#define DEBUG +#ifdef DEBUG + write (iout,*) "bordlipbot",bordlipbot," bordliptop",bordliptop + write (iout,*) "buflipbot",buflipbot," lipbufthick",lipbufthick + write (iout,*) "xi yi zi",xi,yi,zi +#endif if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then C the energy transfer exist if (zi.lt.buflipbot) then @@ -97,5 +103,9 @@ C lipbufthick is thickenes of lipid buffore sslipi=0.0d0 ssgradlipi=0.0 endif +#ifdef DEBUG + write (iout,*) "sslipi",sslipi," ssgradlipi",ssgradlipi +#endif +#undef DEBUG return end diff --git a/source/unres/src-HCD-5D/chain_symmetry.F b/source/unres/src-HCD-5D/chain_symmetry.F index 1406d1d..8c36855 100644 --- a/source/unres/src-HCD-5D/chain_symmetry.F +++ b/source/unres/src-HCD-5D/chain_symmetry.F @@ -7,6 +7,7 @@ c implicit none include "DIMENSIONS" include "COMMON.IOUNITS" + include "COMMON.CONTROL" integer nchain,nres,itype(nres),chain_border(2,maxchain), & chain_length(nchain),itemp(maxchain), & npermchain,tabpermchain(maxchain,maxperm), @@ -42,6 +43,7 @@ c nchain_group=nchain_group+1 iieq=1 iequiv(iieq,nchain_group)=i + if (symetr.eq.1) then do j=i+1,nchain if (iflag(j).gt.0.or.chain_length(i).ne.chain_length(j)) cycle c k=0 @@ -57,6 +59,7 @@ c k=k+1 iieq=iieq+1 iequiv(iieq,nchain_group)=j enddo + endif nequiv(nchain_group)=iieq enddo write(iout,*) "Number of equivalent chain groups:",nchain_group diff --git a/source/unres/src-HCD-5D/dfa.F b/source/unres/src-HCD-5D/dfa.F index 3982b6d..1af0b44 100644 --- a/source/unres/src-HCD-5D/dfa.F +++ b/source/unres/src-HCD-5D/dfa.F @@ -368,6 +368,7 @@ C END OF BETA RESTRAINT edfadis=0 gdfad=0.0d0 +c write (2,*) "edfad",idfadis_start,idfadis_end do i=idfadis_start,idfadis_end iatm1=idislis(1,i)+ishiftca diff --git a/source/unres/src-HCD-5D/energy_p_new_barrier.F b/source/unres/src-HCD-5D/energy_p_new_barrier.F index 6d5b25f..6d6a817 100644 --- a/source/unres/src-HCD-5D/energy_p_new_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new_barrier.F @@ -2044,7 +2044,8 @@ c write(iout,*) "PO ZWYKLE", 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 do k=j+1,iend(i,iint) + do k=j+1,nct C search over all next residues if (dyn_ss_mask(k)) then C check if they are cysteins diff --git a/source/unres/src-HCD-5D/readpdb-mult.F b/source/unres/src-HCD-5D/readpdb-mult.F index 76cb6b6..41fe7f6 100644 --- a/source/unres/src-HCD-5D/readpdb-mult.F +++ b/source/unres/src-HCD-5D/readpdb-mult.F @@ -64,9 +64,9 @@ c call flush(iout) iterter(ires_old-1)=1 itype(ires_old)=ntyp1 iterter(ires_old)=1 -c ishift1=ishift1+1 + ishift1=ishift1+1 ibeg=2 - write (iout,*) "Chain ended",ires,ishift,ires_old,ibeg + write (iout,*) "Chain ended",ires,ishift,ires_old if (unres_pdb) then do j=1,3 dc(j,ires)=sccor(j,iii) @@ -95,8 +95,8 @@ c write (iout,*) "! ",atom," !",ires read (card(18:20),'(a3)') res c write (iout,*) "ires",ires,ires-ishift+ishift1, c & " ires_old",ires_old -c write (iout,*) "ishift",ishift," ishift1",ishift1 -c write (iout,*) "IRES",ires-ishift+ishift1,ires_old +c write (iout,*) "ishift",ishift," ishift1",ishift1 +c write (iout,*) "IRES",ires-ishift+ishift1,ires_old if (ires-ishift+ishift1.ne.ires_old) then ! Calculate the CM of the preceding residue. ! if (ibeg.eq.0) call sccenter(ires,iii,sccor) @@ -115,7 +115,6 @@ c write (iout,'(i5,3f10.5)') ires,(sccor(j,iii),j=1,3) sccalc=.true. endif ! Start new residue. -c write (iout,*) "ibeg",ibeg if (res.eq.'Cl-' .or. res.eq.'Na+') then ires=ires_old cycle @@ -134,13 +133,10 @@ c write (iout,*) "BEG ires",ires else if (ibeg.eq.2) then ! Start a new chain ishift=-ires_old+ires-1 !!!!! -c ishift1=ishift1-1 !!!!! -c write (iout,*) "New chain started",ires,ires_old,ishift, -c & ishift1 + ishift1=ishift1-1 !!!!! +c write (iout,*) "New chain started",ires,ishift,ishift1,"!" ires=ires-ishift+ishift1 - write (iout,*) "New chain started ires",ires ires_old=ires -c ires=ires_old+1 ibeg=0 else ishift=ishift-(ires-ishift+ishift1-ires_old-1) @@ -163,8 +159,7 @@ c write (2,*) "ires",ires," res ",res!," ity"!,ity if (atom.eq.'CA' .or. atom.eq.'CH3' .or. & res.eq.'NHE'.and.atom(:2).eq.'HN') then read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) -c write (iout,*) "backbone ",atom -c write (iout,*) ires,res,(c(j,ires),j=1,3) +! write (iout,*) "backbone ",atom #ifdef DEBUG write (iout,'(i6,i3,2x,a,3f8.3)') & ires,itype(ires),res,(c(j,ires),j=1,3) @@ -234,7 +229,7 @@ C 2/15/2013 by Adam: corrected insertion of the first dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,i)=c(j,i+1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + c(j,i)=c(j,i+1)-1.9d0*e2(j) enddo else !unres_pdb do j=1,3 @@ -417,9 +412,8 @@ C and convert the peptide geometry into virtual-chain geometry. character*3 seq,res character*5 atom character*80 card - double precision sccor(3,50) + double precision sccor(3,20) integer rescode,iterter(maxres) - logical zero do i=1,maxres iterter(i)=0 enddo @@ -587,7 +581,7 @@ C 2/15/2013 by Adam: corrected insertion of the first dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,i)=c(j,i+1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + c(j,i)=c(j,i+1)-1.9d0*e2(j) enddo else !unres_pdb do j=1,3 @@ -622,7 +616,7 @@ C 2/15/2013 by Adam: corrected insertion of the last dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,nres)=c(j,nres-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) + c(j,nres)=c(j,nres-1)-1.9d0*e2(j) enddo else do j=1,3 @@ -654,7 +648,7 @@ C 2/15/2013 by Adam: corrected insertion of the first dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,1)=c(j,2)+1.9d0*(e1(j)-e2(j))/dsqrt(2.0d0) + c(j,1)=c(j,2)-1.9d0*e2(j) enddo else do j=1,3 @@ -682,18 +676,6 @@ C Calculate internal coordinates. & (c(j,ires+nres),j=1,3) enddo endif - zero=.false. - do ires=1,nres - zero=zero.or.itype(ires).eq.0 - enddo - if (zero) then - write (iout,'(2a)') "Gaps in PDB coordinates detected;", - & " look for ZERO in the control output above." - write (iout,'(2a)') "Repair the PDB file using MODELLER", - & " or other softwared and resubmit." - call flush(iout) - stop - endif C Calculate internal coordinates. call int_from_cart(.true.,out_template_coord) call sc_loc_geom(.false.) @@ -701,7 +683,6 @@ C Calculate internal coordinates. thetaref(i)=theta(i) phiref(i)=phi(i) enddo - dc(:,0)=c(:,1) do i=1,nres-1 do j=1,3 dc(j,i)=c(j,i+1)-c(j,i) diff --git a/source/unres/src-HCD-5D/readrtns_CSA.F b/source/unres/src-HCD-5D/readrtns_CSA.F index eeaf74c..4fbc0f1 100644 --- a/source/unres/src-HCD-5D/readrtns_CSA.F +++ b/source/unres/src-HCD-5D/readrtns_CSA.F @@ -741,7 +741,7 @@ C integer ilen external ilen integer iperm,tperm - integer i,j,ii,k,l,itrial,itmp,i1,i2,it1,it2,nres_temp + integer i,j,ii,k,l,itrial,itmp,i1,i2,it1,it2,nres_temp,itemp double precision sumv C C Read PDB structure if applicable @@ -1184,8 +1184,7 @@ c write (iout,*) "After read_dist_constr nhpb",nhpb 335 continue unres_pdb=.false. nres_temp=nres -c call readpdb - call readpdb_template(nmodel_start+1) + call readpdb close(ipdbin) if (nres.ge.nres_temp) then nmodel_start=nmodel_start+1 @@ -1196,11 +1195,22 @@ c call readpdb enddo enddo else - if (me.eq.king .or. .not. out1file) +c itemp=nres +c nres=nres_temp +c call gen_rand_conf(itemp,*115) +c nmodel_start=nmodel_start+1 +c do i=1,2*nres +c do j=1,3 +c chomo(j,i,nmodel_start)=c(j,i) +c enddo +c enddo +c goto 116 + 115 if (me.eq.king .or. .not. out1file) & write (iout,'(a,2i5,1x,a)') & "Different number of residues",nres_temp,nres, & " model skipped." endif + 116 continue nres=nres_temp enddo 332 continue diff --git a/source/unres/src-HCD-5D/ssMD.F b/source/unres/src-HCD-5D/ssMD.F index 26807a0..67e9f10 100644 --- a/source/unres/src-HCD-5D/ssMD.F +++ b/source/unres/src-HCD-5D/ssMD.F @@ -100,6 +100,7 @@ C----------------------------------------------------------------------------- include 'COMMON.IOUNITS' include 'COMMON.CALC' include 'COMMON.NAMES' + include 'COMMON.SPLITELE' #ifndef CLUST #ifndef WHAM include 'COMMON.MD' @@ -153,6 +154,8 @@ c-------END TESTING CODE j=resj ici=icys(i) icj=icys(j) +c write (iout,*) "dyn_ssbond",resi,resj,ici,icj +c call flush(iout) if (ici.eq.0 .or. icj.eq.0) then #ifdef MPI write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') @@ -177,6 +180,8 @@ c-------END TESTING CODE yi=c(2,nres+i) zi=c(3,nres+i) call to_box(xi,yi,zi) +c write (iout,*) "After to_box i",xi,yi,zi +c call flush(iout) C define scaling factor for lipids C if (positi.le.0) positi=positi+boxzsize @@ -184,12 +189,18 @@ C print *,i C first for peptide groups c for each residue check if it is in lipid or lipid water border area call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) +c write (iout,*) "After lipid_layer" +c call flush(iout) itypj=itype(j) xj=c(1,nres+j) yj=c(2,nres+j) zj=c(3,nres+j) call to_box(xj,yj,zj) +c write (iout,*) "After to_box j",xj,yj,zj +c call flush(iout) call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +c write (iout,*) "After lipid_layer" +c call flush(iout) 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 @@ -197,6 +208,8 @@ c for each residue check if it is in lipid or lipid water border area xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) +c write (iout,*) "After boxshift" +c call flush(iout) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -214,8 +227,8 @@ c for each residue check if it is in lipid or lipid water border area rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse - sss=sscale((1.0d0/rij)/sigma(itypi,itypj)) - sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj)) + sss=sscale((1.0d0/rij)/sigma(itypi,itypj),r_cut_int) + sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj),r_cut_int) c The following are set in sc_angular c erij(1)=xj*rij c erij(2)=yj*rij @@ -223,7 +236,11 @@ 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 +c write (iout,*) "Calling sc_angular" +c call flush(iout) call sc_angular +c write (iout,*) "After sc_angular" +c call flush(iout) rij=1.0D0/rij ! Reset this so it makes sense sig0ij=sigma(itypi,itypj) @@ -265,6 +282,8 @@ c-------END TESTING CODE c-------TESTING CODE c Stop and plot energy and derivative as a function of distance +c write (iout,*) "checkstop",checkstop +c call flush(iout) if (checkstop) then ssm=ssC-0.25D0*ssB*ssB/ssA ljm=-0.25D0*ljB*bb/aa @@ -447,6 +466,8 @@ c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE endif +c write (iout,*) "havebond",havebond +c call flush(iout) if (havebond) then #ifndef CLUST #ifndef WHAM @@ -509,8 +530,8 @@ cgrad enddo cgrad enddo do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(k) - gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(k) + gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l) + gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l) enddo return diff --git a/source/wham/src-HCD/bxread.F b/source/wham/src-HCD/bxread.F index c459499..a85bff4 100644 --- a/source/wham/src-HCD/bxread.F +++ b/source/wham/src-HCD/bxread.F @@ -20,7 +20,7 @@ include "COMMON.FREE" include "COMMON.SBRIDGE" real*4 csingle(3,maxres2) - character*64 nazwa,bprotfile_temp + character*256 nazwa,bprotfile_temp character*3 liczba integer i,is,ie,j,ii,jj,k,kk,l,ll,mm,if integer nrec,nlines,iscor,islice diff --git a/source/wham/src-HCD/cxread.F b/source/wham/src-HCD/cxread.F index 36ef6e6..46867c5 100644 --- a/source/wham/src-HCD/cxread.F +++ b/source/wham/src-HCD/cxread.F @@ -17,7 +17,7 @@ include 'COMMON.VAR' include 'COMMON.GEO' include 'COMMON.PROT' - character*64 nazwa,bprotfile_temp + character*256 nazwa,bprotfile_temp real*4 rtime,rpotE,ruconst,rt_bath,rprop(maxQ) double precision time integer iret,itmp,itraj,ntraj diff --git a/source/wham/src-HCD/enecalc1.F b/source/wham/src-HCD/enecalc1.F index 60addc7..b64de48 100644 --- a/source/wham/src-HCD/enecalc1.F +++ b/source/wham/src-HCD/enecalc1.F @@ -46,7 +46,7 @@ c double precision tole /1.0d-1/ double precision tt integer snk_p(MaxR,MaxT_h,Max_parm) logical lerr - character*64 bprotfile_temp + character*256 bprotfile_temp call opentmp(islice,ientout,bprotfile_temp) iii=0 ii=0 @@ -368,7 +368,7 @@ c------------------------------------------------------------------------------ include "COMMON.CONTACTS1" character*64 nazwa character*80 bxname,cxname - character*64 bprotfile_temp + character*256 bprotfile_temp character*3 liczba,licz character*2 licz2 integer i,itj,ii,iii,j,k,l diff --git a/source/wham/src-HCD/readrtns.F b/source/wham/src-HCD/readrtns.F index bca3771..c733c37 100644 --- a/source/wham/src-HCD/readrtns.F +++ b/source/wham/src-HCD/readrtns.F @@ -412,7 +412,7 @@ c------------------------------------------------------------------------------- include "COMMON.PROTFILES" include "COMMON.PROT" include "COMMON.FREE" - character*64 bprotfile_temp + character*256 bprotfile_temp character*3 liczba,liczba2 character*2 liczba1 integer iunit,islice @@ -472,7 +472,7 @@ c------------------------------------------------------------------------------- include "COMMON.SBRIDGE" include "COMMON.OBCINKA" real*4 csingle(3,maxres2) - character*64 nazwa,bprotfile_temp + character*256 nazwa,bprotfile_temp character*3 liczba character*2 liczba1 integer i,j,ii,jj(maxslice),k,kk(maxslice),l, diff --git a/source/wham/src-HCD/xread.F b/source/wham/src-HCD/xread.F index ac35de1..b397a6f 100644 --- a/source/wham/src-HCD/xread.F +++ b/source/wham/src-HCD/xread.F @@ -23,7 +23,7 @@ include "COMMON.SBRIDGE" include "COMMON.OBCINKA" real*4 csingle(3,maxres2) - character*64 nazwa,bprotfile_temp + character*256 nazwa,bprotfile_temp integer i,j,k,l,ii,jj(maxslice),kk(maxslice),ll(maxslice), & mm(maxslice) integer iscor,islice,islice1,slice -- 1.7.9.5 From d631f0741548037e5228c0fb29e1aaefb4e828e9 Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Tue, 16 Feb 2021 14:46:07 +0100 Subject: [PATCH 11/16] Adam's cluster wham update --- source/cluster/wham/src-HCD/COMMON.CHAIN | 2 +- source/cluster/wham/src-HCD/COMMON.DFA | 2 +- source/cluster/wham/src-HCD/COMMON.SHIELD | 9 +- source/cluster/wham/src-HCD/chain_symmetry.F | 3 + source/cluster/wham/src-HCD/energy_p_new.F | 2 + source/cluster/wham/src-HCD/geomout.F | 14 ++- source/cluster/wham/src-HCD/read_constr_homology.F | 4 +- source/cluster/wham/src-HCD/read_coords.F | 98 ++++++++++++-------- source/cluster/wham/src-HCD/readrtns.F | 1 + source/cluster/wham/src-HCD/ssMD.F | 6 +- source/cluster/wham/src-HCD/wrtclust.f | 26 +++++- 11 files changed, 114 insertions(+), 53 deletions(-) diff --git a/source/cluster/wham/src-HCD/COMMON.CHAIN b/source/cluster/wham/src-HCD/COMMON.CHAIN index 2b481a5..a17e113 100644 --- a/source/cluster/wham/src-HCD/COMMON.CHAIN +++ b/source/cluster/wham/src-HCD/COMMON.CHAIN @@ -3,7 +3,7 @@ & tabpermchain,ishift_pdb,iz_sc,nres_chomo double precision c,cref,crefjlee,cref_pdb,dc,xloc,xrot,dc_norm, & t,r,prod,rt,chomo - common /chain/ c(3,maxres2+2),dc(3,maxres2),xloc(3,maxres), + common /chain/ c(3,maxres2+2),dc(3,0: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) diff --git a/source/cluster/wham/src-HCD/COMMON.DFA b/source/cluster/wham/src-HCD/COMMON.DFA index 064a7ce..782e8c4 100644 --- a/source/cluster/wham/src-HCD/COMMON.DFA +++ b/source/cluster/wham/src-HCD/COMMON.DFA @@ -11,7 +11,7 @@ C Total : ~ 11 * Nres restraints C C INTEGER IDFAMAX,IDFAMX2,IDFACMD,IDMAXMIN, MAXN - PARAMETER(IDFAMAX=10000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) + PARAMETER(IDFAMAX=25000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) PARAMETER(MAXN=4) real*8 wwdist,wwangle,wwnei parameter(wwdist=1.0d0,wwangle=1.0d0,wwnei=1.0d0) diff --git a/source/cluster/wham/src-HCD/COMMON.SHIELD b/source/cluster/wham/src-HCD/COMMON.SHIELD index 1f96c94..8d89f0b 100644 --- a/source/cluster/wham/src-HCD/COMMON.SHIELD +++ b/source/cluster/wham/src-HCD/COMMON.SHIELD @@ -5,10 +5,11 @@ common /shield/ VSolvSphere,VSolvSphere_div,buff_shield, & long_r_sidechain(ntyp), & short_r_sidechain(ntyp),fac_shield(maxres),wshield, - & grad_shield_side(3,maxcont,-1:maxres),grad_shield(3,-1:maxres), - & grad_shield_loc(3,maxcont,-1:maxres), - & ishield_list(maxres),shield_list(maxcont,maxres), - & ees0plist(maxcont,maxres) + & grad_shield_side(3,maxint_res,-1:maxres), + & grad_shield(3,-1:maxres), + & grad_shield_loc(3,maxint_res,-1:maxres), + & ishield_list(maxres),shield_list(maxint_res,maxres), + & ees0plist(maxint_res,maxres) diff --git a/source/cluster/wham/src-HCD/chain_symmetry.F b/source/cluster/wham/src-HCD/chain_symmetry.F index 1406d1d..8c36855 100644 --- a/source/cluster/wham/src-HCD/chain_symmetry.F +++ b/source/cluster/wham/src-HCD/chain_symmetry.F @@ -7,6 +7,7 @@ c implicit none include "DIMENSIONS" include "COMMON.IOUNITS" + include "COMMON.CONTROL" integer nchain,nres,itype(nres),chain_border(2,maxchain), & chain_length(nchain),itemp(maxchain), & npermchain,tabpermchain(maxchain,maxperm), @@ -42,6 +43,7 @@ c nchain_group=nchain_group+1 iieq=1 iequiv(iieq,nchain_group)=i + if (symetr.eq.1) then do j=i+1,nchain if (iflag(j).gt.0.or.chain_length(i).ne.chain_length(j)) cycle c k=0 @@ -57,6 +59,7 @@ c k=k+1 iieq=iieq+1 iequiv(iieq,nchain_group)=j enddo + endif nequiv(nchain_group)=iieq enddo write(iout,*) "Number of equivalent chain groups:",nchain_group diff --git a/source/cluster/wham/src-HCD/energy_p_new.F b/source/cluster/wham/src-HCD/energy_p_new.F index 4fa79c5..e969ea3 100644 --- a/source/cluster/wham/src-HCD/energy_p_new.F +++ b/source/cluster/wham/src-HCD/energy_p_new.F @@ -3544,6 +3544,8 @@ C Third- and fourth-order contributions from turns common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 + double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij + common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij j=i+3 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C diff --git a/source/cluster/wham/src-HCD/geomout.F b/source/cluster/wham/src-HCD/geomout.F index be43686..d513764 100644 --- a/source/cluster/wham/src-HCD/geomout.F +++ b/source/cluster/wham/src-HCD/geomout.F @@ -10,10 +10,22 @@ include 'COMMON.SBRIDGE' include 'COMMON.TEMPFAC' character*50 tytul - character*1 chainid(10) /'A','B','C','D','E','F','G','H','I','J'/ dimension ica(maxres) + character*1 chainid(32) /'A','B','C','D','E','F','G','H','I','J', + & 'K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z', + & '1','2','3','4','5','6'/ write (ipdb,'(3a,1pe15.5,a,0pf7.2)') 'REMARK ',tytul(:20), & ' ENERGY ',etot,' RMS ',rmsd + do i=1,nss + ici=ireschain(ihpb(i)-nres) + icj=ireschain(jhpb(i)-nres) + iri=ihpb(i)-chain_border(1,ici)+1-nres + irj=jhpb(i)-chain_border(1,icj)+1-nres +c write (iout,*) ihpb(i),ici,iri,jhpb(i),icj,irj + write(ipdb,'(a6,i4,1x,a3,1x,a1,i5,4x,a3,1x,a1,i5,38x,f5.2)') + & 'SSBOND',i,'CYS',chainid(ici),iri,'CYS',chainid(icj),irj, + & dist(ihpb(i),jhpb(i)) + enddo iatom=0 ichain=1 ires=0 diff --git a/source/cluster/wham/src-HCD/read_constr_homology.F b/source/cluster/wham/src-HCD/read_constr_homology.F index 0b265fa..f2fb1d0 100644 --- a/source/cluster/wham/src-HCD/read_constr_homology.F +++ b/source/cluster/wham/src-HCD/read_constr_homology.F @@ -257,8 +257,8 @@ c & constr_homology endif sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii)) else - ii=ii+1 - l_homo(k,ii)=.false. +c ii=ii+1 +c l_homo(k,ii)=.false. endif enddo enddo diff --git a/source/cluster/wham/src-HCD/read_coords.F b/source/cluster/wham/src-HCD/read_coords.F index facbc27..20abce5 100644 --- a/source/cluster/wham/src-HCD/read_coords.F +++ b/source/cluster/wham/src-HCD/read_coords.F @@ -49,8 +49,8 @@ c Set the scratchfile names #endif c 1/27/05 AL Change stored coordinates to single precision and don't store c energy components in the binary databases. - lenrec=12*(nres+nct-nnt+1)+4*(2*nss+2)+16 - lenrec_in=12*(nres+nct-nnt+1)+4*(2*nss+2)+24 + lenrec=12*(nres+nct-nnt+1)+4*(ns+2)+16 + lenrec_in=12*(nres+nct-nnt+1)+4*(ns+2)+24 #ifdef DEBUG write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss", nss write (iout,*) "lenrec_in",lenrec_in @@ -217,19 +217,28 @@ c call flush(iout) if (iret.eq.0) goto 101 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 + if (dyn_ss) then + do k=1,nss + call xdrfint(ixdrf, idssb(k), iret) + call xdrfint(ixdrf, jdssb(k), iret) + ihpb(k)=iss(idssb(k)-nres)+nres + jhpb(k)=iss(jdssb(k)-nres)+nres +#ifdef DEBUG + write (iout,*) "jj",jj+1," dyn_ss:",idssb(k)-nres, + & jdssb(k)-nres,ihpb(k),jhpb(k) +#endif + enddo + else + do k=1,nss + call xdrfint(ixdrf, ihpb(k), iret) + if (iret.eq.0) goto 101 + call xdrfint(ixdrf, jhpb(k), iret) + if (iret.eq.0) goto 101 +#ifdef DEBUG + write (iout,*) "jj",jj+1," stat_ss:",ihpb(k),jhpb(k) +#endif + enddo + endif call xdrffloat_(ixdrf,reini,iret) if (iret.eq.0) goto 101 call xdrffloat_(ixdrf,refree,iret) @@ -249,17 +258,28 @@ c write (iout,*) "iret",iret c write (iout,*) "nss",nss 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) + if (dyn_ss) then + do k=1,nss + call xdrfint(ixdrf, idssb(k), iret) + call xdrfint(ixdrf, jdssb(k), iret) + ihpb(k)=iss(idssb(k)-nres)+nres + jhpb(k)=iss(jdssb(k)-nres)+nres +#ifdef DEBUG + write (iout,*) "jj",jj+1," dyn_ss:",idssb(k)-nres, + & jdssb(k)-nres,ihpb(k),jhpb(k) +#endif + enddo 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 + do k=1,nss + call xdrfint(ixdrf, ihpb(k), iret) + if (iret.eq.0) goto 101 + call xdrfint(ixdrf, jhpb(k), iret) + if (iret.eq.0) goto 101 +#ifdef DEBUG + write (iout,*) "jj",jj+1," stat_ss:",ihpb(k),jhpb(k) +#endif + enddo endif - enddo call xdrffloat(ixdrf,reini,iret) if (iret.eq.0) goto 101 call xdrffloat(ixdrf,refree,iret) @@ -391,10 +411,9 @@ c------------------------------------------------------------------------------ include "COMMON.SBRIDGE" include "COMMON.GEO" integer i,j,jj,jjj,jj_old,icount,k,kk,l,ii,ib - & nn,nn1,inan,Next,itj,chalen + & nn,nn1,inan,Next,itj double precision etot,energia(0:max_ene) jjj=jjj+1 - 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) @@ -402,8 +421,7 @@ c------------------------------------------------------------------------------ if (j.gt.2) then if (itel(j).ne.0 .and. itel(j-1).ne.0) then write (iout,*) "Conformation",jjj,jj+1 - write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),itel(j), - & chalen + write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),itel(j) write (iout,*) "The Cartesian geometry is:" 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) @@ -671,17 +689,17 @@ C#define DEBUG 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 if (dyn_ss) then +c read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), +c & ((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 +c & entfac(ii),rmstb(ii) +c 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 +c endif #ifdef DEBUG write (iout,*) ii,iii,ij,entfac(ii) write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres) @@ -738,17 +756,17 @@ 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 if (dyn_ss) then +c write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), +c & ((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 +c & entfac(ii),rmstb(ii) +c 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 +c 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, diff --git a/source/cluster/wham/src-HCD/readrtns.F b/source/cluster/wham/src-HCD/readrtns.F index e9e576f..2cd4ee1 100644 --- a/source/cluster/wham/src-HCD/readrtns.F +++ b/source/cluster/wham/src-HCD/readrtns.F @@ -27,6 +27,7 @@ C read (INP,'(a80)') titel call card_concat(controlcard) + dyn_ss = index(controlcard,"DYN_SS").gt.0 energy_dec=(index(controlcard,'ENERGY_DEC').gt.0) unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0 call readi(controlcard,'TORMODE',tor_mode,0) diff --git a/source/cluster/wham/src-HCD/ssMD.F b/source/cluster/wham/src-HCD/ssMD.F index 9b2908f..a62f7be 100644 --- a/source/cluster/wham/src-HCD/ssMD.F +++ b/source/cluster/wham/src-HCD/ssMD.F @@ -496,8 +496,8 @@ cgrad enddo cgrad enddo do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(k) - gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(k) + gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l) + gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l) enddo return @@ -571,7 +571,7 @@ c Local variables logical found integer i_newnss(1024),displ(0:1024) integer g_newihpb(maxdim_cont),g_newjhpb(maxdim_cont),g_newnss - + nfgtasks=1 allnss=0 do i=1,ns-1 do j=i+1,ns diff --git a/source/cluster/wham/src-HCD/wrtclust.f b/source/cluster/wham/src-HCD/wrtclust.f index e21494a..0415640 100644 --- a/source/cluster/wham/src-HCD/wrtclust.f +++ b/source/cluster/wham/src-HCD/wrtclust.f @@ -189,7 +189,7 @@ c create InsightII command file for their displaying in different colors c write (iout,*) "cfname",cfname OPEN(ipdb,FILE=CFNAME,STATUS='UNKNOWN',FORM='FORMATTED') write (ipdb,'(a,f8.2)') - & "REMAR AVERAGE CONFORMATIONS AT TEMPERATURE",temper + & "REMARK AVERAGE CONFORMATIONS AT TEMPERATURE",temper close (ipdb) I=1 ICON=NCONF(1,1) @@ -227,6 +227,13 @@ c write (iout,*) "ncon_out",ncon_out c(k,ii)=allcart(k,ii,icon) enddo enddo + nss=nss_all(icon) + write (iout,*) "ICON",icon," nss",nss + do k=1,nss + ihpb(k)=ihpb_all(k,icon) + jhpb(k)=jhpb_all(k,icon) + write (iout,*) ihpb(k),jhpb(k) + enddo call center call pdbout(totfree(icon)/beta_h(ib),rmstb(icon),titel) write (ipdb,'("TER")') @@ -240,6 +247,7 @@ c Average structures and structures closest to average call ave_coord(i) write (ipdb,'(a,i5)') "REMARK CLUSTER",i call center + nss=0 call pdbout(totfree_gr(i)/beta_h(ib),rmsave(i),titel) write (ipdb,'("TER")') if (print_fittest.and.(nsaxs.gt.0 .or. nhpb.gt.0 @@ -530,6 +538,7 @@ c------------------------------------------------------------------------------ include 'COMMON.CLUSTER' include 'COMMON.CHAIN' include 'COMMON.INTERACT' + include 'COMMON.SBRIDGE' include 'COMMON.VAR' include 'COMMON.FFIELD' include 'COMMON.TORCNSTR' @@ -570,6 +579,11 @@ c & " Edihcnstr",edihcnstr c(j,i)=allcart(j,i,jconmin) enddo enddo + nss=nss_all(jconmin) + do k=1,nss + ihpb(k)=ihpb_all(k,jconmin) + jhpb(k)=jhpb_all(k,jconmin) + enddo return end c------------------------------------------------------------------------------ @@ -583,6 +597,7 @@ c------------------------------------------------------------------------------ include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.VAR' + include 'COMMON.SBRIDGE' logical non_conv double precision przes(3),obrot(3,3) integer i,ii,j,k,icon,jcon,jconmin,igr,ipermmin @@ -616,6 +631,15 @@ c write (iout,*) "rmsmin",rmsmin," rms",rms c(j,i)=allcart(j,i,jconmin) enddo enddo + nss=nss_all(jconmin) +c write (iout,*) "jconmin",jconmin," nss",nss + call flush(iout) + do k=1,nss + ihpb(k)=ihpb_all(k,jconmin) + jhpb(k)=jhpb_all(k,jconmin) +c write (iout,*) "k",k," ihpb",ihpb(k)," jhpb",jhpb(k) + enddo + call flush(iout) return end c------------------------------------------------------------------------------ -- 1.7.9.5 From 03ac44644b8a2c0bc8f10aeddd4f292c3b2d2e6e Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Tue, 16 Feb 2021 14:54:17 +0100 Subject: [PATCH 12/16] Adam's wham update --- source/wham/src-HCD/COMMON.CHAIN | 2 +- source/wham/src-HCD/COMMON.DFA | 2 +- source/wham/src-HCD/COMMON.ENERGIES | 2 +- source/wham/src-HCD/DIMENSIONS | 4 +- source/wham/src-HCD/DIMENSIONS.FREE | 2 +- source/wham/src-HCD/chain_symmetry.F | 3 ++ source/wham/src-HCD/cxread.F | 2 +- source/wham/src-HCD/elecont.f | 63 +++++----------------- source/wham/src-HCD/enecalc1.F | 52 ++++++++++++++++-- source/wham/src-HCD/energy_p_new.F | 5 +- source/wham/src-HCD/geomout.F | 26 ++++----- source/wham/src-HCD/include_unres/COMMON.SBRIDGE | 3 +- source/wham/src-HCD/include_unres/COMMON.SETUP | 4 +- source/wham/src-HCD/initialize_p.F | 2 + source/wham/src-HCD/make_ensemble1.F | 2 +- source/wham/src-HCD/read_constr_homology.F | 4 +- source/wham/src-HCD/secondary.f | 6 +-- source/wham/src-HCD/ssMD.F | 15 ++++-- source/wham/src-HCD/wham_calc1.F | 18 +++---- 19 files changed, 120 insertions(+), 97 deletions(-) diff --git a/source/wham/src-HCD/COMMON.CHAIN b/source/wham/src-HCD/COMMON.CHAIN index 7b79a58..6b453af 100644 --- a/source/wham/src-HCD/COMMON.CHAIN +++ b/source/wham/src-HCD/COMMON.CHAIN @@ -3,7 +3,7 @@ & tabpermchain,nchain ,npermchain,ireschain,iz_sc,nres_chomo double precision c,cref,crefjlee,dc,xloc,xrot,dc_norm,t,r,prod,rt, & rmssing,anatemp,chomo - common /chain/ c(3,maxres2+2),dc(3,maxres2),xloc(3,maxres), + common /chain/ c(3,maxres2+2),dc(3,0: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) diff --git a/source/wham/src-HCD/COMMON.DFA b/source/wham/src-HCD/COMMON.DFA index 064a7ce..782e8c4 100644 --- a/source/wham/src-HCD/COMMON.DFA +++ b/source/wham/src-HCD/COMMON.DFA @@ -11,7 +11,7 @@ C Total : ~ 11 * Nres restraints C C INTEGER IDFAMAX,IDFAMX2,IDFACMD,IDMAXMIN, MAXN - PARAMETER(IDFAMAX=10000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) + PARAMETER(IDFAMAX=25000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) PARAMETER(MAXN=4) real*8 wwdist,wwangle,wwnei parameter(wwdist=1.0d0,wwangle=1.0d0,wwnei=1.0d0) diff --git a/source/wham/src-HCD/COMMON.ENERGIES b/source/wham/src-HCD/COMMON.ENERGIES index 2d40a95..e0ed696 100644 --- a/source/wham/src-HCD/COMMON.ENERGIES +++ b/source/wham/src-HCD/COMMON.ENERGIES @@ -1,4 +1,4 @@ double precision potE(MaxStr_Proc,Max_Parm),entfac(MaxStr_Proc), - & q(MaxQ+2,MaxStr_Proc),enetb(max_ene,MaxStr_Proc,Max_Parm) + & q(MaxQ+6,MaxStr_Proc),enetb(max_ene,MaxStr_Proc,Max_Parm) integer einicheck common /energies/ potE,entfac,q,enetb,einicheck diff --git a/source/wham/src-HCD/DIMENSIONS b/source/wham/src-HCD/DIMENSIONS index fb93081..49e50f5 100644 --- a/source/wham/src-HCD/DIMENSIONS +++ b/source/wham/src-HCD/DIMENSIONS @@ -14,8 +14,8 @@ c parameter (max_cg_procs=maxprocs) C Max. number of AA residues integer maxres c parameter (maxres=250) -c parameter (maxres=1200) - parameter (maxres=10000) + parameter (maxres=1200) +c parameter (maxres=20000) C Max. number of cysteines and other bridging residues integer max_cyst parameter (max_cyst=100) diff --git a/source/wham/src-HCD/DIMENSIONS.FREE b/source/wham/src-HCD/DIMENSIONS.FREE index 7a397d9..c42f2d7 100644 --- a/source/wham/src-HCD/DIMENSIONS.FREE +++ b/source/wham/src-HCD/DIMENSIONS.FREE @@ -3,7 +3,7 @@ integer MaxR,MaxT_h,maxHdim integer MaxSlice parameter (Max_Parm=5) - parameter (MaxQ=4,MaxQ1=MaxQ+2) + parameter (MaxQ=4,MaxQ1=MaxQ+6) parameter(MaxR=8,MaxT_h=36) parameter(MaxSlice=40) parameter(maxHdim=200) diff --git a/source/wham/src-HCD/chain_symmetry.F b/source/wham/src-HCD/chain_symmetry.F index 1406d1d..8c36855 100644 --- a/source/wham/src-HCD/chain_symmetry.F +++ b/source/wham/src-HCD/chain_symmetry.F @@ -7,6 +7,7 @@ c implicit none include "DIMENSIONS" include "COMMON.IOUNITS" + include "COMMON.CONTROL" integer nchain,nres,itype(nres),chain_border(2,maxchain), & chain_length(nchain),itemp(maxchain), & npermchain,tabpermchain(maxchain,maxperm), @@ -42,6 +43,7 @@ c nchain_group=nchain_group+1 iieq=1 iequiv(iieq,nchain_group)=i + if (symetr.eq.1) then do j=i+1,nchain if (iflag(j).gt.0.or.chain_length(i).ne.chain_length(j)) cycle c k=0 @@ -57,6 +59,7 @@ c k=k+1 iieq=iieq+1 iequiv(iieq,nchain_group)=j enddo + endif nequiv(nchain_group)=iieq enddo write(iout,*) "Number of equivalent chain groups:",nchain_group diff --git a/source/wham/src-HCD/cxread.F b/source/wham/src-HCD/cxread.F index 46867c5..2cfb938 100644 --- a/source/wham/src-HCD/cxread.F +++ b/source/wham/src-HCD/cxread.F @@ -174,7 +174,7 @@ c call flush(iout) c write (iout,*) "Before boxshift" c call flush(iout) c Box shift - call oligomer +c call oligomer c write (iout,*) "After oligomer" c call flush(iout) do i=1,nres diff --git a/source/wham/src-HCD/elecont.f b/source/wham/src-HCD/elecont.f index fb105a4..86db2df 100644 --- a/source/wham/src-HCD/elecont.f +++ b/source/wham/src-HCD/elecont.f @@ -18,10 +18,11 @@ & eesij,ees,evdw,ene, rij,zj_temp,xj_temp,yj_temp, & sscale,sscagrad,dist_temp,xj_safe,yj_safe,zj_safe,dist_init double precision elpp6c(2,2),elpp3c(2,2),ael6c(2,2),ael3c(2,2), - & appc(2,2),bppc(2,2) + & appc(2,2),bppc(2,2),epp_(2,2),rpp_(2,2) double precision elcutoff,elecutoff_14 integer ncont,icont(2,maxcont),xshift,yshift,zshift,isubchap double precision econt(maxcont) + double precision boxshift * * Load the constants of peptide bond - peptide bond interactions. * Type 1 - ordinary peptide bond, type 2 - alkylated peptide bond (e.g. @@ -29,8 +30,8 @@ * * as of 7/06/91. * -c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ -c data rpp / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ +c data epp_ / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ + data rpp_ / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ data elpp6c /-0.2379d0,-0.2056d0,-0.2056d0,-0.0610d0/ data elpp3c / 0.0503d0, 0.0000d0, 0.0000d0, 0.0692d0/ data elcutoff /-0.3d0/,elecutoff_14 /-0.5d0/ @@ -40,7 +41,7 @@ c data rpp / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ & "Constants of electrostatic interaction energy expression." do i=1,2 do j=1,2 - rri=rpp(i,j)**6 + rri=rpp_(i,j)**6 appc(i,j)=epp(i,j)*rri*rri bppc(i,j)=-2.0*epp(i,j)*rri ael6c(i,j)=elpp6c(i,j)*4.2**6 @@ -62,12 +63,8 @@ c data rpp / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ xmedi=xi+0.5*dxi ymedi=yi+0.5*dyi zmedi=zi+0.5*dzi - xmedi=mod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=mod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=mod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize + call to_box(xmedi,ymedi,zmedi) +c write (iout,*) "i",xmedi,ymedi,zmedi do 4 j=i+2,ien-1 jj=iperm(j,ipermmin) ind=ind+1 @@ -86,46 +83,13 @@ c data rpp / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ xj=c(1,jj)+0.5*dxj yj=c(2,jj)+0.5*dyj zj=c(3,jj)+0.5*dzj - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - isubchap=0 - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - isubchap=1 - endif - enddo - enddo - enddo - if (isubchap.eq.1) then - xj=xj_temp-xmedi - yj=yj_temp-ymedi - zj=zj_temp-zmedi - else - xj=xj_safe-xmedi - yj=yj_safe-ymedi - zj=zj_safe-zmedi - endif +c write (iout,*) "j",xj,yj,zj + call to_box(xj,yj,zj) + xj=boxshift(xj-xmedi,boxxsize) + yj=boxshift(yj-ymedi,boxysize) + zj=boxshift(zj-zmedi,boxzsize) +c write (iout,*) "j",xj,yj,zj rij=xj*xj+yj*yj+zj*zj - sss=sscale(sqrt(rij)) - sssgrad=sscagrad(sqrt(rij)) rrmij=1.0/(xj*xj+yj*yj+zj*zj) rmij=sqrt(rrmij) r3ij=rrmij*rmij @@ -152,6 +116,7 @@ c data rpp / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ endif ees=ees+eesij evdw=evdw+evdwij*sss +c write (iout,*) "i",i," j",j," rij",dsqrt(rij)," eesij",eesij 4 continue 1 continue if (lprint) then diff --git a/source/wham/src-HCD/enecalc1.F b/source/wham/src-HCD/enecalc1.F index b64de48..2edf349 100644 --- a/source/wham/src-HCD/enecalc1.F +++ b/source/wham/src-HCD/enecalc1.F @@ -46,13 +46,31 @@ c double precision tole /1.0d-1/ double precision tt integer snk_p(MaxR,MaxT_h,Max_parm) logical lerr + integer ncont,icont(2,maxcont),isecstr(maxres) character*256 bprotfile_temp + double precision totlength call opentmp(islice,ientout,bprotfile_temp) iii=0 ii=0 errmsg_count=0 c write (iout,*) "enecalc: nparmset ",nparmset c write (iout,*) "enecalc: tormode ",tor_mode + write (iout,*) "ns",ns," dyn_ss",dyn_ss,(iss(i),i=1,ns) + 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 + write (iout,*) "dyn_ss_mask",(dyn_ss_mask(i),i=1,nres) #ifdef MPI do iparm=1,nParmSet do ib=1,nT_h(iparm) @@ -94,7 +112,7 @@ c write (iout,*) "enecalc: tormode ",tor_mode anatemp= 1.0d0/(beta_h(ib,ipar)*1.987D-3) q(nQ+1,iii+1)=rmsnat(iii+1,ipermin) endif - q(nQ+2,iii+1)=gyrate(iii+1) +c write (iout,*) iii+1,q(nQ+3,iii+1),q(nQ+4,iii+1),q(nQ+5,iii+1) c fT=T0*beta_h(ib,ipar)*1.987D-3 c ft=2.0d0/(1.0d0+1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)) if (rescale_mode.eq.1) then @@ -158,9 +176,9 @@ c & " kfac",kfac,"quot",quot," fT",fT & wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc, & wtor_d,wsccor,wbond #endif -C write (iout,*) "tuz przed energia" +c write (iout,*) "tuz przed energia" call etotal(energia(0),fT) -C write (iout,*) "tuz za energia" +c write (iout,*) "tuz za energia" #ifdef DEBUG write (iout,*) "Conformation",i write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), @@ -215,8 +233,8 @@ c & eini-energia(0) write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), & ((c(l,k+nres),l=1,3),k=nnt,nct) c call intout - call pdbout(indstart(me1)+iii, - & 1.0d0/(1.987D-3*beta_h(ib,ipar)),energia(0),eini,0.0d0,0.0d0) +c call pdbout(indstart(me1)+iii, +c & 1.0d0/(1.987D-3*beta_h(ib,ipar)),energia(0),eini,0.0d0,0.0d0) call enerprint(energia(0),fT) errmsg_count=errmsg_count+1 if (errmsg_count.gt.maxerrmsg_count) @@ -260,6 +278,30 @@ c call enerprint(energia(0),fT) endif enddo ! iparm + q(nQ+2,iii+1)=gyrate(iii+1) +c 8/28/2020 Adam - determine the fraction of secondary structures. + call elecont(.false.,ncont,icont,nnt,nct-1,1) + call secondary2(.false.,.false.,ncont,icont,isecstr) +#ifdef DEBUG + write (iout,*) "secondary structure" + write (iout,'(80i1)') (isecstr(k),k=1,nres) +#endif + q(nQ+3,iii+1)=0.0d0 + q(nQ+4,iii+1)=0.0d0 + q(nQ+5,iii+1)=0.0d0 + totlength=0.0d0 + do k=nnt,nct + if (itype(k).eq.ntyp1) cycle + totlength=totlength+1.0d0 + l=isecstr(k) + q(nQ+3+l,iii+1)=q(nQ+3+l,iii+1)+1.0d0 + enddo + q(nQ+3,iii+1)=q(nQ+3,iii+1)/totlength + q(nQ+4,iii+1)=q(nQ+4,iii+1)/totlength + q(nQ+5,iii+1)=q(nQ+5,iii+1)/totlength +c write (iout,*) "iii",iii," nssbond",nssbond,nss +c q(nQ+6,iii+1)=nssbond + q(nQ+6,iii+1)=nss iii=iii+1 if (q(1,iii).le.0.0d0 .and. indpdb.gt.0) diff --git a/source/wham/src-HCD/energy_p_new.F b/source/wham/src-HCD/energy_p_new.F index e72d558..3a83918 100644 --- a/source/wham/src-HCD/energy_p_new.F +++ b/source/wham/src-HCD/energy_p_new.F @@ -56,7 +56,7 @@ C call set_shield_fac2 endif call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) -C write(iout,*) 'po eelec' +c write(iout,*) 'po eelec eello_turn4',eello_turn4 C Calculate excluded-volume interaction energy between peptide groups C and side chains. @@ -2273,6 +2273,7 @@ c write(iout,*) "JESTEM W PETLI" call eelecij(i,i+3,ees,evdw1,eel_loc) if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) & call eturn4(i,eello_turn4) +c write (iout,*) "i",i," eello_turn4",eello_turn4 #ifdef FOURBODY num_cont_hb(i)=num_conti #endif @@ -3581,6 +3582,8 @@ C Third- and fourth-order contributions from turns common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 + double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij + common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij j=i+3 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C diff --git a/source/wham/src-HCD/geomout.F b/source/wham/src-HCD/geomout.F index 097040f..ed33cc7 100644 --- a/source/wham/src-HCD/geomout.F +++ b/source/wham/src-HCD/geomout.F @@ -9,7 +9,9 @@ include 'COMMON.HEADER' include 'COMMON.SBRIDGE' character*50 tytul - character*1 chainid(10) /'A','B','C','D','E','F','G','H','I','J'/ + character*1 chainid(32) /'A','B','C','D','E','F','G','H','I','J', + & 'K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z', + & '1','2','3','4','5','6'/ dimension ica(maxres) write(ipdb,'("REMARK CONF",i8," TEMPERATURE",f7.1," RMS",0pf7.2)') & ii,temp,rmsdev @@ -20,24 +22,28 @@ iatom=0 ichain=1 ires=0 + iti_prev=0 do i=nnt,nct iti=itype(i) if (iti.eq.ntyp1) then - ichain=ichain+1 ires=0 - write (ipdb,'(a)') 'TER' + if (iti_prev.ne.ntyp1) then + write (ipdb,'(a)') 'TER' + ichain=ichain+1 + endif else ires=ires+1 iatom=iatom+1 ica(i)=iatom write (ipdb,10) iatom,restyp(iti),chainid(ichain), - & ires,(c(j,i),j=1,3) + & ires,(c(j,i),j=1,3),1.0d0 if (iti.ne.10) then iatom=iatom+1 write (ipdb,20) iatom,restyp(iti),chainid(ichain), - & ires,(c(j,nres+i),j=1,3) + & ires,(c(j,nres+i),j=1,3),1.0d0 endif endif + iti_prev=iti enddo write (ipdb,'(a)') 'TER' do i=nnt,nct-1 @@ -54,15 +60,11 @@ write (ipdb,30) ica(nct),ica(nct)+1 endif do i=1,nss - if (dyn_ss) then - write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1 - else - write (ipdb,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 - endif + write (ipdb,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 enddo write (ipdb,'(a6)') 'ENDMDL' - 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3) - 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,f15.3) + 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,2f6.2) + 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,2f6.2) 30 FORMAT ('CONECT',8I5) return end diff --git a/source/wham/src-HCD/include_unres/COMMON.SBRIDGE b/source/wham/src-HCD/include_unres/COMMON.SBRIDGE index a313d8f..d2a41e1 100644 --- a/source/wham/src-HCD/include_unres/COMMON.SBRIDGE +++ b/source/wham/src-HCD/include_unres/COMMON.SBRIDGE @@ -24,8 +24,9 @@ & link_end_peak double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss logical dyn_ss,dyn_ss_mask + integer nssbond common /dyn_ssbond/ dtriss,atriss,btriss,ctriss,Ht, & dyn_ssbond_ij(max_cyst,max_cyst), - & idssb(maxss),jdssb(maxss) + & idssb(maxss),jdssb(maxss),nssbond common /dyn_ss_logic/ & dyn_ss,dyn_ss_mask(maxres) diff --git a/source/wham/src-HCD/include_unres/COMMON.SETUP b/source/wham/src-HCD/include_unres/COMMON.SETUP index 5039116..1edc7c3 100644 --- a/source/wham/src-HCD/include_unres/COMMON.SETUP +++ b/source/wham/src-HCD/include_unres/COMMON.SETUP @@ -1,14 +1,14 @@ 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, + & koniec(0:maxprocs-1),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, + & max_gs_size,kolor,koniec,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, diff --git a/source/wham/src-HCD/initialize_p.F b/source/wham/src-HCD/initialize_p.F index 8217663..0cf093a 100644 --- a/source/wham/src-HCD/initialize_p.F +++ b/source/wham/src-HCD/initialize_p.F @@ -22,6 +22,7 @@ C include "COMMON.NAMES" include "COMMON.TIME1" include "COMMON.TORCNSTR" + include "COMMON.SETUP" C C The following is just to define auxiliary variables used in angle conversion C @@ -237,6 +238,7 @@ C Set timers and counters for the respective routines n_viol = 0 n_gviol = 0 n_map = 0 + nfgtasks = 1 #ifndef SPLITELE nprint_ene=nprint_ene-1 #endif diff --git a/source/wham/src-HCD/make_ensemble1.F b/source/wham/src-HCD/make_ensemble1.F index a07dbeb..f18dd2b 100644 --- a/source/wham/src-HCD/make_ensemble1.F +++ b/source/wham/src-HCD/make_ensemble1.F @@ -371,7 +371,7 @@ c write (iout,*) "qfree",qfree & ctemper(:ilen(ctemper))//"pdb" endif open(ipdb,file=pdbname) - write (iout,*) "Before reading nlist",nlist +c write (iout,*) "Before reading nlist",nlist do i=1,nlist read (ientout,rec=iperm(i)) & ((csingle(l,k),l=1,3),k=1,nres), diff --git a/source/wham/src-HCD/read_constr_homology.F b/source/wham/src-HCD/read_constr_homology.F index fa81b80..03d7968 100644 --- a/source/wham/src-HCD/read_constr_homology.F +++ b/source/wham/src-HCD/read_constr_homology.F @@ -259,8 +259,8 @@ c & constr_homology endif sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii)) else - ii=ii+1 - l_homo(k,ii)=.false. +c ii=ii+1 +c l_homo(k,ii)=.false. endif enddo enddo diff --git a/source/wham/src-HCD/secondary.f b/source/wham/src-HCD/secondary.f index 4088831..d2e9271 100644 --- a/source/wham/src-HCD/secondary.f +++ b/source/wham/src-HCD/secondary.f @@ -401,8 +401,8 @@ cd write (iout,*) '------- looking for parallel beta -----------' do i=1,ncont i1=icont(1,i) j1=icont(2,i) - if (i1.ge.nstart_sup .and. i1.le.nend_sup - & .and. j1.gt.nstart_sup .and. j1.le.nend_sup) then +c if (i1.ge.nstart_sup .and. i1.le.nend_sup +c & .and. j1.gt.nstart_sup .and. j1.le.nend_sup) then cd write (iout,*) "parallel",i1,j1 if(j1-i1.gt.5 .and. freeres(i1,j1,nsec,isec)) then ii1=i1 @@ -469,7 +469,7 @@ cd write (iout,*) i1,j1,not_done & "SetNeigh",ii1-1,i1-1,jj1-1,j1-1 endif endif - endif +c endif endif ! i1.ge.nstart_sup .and. i1.le.nend_sup .and. i2.gt.nstart_sup .and. i2.le.nend_sup enddo diff --git a/source/wham/src-HCD/ssMD.F b/source/wham/src-HCD/ssMD.F index 4ce1b3d..d9b9df7 100644 --- a/source/wham/src-HCD/ssMD.F +++ b/source/wham/src-HCD/ssMD.F @@ -144,13 +144,13 @@ c-------TESTING CODE double precision echeck(-1:1),deps,ssx0,ljx0,xi,yi,zi c-------END TESTING CODE - + nssbond=0 i=resi j=resj ici=icys(i) icj=icys(j) if (ici.eq.0 .or. icj.eq.0) then - write (*,'(a,i5,2a,a3,i5,5h and ,a3,i5)') + write (iout,'(a,i5,2a,a3,i5,5h and ,a3,i5)') & "Attempt to create", & " a disulfide link between non-cysteine residues ",restyp(i),i, & restyp(j),j @@ -276,6 +276,8 @@ c Stop and plot energy and derivative as a function of distance & ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps c-------END TESTING CODE +c write (iout,'(2(a,i5),4(a,f7.2))') "resi",resi," resj",resj, +c & " ljxm",ljxm," ljxs",ljxs," ssxm",ssxm," rij",rij if (rij.gt.ljxm) then havebond=.false. ljd=rij-ljXs @@ -298,6 +300,8 @@ c-------END TESTING CODE & -2.0D0*alf12*eps3der+sigder*sigsq_om12 else if (rij.lt.ssxm) then havebond=.true. + nssbond=nssbond+1 +c write (iout,*) "ssMD: nssbond",nssbond ssd=rij-ssXs eij=ssA*ssd*ssd+ssB*ssd+ssC eij=eij*sss @@ -309,6 +313,7 @@ c-------END TESTING CODE eom2= 2*akth*deltat2+pom1-om1*pom2 eom12=pom2 else +c nssbond=nssbond+1 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi d_ssxm(1)=0.5D0*akct/ssA @@ -497,8 +502,8 @@ cgrad enddo cgrad enddo do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(k) - gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(k) + gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l) + gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l) enddo return @@ -556,7 +561,6 @@ c Includes include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' include 'COMMON.IOUNITS' -C include 'COMMON.SETUP' #ifndef CLUST #ifndef WHAM C include 'COMMON.MD' @@ -572,6 +576,7 @@ c Local variables logical found integer i_newnss(1024),displ(0:1024) integer g_newihpb(maxdim_cont),g_newjhpb(maxdim_cont),g_newnss + nfgtasks=1 allnss=0 do i=1,ns-1 diff --git a/source/wham/src-HCD/wham_calc1.F b/source/wham/src-HCD/wham_calc1.F index 7e4512d..2d1d661 100644 --- a/source/wham/src-HCD/wham_calc1.F +++ b/source/wham/src-HCD/wham_calc1.F @@ -639,7 +639,7 @@ c & " WHAM_COMM",WHAM_COMM sumE_p(i,iparm)=0.0d0 sumEbis_p(i,iparm)=0.0d0 sumEsq_p(i,iparm)=0.0d0 - do j=1,nQ+2 + do j=1,nQ+6 sumQ_p(j,i,iparm)=0.0d0 sumQsq_p(j,i,iparm)=0.0d0 sumEQ_p(j,i,iparm)=0.0d0 @@ -654,7 +654,7 @@ c & " WHAM_COMM",WHAM_COMM sumE(i,iparm)=0.0d0 sumEbis(i,iparm)=0.0d0 sumEsq(i,iparm)=0.0d0 - do j=1,nQ+2 + do j=1,nQ+6 sumQ(j,i,iparm)=0.0d0 sumQsq(j,i,iparm)=0.0d0 sumEQ(j,i,iparm)=0.0d0 @@ -854,7 +854,7 @@ c call restore_parm(iparm) sumE_p(k,iparm)=sumE_p(k,iparm)+etot*weight sumEbis_p(k,iparm)=sumEbis_p(k,iparm)+ebis*weight sumEsq_p(k,iparm)=sumEsq_p(k,iparm)+etot**2*weight - do j=1,nQ+2 + do j=1,nQ+6 sumQ_p(j,k,iparm)=sumQ_p(j,k,iparm)+q(j,t)*weight sumQsq_p(j,k,iparm)=sumQsq_p(j,k,iparm)+q(j,t)**2*weight sumEQ_p(j,k,iparm)=sumEQ_p(j,k,iparm) @@ -865,7 +865,7 @@ c call restore_parm(iparm) sumE(k,iparm)=sumE(k,iparm)+etot*weight sumEbis(k,iparm)=sumEbis(k,iparm)+ebis*weight sumEsq(k,iparm)=sumEsq(k,iparm)+etot**2*weight - do j=1,nQ+2 + do j=1,nQ+6 sumQ(j,k,iparm)=sumQ(j,k,iparm)+q(j,t)*weight sumQsq(j,k,iparm)=sumQsq(j,k,iparm)+q(j,t)**2*weight sumEQ(j,k,iparm)=sumEQ(j,k,iparm) @@ -1085,7 +1085,7 @@ c call restore_parm(iparm) & sumW(i,iparm) sumEsq(i,iparm)=(sumEsq(i,iparm)/sumW(i,iparm) & -sumE(i,iparm)**2)/(1.987D-3*(startGridT+i*delta_T)**2) - do j=1,nQ+2 + do j=1,nQ+6 sumQ(j,i,iparm)=sumQ(j,i,iparm)/sumW(i,iparm) sumQsq(j,i,iparm)=sumQsq(j,i,iparm)/sumW(i,iparm) & -sumQ(j,i,iparm)**2 @@ -1096,15 +1096,15 @@ c call restore_parm(iparm) & (startGridT+i*delta_T))+potEmin write (iout,'(f7.1,2f15.5,$)') startGridT+i*delta_T, & sumW(i,iparm),sumE(i,iparm) - write (iout,'(f10.5,$)') (sumQ(j,i,iparm),j=1,nQ+2) + write (iout,'(f10.5,$)') (sumQ(j,i,iparm),j=1,nQ+6) write (iout,'(e15.5,$)') sumEsq(i,iparm)-sumEbis(i,iparm), - & (sumQsq(j,i,iparm),j=1,nQ+2),(sumEQ(j,i,iparm),j=1,nQ+2) + & (sumQsq(j,i,iparm),j=1,nQ+6),(sumEQ(j,i,iparm),j=1,nQ+6) write (iout,*) write (34,'(f7.1,2f15.5,$)') startGridT+i*delta_T, & sumW(i,iparm),sumE(i,iparm) - write (34,'(f10.5,$)') (sumQ(j,i,iparm),j=1,nQ+2) + write (34,'(f10.5,$)') (sumQ(j,i,iparm),j=1,nQ+6) write (34,'(e15.5,$)') sumEsq(i,iparm)-sumEbis(i,iparm), - & (sumQsq(j,i,iparm),j=1,nQ+2),(sumEQ(j,i,iparm),j=1,nQ+2) + & (sumQsq(j,i,iparm),j=1,nQ+6),(sumEQ(j,i,iparm),j=1,nQ+6) write (34,*) call flush(34) enddo -- 1.7.9.5 From 557c4e196d2022afc18038c950d78423b48a93a6 Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Tue, 16 Feb 2021 15:11:53 +0100 Subject: [PATCH 13/16] Adam's unres update --- source/unres/src-HCD-5D/COMMON.CHAIN | 10 +- source/unres/src-HCD-5D/COMMON.CONTROL | 6 +- source/unres/src-HCD-5D/COMMON.INTERACT | 41 +- source/unres/src-HCD-5D/COMMON.MD | 4 +- source/unres/src-HCD-5D/COMMON.TIME1 | 10 +- source/unres/src-HCD-5D/COMMON.TORCNSTR | 5 +- source/unres/src-HCD-5D/DIMENSIONS | 15 +- source/unres/src-HCD-5D/MD_A-MTS.F | 13 +- source/unres/src-HCD-5D/cartprint.f | 2 +- source/unres/src-HCD-5D/chain_symmetry.F | 23 +- source/unres/src-HCD-5D/chainbuild.F | 37 +- source/unres/src-HCD-5D/checkder_p.F | 1 + source/unres/src-HCD-5D/contact.f | 6 +- source/unres/src-HCD-5D/dfa.F | 1 - source/unres/src-HCD-5D/elecont.f | 34 +- source/unres/src-HCD-5D/energy_p_new-sep_barrier.F | 124 ++-- source/unres/src-HCD-5D/energy_p_new_barrier.F | 73 ++- source/unres/src-HCD-5D/energy_split-sep.F | 76 ++- source/unres/src-HCD-5D/gen_rand_conf.F | 223 ++++++- source/unres/src-HCD-5D/gen_rand_conf_mchain.F | 424 +++++++++++++ source/unres/src-HCD-5D/geomout.F | 16 +- source/unres/src-HCD-5D/gradient_p.F | 1 + source/unres/src-HCD-5D/initialize_p.F | 182 ++++-- source/unres/src-HCD-5D/lagrangian_lesyng.F | 23 +- source/unres/src-HCD-5D/make_xx_list.F | 641 ++++++++++++++++---- source/unres/src-HCD-5D/minimize_p.F | 6 +- source/unres/src-HCD-5D/orig_frame_chain.F | 85 +++ source/unres/src-HCD-5D/readpdb-mult.F | 52 +- source/unres/src-HCD-5D/readrtns_CSA.F | 355 +++++++---- source/unres/src-HCD-5D/refsys.f | 8 +- source/unres/src-HCD-5D/stochfric.F | 25 +- source/unres/src-HCD-5D/timing.F | 37 ++ source/unres/src-HCD-5D/unres.F | 33 +- 33 files changed, 2101 insertions(+), 491 deletions(-) create mode 100644 source/unres/src-HCD-5D/gen_rand_conf_mchain.F create mode 100644 source/unres/src-HCD-5D/orig_frame_chain.F diff --git a/source/unres/src-HCD-5D/COMMON.CHAIN b/source/unres/src-HCD-5D/COMMON.CHAIN index da83764..d666fd9 100644 --- a/source/unres/src-HCD-5D/COMMON.CHAIN +++ b/source/unres/src-HCD-5D/COMMON.CHAIN @@ -1,7 +1,8 @@ integer nres,nsup,nstart_sup,nz_start,nz_end,iz_sc, & nres0,nstart_seq,nchain,chain_length,chain_border,iprzes, - & chain_border1,ireschain,tabpermchain,npermchain,afmend,afmbeg, - & nres_chomo,nmodel_start + & chain_border1,ireschain,tabpermchain,npermchain,nequiv, + & nchain_group,iequiv,mapchain,afmend,afmbeg, + & nres_chomo,nmodel_start,nran_start double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm,t,r, & prod,rt,dc_work,cref,crefjlee,dc_norm2,velAFMconst, & totTafm,chomo @@ -9,14 +10,15 @@ common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2), & xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2), & dc_norm2(3,0:maxres2), - & dc_work(MAXRES6),nres,nres0 + & dc_work(MAXRES6),nres,nres0,nran_start common /rotmat/ t(3,3,maxres),r(3,3,maxres),prod(3,3,maxres), & rt(3,3,maxres) common /refstruct/ cref(3,maxres2+2), & crefjlee(3,maxres2+2), & nsup,nstart_sup,nstart_seq,iprzes, & chain_length(maxchain),npermchain,ireschain(maxres), - & tabpermchain(maxchain,maxperm), + & tabpermchain(maxchain,maxperm),nchain_group, + & iequiv(maxchain,maxres),nequiv(maxchain),mapchain(maxchain), & chain_border(2,maxchain),chain_border1(2,maxchain),nchain common /from_zscore/ nz_start,nz_end,iz_sc double precision boxxsize,boxysize,boxzsize,enecut,sscut, diff --git a/source/unres/src-HCD-5D/COMMON.CONTROL b/source/unres/src-HCD-5D/COMMON.CONTROL index da8581a..32ecc93 100644 --- a/source/unres/src-HCD-5D/COMMON.CONTROL +++ b/source/unres/src-HCD-5D/COMMON.CONTROL @@ -2,7 +2,8 @@ ! and output level. !... energy_dec = .true. means print energy decomposition matrix integer modecalc,iscode,indpdb,indback,indphi,iranconf,icheckgrad, - & inprint,i2ndstr,mucadyn,constr_dist,symetr,AFMlog,selfguide, + & inprint,i2ndstr,mucadyn,constr_dist,symetr,npermut, + & AFMlog,selfguide, & shield_mode,tor_mode,tubelog,constr_homology,homol_nset, & iprint !... minim = .true. means DO minimization. @@ -20,6 +21,7 @@ & unres_pdb,out_cart,out_int,vdisulf,searchsc,lmuca,dccart,mucadyn, & extconf,out1file,gmatout,selfguide,AFMlog,shield_mode,tor_mode, & tubelog,constr_dist,gnorm_check,gradout,split_ene, - & with_theta_constr,with_dihed_constr,symetr,usampl,loc_qlike, + & with_theta_constr,with_dihed_constr,symetr,npermut,usampl,loc_ + & qlike, & adaptive,constr_homology,homol_nset,read2sigma,start_from_model, & read_homol_frag,out_template_coord,out_template_restr diff --git a/source/unres/src-HCD-5D/COMMON.INTERACT b/source/unres/src-HCD-5D/COMMON.INTERACT index 14416ad..9b023e5 100644 --- a/source/unres/src-HCD-5D/COMMON.INTERACT +++ b/source/unres/src-HCD-5D/COMMON.INTERACT @@ -22,22 +22,45 @@ & iatsc_s,iatsc_e,iatel_s,iatel_e,iatel_s_vdw,iatel_e_vdw, & iatscp_s,iatscp_e,ispp,iscp C 3/26/20 Interaction lists +C 10/26/20 Upgraded to interaction lists for RESPA integer newcontlisti(maxint_res*maxres), + & newcontlisti_long(maxint_res*maxres), + & newcontlisti_short(maxint_res*maxres), & newcontlistj(maxint_res*maxres), + & newcontlistj_long(maxint_res*maxres), + & newcontlistj_short(maxint_res*maxres), & newcontlistppi(maxint_res*maxres), & newcontlistppj(maxint_res*maxres), - & newcontlistpp_vdwi(maxint_res*maxres), - & newcontlistpp_vdwj(maxint_res*maxres), + & newcontlistpp_vdwi_short(maxint_res*maxres), + & newcontlistpp_vdwj_short(maxint_res*maxres), & newcontlistscpi(2*maxint_res*maxres), + & newcontlistscpi_long(2*maxint_res*maxres), + & newcontlistscpi_short(2*maxint_res*maxres), & newcontlistscpj(2*maxint_res*maxres), + & newcontlistscpj_long(2*maxint_res*maxres), + & newcontlistscpj_short(2*maxint_res*maxres), & g_listscsc_start,g_listscsc_end,g_listpp_start,g_listpp_end, - & g_listpp_vdw_start,g_listpp_vdw_end,g_listscp_start,g_listscp_end - common /interact_list/newcontlisti,newcontlistj,g_listscsc_start, - & g_listscsc_end,newcontlistppi,newcontlistppj,g_listpp_start, - & g_listpp_end,newcontlistpp_vdwi,newcontlistpp_vdwj, - & g_listpp_vdw_start,g_listpp_vdw_end, - & newcontlistscpi,newcontlistscpj,g_listscp_start, - & g_listscp_end + & g_listscp_start,g_listscp_end, + & g_listscsc_start_long,g_listscsc_end_long, + & g_listscp_start_long,g_listscp_end_long, + & g_listscsc_start_short,g_listscsc_end_short, + & g_listpp_vdw_start_short,g_listpp_vdw_end_short, + & g_listscp_start_short,g_listscp_end_short + common /interact_list/ + & newcontlisti,newcontlisti_long,newcontlisti_short, + & newcontlistj,newcontlistj_long,newcontlistj_short, + & g_listscsc_start,g_listscsc_start_long,g_listscsc_start_short, + & g_listscsc_end,g_listscsc_end_long,g_listscsc_end_short, + & newcontlistppi,newcontlistppj,g_listpp_start, + & g_listpp_end, + & newcontlistpp_vdwi_short, + & newcontlistpp_vdwj_short, + & g_listpp_vdw_start_short, + & g_listpp_vdw_end_short, + & newcontlistscpi,newcontlistscpi_long,newcontlistscpi_short, + & newcontlistscpj,newcontlistscpj_long,newcontlistscpj_short, + & g_listscp_start,g_listscp_start_long,g_listscp_start_short, + & g_listscp_end,g_listscp_end_long,g_listscp_end_short C 12/1/95 Array EPS included in the COMMON block. double precision eps,epslip,sigma,sigmaii,rs0,chi,chip,alp, & sigma0,sigii, diff --git a/source/unres/src-HCD-5D/COMMON.MD b/source/unres/src-HCD-5D/COMMON.MD index cea18eb..c69e8e4 100644 --- a/source/unres/src-HCD-5D/COMMON.MD +++ b/source/unres/src-HCD-5D/COMMON.MD @@ -3,13 +3,13 @@ & dvmax,damax,edriftmax integer n_timestep,ntwx,ntwe,lang,count_reset_moment, & count_reset_vel,ntime_split,ntime_split0, - & maxtime_split,itime_mat,imatupdate + & maxtime_split,itime_mat,imatupdate,irest_freq logical large,print_compon,tbf,rest,reset_moment,reset_vel, & rattle,mdpdb,RESPA,preminim common /mdpar/ v_ini,d_time,d_time0,t_bath, & tau_bath,dvmax,damax,n_timestep,mdpdb, & ntime_split,ntime_split0,maxtime_split,itime_mat,imatupdate, - & ntwx,ntwe,lang,large,print_compon,tbf,rest,preminim, + & ntwx,ntwe,irest_freq,lang,large,print_compon,tbf,rest,preminim, & reset_moment,reset_vel,count_reset_moment,count_reset_vel, & rattle,RESPA ! Basic quantities diff --git a/source/unres/src-HCD-5D/COMMON.TIME1 b/source/unres/src-HCD-5D/COMMON.TIME1 index fc1e7d5..24d82ee 100644 --- a/source/unres/src-HCD-5D/COMMON.TIME1 +++ b/source/unres/src-HCD-5D/COMMON.TIME1 @@ -15,7 +15,10 @@ c FOUND_NAN - set by calcf to stop sumsl via stopx & time_vec,time_mat,time_ginvmult,time_fricmatmult,time_fric, & time_scatter_fmat,time_scatter_ginv, & time_fsample,time_scatter_fmatmult,time_scatter_ginvmult, - & time_stoch,t_eshort,t_elong,t_etotal,time_SAXS + & time_stoch,t_eshort,t_elong,t_etotal,time_SAXS,time_list, + & time_evdw,time_eelec,time_escp,time_evdw_short,time_eelec_short, + & time_escp_short,time_evdw_long,time_eelec_long,time_escp_long, + & time_escpcalc,time_escpsetup common /timing/ t_init,t_MDsetup,t_langsetup, & t_MD,t_enegrad,t_sdsetup,time_bcast,time_reduce,time_gather, & time_sendrecv,time_scatter,time_barrier_e,time_barrier_g, @@ -25,4 +28,7 @@ c FOUND_NAN - set by calcf to stop sumsl via stopx & time_vec,time_mat,time_ginvmult,time_fricmatmult,time_fric, & time_fsample,time_scatter_fmatmult,time_scatter_ginvmult, & time_scatter_fmat,time_scatter_ginv, - & time_stoch,t_eshort,t_elong,t_etotal,time_SAXS + & time_stoch,t_eshort,t_elong,t_etotal,time_SAXS,time_list, + & time_evdw,time_eelec,time_escp,time_evdw_short,time_eelec_short, + & time_escp_short,time_evdw_long,time_eelec_long,time_escp_long, + & time_escpcalc,time_escpsetup diff --git a/source/unres/src-HCD-5D/COMMON.TORCNSTR b/source/unres/src-HCD-5D/COMMON.TORCNSTR index 9476b50..5219a92 100644 --- a/source/unres/src-HCD-5D/COMMON.TORCNSTR +++ b/source/unres/src-HCD-5D/COMMON.TORCNSTR @@ -1,4 +1,5 @@ - integer ndih_constr,idih_constr(maxdih_constr),ntheta_constr, + integer ndih_constr,idih_constr(maxdih_constr), + & iconstr_dih(maxres),ntheta_constr, & itheta_constr(maxdih_constr) integer ndih_nconstr,idih_nconstr(maxdih_constr) integer idihconstr_start,idihconstr_end,ithetaconstr_start, @@ -10,7 +11,7 @@ & vpsipred(3,maxdih_constr),sdihed(2,maxdih_constr),wdihc common /torcnstr/ phi0,drange,ftors,theta_constr0,theta_drange, & for_thet_constr,vpsipred,sdihed,wdihc, - & ndih_constr,idih_constr, + & ndih_constr,idih_constr,iconstr_dih, & ndih_nconstr,idih_nconstr,idihconstr_start,idihconstr_end, & ntheta_constr,itheta_constr,ithetaconstr_start, & ithetaconstr_end,raw_psipred diff --git a/source/unres/src-HCD-5D/DIMENSIONS b/source/unres/src-HCD-5D/DIMENSIONS index 4236776..3c2c924 100644 --- a/source/unres/src-HCD-5D/DIMENSIONS +++ b/source/unres/src-HCD-5D/DIMENSIONS @@ -16,7 +16,8 @@ C Max. number of coarse-grain processors parameter (max_cg_procs=maxprocs) C Max. number of AA residues integer maxres - parameter (maxres=20000) +c parameter (maxres=70000) + parameter (maxres=1000) C Max. number of AA residues per chain integer maxres_chain parameter (maxres_chain=1200) @@ -30,9 +31,10 @@ C Appr. max. number of interaction sites & mmaxres2_chain=maxres2_chain*(maxres2_chain+1)/2) C Max number of symetric chains integer maxchain - parameter (maxchain=50) + parameter (maxchain=250) integer maxperm - parameter (maxperm=5040) +c parameter (maxperm=5040) + parameter (maxperm=3628800) C Max. number of variables integer maxvar parameter (maxvar=6*maxres) @@ -42,8 +44,8 @@ C Max. number of groups of interactions that a given SC is involved in C Max. number of derivatives of virtual-bond and side-chain vectors in theta C or phi. integer maxdim -c parameter (maxdim=(maxres_chain-1)*(maxres_chain-2)/2) - parameter (maxdim=(maxres-1)*(maxres-2)/2) + parameter (maxdim=(maxres_chain-1)*(maxres_chain-2)/2) +c parameter (maxdim=(maxres-1)*(maxres-2)/2) C Max. number of SC contacts integer maxcont parameter (maxcont=12*maxres) @@ -60,8 +62,7 @@ C include in template-based/contact distance restraints. parameter (maxcont_res=200) C Max. number of distance/contact-distance restraints integer maxdim_cont -c parameter (maxdim_cont=maxres*maxcont_res) - parameter (maxdim_cont=maxres*1000) + parameter (maxdim_cont=maxres*maxcont_res) C Number of AA types (at present only natural AA's will be handled integer ntyp,ntyp1 parameter (ntyp=24,ntyp1=ntyp+1) diff --git a/source/unres/src-HCD-5D/MD_A-MTS.F b/source/unres/src-HCD-5D/MD_A-MTS.F index e504cbd..8cebc8f 100644 --- a/source/unres/src-HCD-5D/MD_A-MTS.F +++ b/source/unres/src-HCD-5D/MD_A-MTS.F @@ -65,6 +65,7 @@ c t_enegrad=0.0d0 t_sdsetup=0.0d0 write (iout,'(20(1h=),a20,20(1h=))') "MD calculation started" + write (iout,*) "Restart frequency:",irest_freq #ifdef MPI tt0=MPI_Wtime() #else @@ -261,7 +262,7 @@ C call check_ecartint call cartout(totT) endif endif - if (rstcount.eq.1000.or.itime.eq.n_timestep) then + if (rstcount.eq.irest_freq.or.itime.eq.n_timestep) then open(irest2,file=rest2name,status='unknown') write(irest2,*) totT,EK,potE,totE,t_bath do i=0,2*nres-1 @@ -290,7 +291,7 @@ C call check_ecartint & ' End of MD calculation ' #ifdef TIMING_ENE write (iout,*) "time for etotal",t_etotal," elong",t_elong, - & " eshort",t_eshort + & " eshort",t_eshort," list",time_list write (iout,*) "time_fric",time_fric," time_stoch",time_stoch, & " time_fricmatmult",time_fricmatmult," time_fsample ", & time_fsample @@ -429,7 +430,7 @@ c Calculate energy and forces call zerograd call etotal(potEcomp) ! AL 4/17/17: Reduce the steps if NaNs occurred. - if (potEcomp(0).gt.0.99e20 .or. isnan(potEcomp(0)).gt.0) then + if (potEcomp(0).gt.0.99e20 .or. isnan(potEcomp(0))) then d_time=d_time/2 cycle endif @@ -1672,6 +1673,7 @@ c Set up the initial conditions of a MD simulation double precision etot logical fail integer i_start_models(0:nodes-1) + double precision potEcomp_long(0:Max_Ene) write (iout,*) "init_MD INDPDB",indpdb d_time0=d_time c write(iout,*) "d_time", d_time @@ -1810,7 +1812,7 @@ c rest2name = prefix(:ilen(prefix))//'.rst' if(me.eq.king.or..not.out1file)then write (iout,*) "Initial velocities" do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), + write (iout,'(i7,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), & (d_t(j,i+nres),j=1,3) enddo endif @@ -2080,6 +2082,7 @@ C 8/22/17 AL Minimize initial structure call zerograd call etotal(potEcomp) if (large) call enerprint(potEcomp) + if (RESPA) call etotal_long(potEcomp_long) #ifdef TIMING_ENE #ifdef MPI t_etotal=t_etotal+MPI_Wtime()-tt0 @@ -2092,7 +2095,7 @@ c write (iout,*) "PotE-homology",potE-potEcomp(27) call cartgrad call lagrangian call max_accel - if (amax*d_time .gt. dvmax) then + if (amax*d_time .gt. dvmax .and. .not. respa) then d_time=d_time*dvmax/amax if(me.eq.king.or..not.out1file) write (iout,*) & "Time step reduced to",d_time, diff --git a/source/unres/src-HCD-5D/cartprint.f b/source/unres/src-HCD-5D/cartprint.f index 339a89d..8a747b4 100644 --- a/source/unres/src-HCD-5D/cartprint.f +++ b/source/unres/src-HCD-5D/cartprint.f @@ -15,6 +15,6 @@ & ' centroid coordinates'/ 1 ' ', 7X,'X',11X,'Y',11X,'Z', & 10X,'X',11X,'Y',11X,'Z') - 110 format (a,'(',i4,')',6f12.5) + 110 format (a,'(',i5,')',6f12.5) return end diff --git a/source/unres/src-HCD-5D/chain_symmetry.F b/source/unres/src-HCD-5D/chain_symmetry.F index 8c36855..d10c33f 100644 --- a/source/unres/src-HCD-5D/chain_symmetry.F +++ b/source/unres/src-HCD-5D/chain_symmetry.F @@ -1,5 +1,6 @@ subroutine chain_symmetry(nchain,nres,itype,chain_border, - & chain_length,npermchain,tabpermchain) + & chain_length,npermchain,tabpermchain,nchain_group,nequiv, + & iequiv,chaingroup) c c Determine chain symmetry. nperm is the number of permutations and c tabperchain contains the allowed permutations of the chains. @@ -12,13 +13,17 @@ c & chain_length(nchain),itemp(maxchain), & npermchain,tabpermchain(maxchain,maxperm), & tabperm(maxchain,maxperm),mapchain(maxchain), - & iequiv(maxchain,maxres),iflag(maxres) + & chaingroup(maxchain),iequiv(maxchain,maxres),iflag(maxres) integer i,j,k,l,ii,nchain_group,nequiv(maxchain),iieq, & nperm,npermc,ind + logical lprn /.false./ if (nchain.eq.1) then npermchain=1 tabpermchain(1,1)=1 c print*,"npermchain",npermchain," tabpermchain",tabpermchain(1,1) + nchain_group=1 + iequiv(1,1)=1 + chaingroup(1)=1 return endif c @@ -73,12 +78,24 @@ c k=k+1 do j=1,nequiv(i) ind=ind+1 mapchain(ind)=iequiv(j,i) + chaingroup(ind)=i enddo enddo write (iout,*) "mapchain" do i=1,nchain write (iout,*) i,mapchain(i) enddo + write (iout,*) "chaingroup" + do i=1,nchain + write (iout,*) i,chaingroup(i) + enddo + if (npermut.eq.0) then + npermchain=1 + do i=1,nchain + tabpermchain(i,1)=i + enddo + return + endif ii=0 do i=1,nchain_group call permut(nequiv(i),nperm,tabperm) @@ -117,10 +134,12 @@ c k=k+1 enddo enddo write(iout,*) "Number of chain permutations",npermchain + if (lprn) then write(iout,*) "Permutations" do i=1,npermchain write(iout,'(20i4)') (tabpermchain(j,i),j=1,nchain) enddo + endif return end c--------------------------------------------------------------------- diff --git a/source/unres/src-HCD-5D/chainbuild.F b/source/unres/src-HCD-5D/chainbuild.F index 7902f15..a60e2bd 100644 --- a/source/unres/src-HCD-5D/chainbuild.F +++ b/source/unres/src-HCD-5D/chainbuild.F @@ -108,11 +108,11 @@ C include 'COMMON.VAR' cost=dcos(theta(3)) sint=dsin(theta(3)) - t(1,1,1)=-cost + t(1,1,1)=cost t(1,2,1)=-sint t(1,3,1)= 0.0D0 - t(2,1,1)=-sint - t(2,2,1)= cost + t(2,1,1)=sint + t(2,2,1)=cost t(2,3,1)= 0.0D0 t(3,1,1)= 0.0D0 t(3,2,1)= 0.0D0 @@ -170,7 +170,7 @@ C C Locate CA(i) and SC(i-1) C implicit none - integer i,j + integer i,j,k double precision theti,phii,cost,sint,cosphi,sinphi include 'DIMENSIONS' include 'COMMON.CHAIN' @@ -196,14 +196,15 @@ C sint=dsin(theti) cosphi=dcos(phii) sinphi=dsin(phii) +c write (iout,*) "locate_next_res i",i * Define the matrices of the rotation about the virtual-bond valence angles * theta, T(i,j,k), virtual-bond dihedral angles gamma (miscalled PHI in this * program), R(i,j,k), and, the cumulative matrices of rotation RT t(1,1,i-2)=-cost - t(1,2,i-2)=-sint + t(1,2,i-2)= sint t(1,3,i-2)= 0.0D0 t(2,1,i-2)=-sint - t(2,2,i-2)= cost + t(2,2,i-2)=-cost t(2,3,i-2)= 0.0D0 t(3,1,i-2)= 0.0D0 t(3,2,i-2)= 0.0D0 @@ -212,26 +213,36 @@ C r(1,2,i-2)= 0.0D0 r(1,3,i-2)= 0.0D0 r(2,1,i-2)= 0.0D0 - r(2,2,i-2)=-cosphi - r(2,3,i-2)= sinphi + r(2,2,i-2)= cosphi + r(2,3,i-2)=-sinphi r(3,1,i-2)= 0.0D0 r(3,2,i-2)= sinphi r(3,3,i-2)= cosphi rt(1,1,i-2)=-cost - rt(1,2,i-2)=-sint + rt(1,2,i-2)= sint rt(1,3,i-2)=0.0D0 - rt(2,1,i-2)=sint*cosphi + rt(2,1,i-2)=-sint*cosphi rt(2,2,i-2)=-cost*cosphi - rt(2,3,i-2)=sinphi + rt(2,3,i-2)=-sinphi rt(3,1,i-2)=-sint*sinphi - rt(3,2,i-2)=cost*sinphi - rt(3,3,i-2)=cosphi + rt(3,2,i-2)=-cost*sinphi + rt(3,3,i-2)= cosphi call matmult(prod(1,1,i-2),rt(1,1,i-2),prod(1,1,i-1)) +c write (iout,*) "prod",i-2 +c do j=1,3 +c write (iout,*) (prod(j,k,i-2),k=1,3) +c enddo +c write (iout,*) "prod",i-1 +c do j=1,3 +c write (iout,*) (prod(j,k,i-1),k=1,3) +c enddo do j=1,3 dc_norm(j,i-1)=prod(j,1,i-1) dc(j,i-1)=vbld(i)*prod(j,1,i-1) c(j,i)=c(j,i-1)+dc(j,i-1) enddo +c write (iout,*) "dc",i-1,(dc(j,i-1),j=1,3) +c write (iout,*) "c",i,(dc(j,i),j=1,3) cd print '(2i3,2(3f10.5,5x))', i-1,i,(dc(j,i-1),j=1,3),(c(j,i),j=1,3) C C Now calculate the coordinates of SC(i-1) diff --git a/source/unres/src-HCD-5D/checkder_p.F b/source/unres/src-HCD-5D/checkder_p.F index e1448db..d0032da 100644 --- a/source/unres/src-HCD-5D/checkder_p.F +++ b/source/unres/src-HCD-5D/checkder_p.F @@ -364,6 +364,7 @@ c------------------------------------------------------------------------- double precision dnorm1,dnorm2,be double precision time00 double precision dist,alpha,beta + double precision time01 if (lprn) write (iout,'(/a)') 'Recalculated internal coordinates' #ifdef TIMING time01=MPI_Wtime() diff --git a/source/unres/src-HCD-5D/contact.f b/source/unres/src-HCD-5D/contact.f index f986380..ead0332 100644 --- a/source/unres/src-HCD-5D/contact.f +++ b/source/unres/src-HCD-5D/contact.f @@ -137,7 +137,7 @@ c print *,'nnt=',nnt,' nct=',nct i2=icont(2,i) it1=itype(i1) it2=itype(i2) - write (iout,'(i5,2x,a,i5,2x,a,i4)') + write (iout,'(i10,2x,a,i7,2x,a,i7)') & i,restyp(it1),i1,restyp(it2),i2 enddo endif @@ -184,8 +184,8 @@ c enddo ii1=iharp(3,i) jj1=iharp(4,i) write (iout,*) - write (iout,'(20(a,i5,1x))') (restyp(itype(k)),k,k=i1,ii1) - write (iout,'(20(a,i5,1x))') (restyp(itype(k)),k,k=j1,jj1,-1) + write (iout,'(20(a,i7,1x))') (restyp(itype(k)),k,k=i1,ii1) + write (iout,'(20(a,i7,1x))') (restyp(itype(k)),k,k=j1,jj1,-1) c do k=jj1,j1,-1 c write (iout,'(a,i3,$)') restyp(itype(k)),k c enddo diff --git a/source/unres/src-HCD-5D/dfa.F b/source/unres/src-HCD-5D/dfa.F index 1af0b44..3982b6d 100644 --- a/source/unres/src-HCD-5D/dfa.F +++ b/source/unres/src-HCD-5D/dfa.F @@ -368,7 +368,6 @@ C END OF BETA RESTRAINT edfadis=0 gdfad=0.0d0 -c write (2,*) "edfad",idfadis_start,idfadis_end do i=idfadis_start,idfadis_end iatm1=idislis(1,i)+ishiftca diff --git a/source/unres/src-HCD-5D/elecont.f b/source/unres/src-HCD-5D/elecont.f index bf9056a..7c024ea 100644 --- a/source/unres/src-HCD-5D/elecont.f +++ b/source/unres/src-HCD-5D/elecont.f @@ -9,7 +9,7 @@ include 'COMMON.NAMES' logical lprint double precision elpp_6(2,2),elpp_3(2,2),ael6_(2,2),ael3_(2,2) - double precision app_(2,2),bpp_(2,2),rpp_(2,2) + double precision app_(2,2),bpp_(2,2),epp_(2,2),rpp_(2,2) integer ncont,icont(2,maxcont) double precision econt(maxcont) double precision boxshift @@ -20,7 +20,7 @@ * * as of 7/06/91. * -c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ +c data epp_ / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ data rpp_ / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ data elpp_6 /-0.2379d0,-0.2056d0,-0.2056d0,-0.0610d0/ data elpp_3 / 0.0503d0, 0.0000d0, 0.0000d0, 0.0692d0/ @@ -55,7 +55,6 @@ c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ zmedi=zi+0.5*dzi call to_box(xmedi,ymedi,zmedi) c write (iout,*) "i",xmedi,ymedi,zmedi -c write (iout,*) "i",xmedi,ymedi,zmedi do 4 j=i+2,nct-1 c write (iout,*) "i",i," j",j if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) goto 4 @@ -74,11 +73,12 @@ c write (iout,*) "i",i," j",j xj=c(1,j)+0.5*dxj yj=c(2,j)+0.5*dyj zj=c(3,j)+0.5*dzj -c write (iout,*) "j",xj,yj,zj call to_box(xj,yj,zj) - xj=boxshift(xj-xi,boxxsize) - yj=boxshift(yj-yi,boxysize) - zj=boxshift(zj-zi,boxzsize) +c write (iout,*) "j",xj,yj,zj + xj=boxshift(xj-xmedi,boxxsize) + yj=boxshift(yj-ymedi,boxysize) + zj=boxshift(zj-zmedi,boxzsize) +c write (iout,*) "j",xj,yj,zj rij=xj*xj+yj*yj+zj*zj rrmij=1.0/(xj*xj+yj*yj+zj*zj) rmij=sqrt(rrmij) @@ -105,7 +105,7 @@ c write (iout,*) "j",xj,yj,zj econt(ncont)=eesij endif ees=ees+eesij -c write (iout,*) "i"," j",j," rij",dsqrt(rij)," eesij",eesij +c write (iout,*) "i",i," j",j," rij",dsqrt(rij)," eesij",eesij 4 continue 1 continue if (lprint) then @@ -118,7 +118,7 @@ c write (iout,*) "i"," j",j," rij",dsqrt(rij)," eesij",eesij i2=icont(2,i) it1=itype(i1) it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') + write (iout,'(i7,2x,a,i6,2x,a,i6,f10.5)') & i,restyp(it1),i1,restyp(it2),i2,econt(i) enddo endif @@ -204,7 +204,7 @@ c enddo i2=icont(2,i) it1=itype(i1) it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') + write (iout,'(i7,2x,a,i6,2x,a,i6,f10.5)') & i,restyp(it1),i1,restyp(it2),i2,econt(i) enddo endif @@ -267,7 +267,7 @@ cd write (iout,*) i1,j1,not_done ii1=max0(ii1-1,1) jj1=max0(jj1-1,1) nbeta=nbeta+1 - if(lprint)write(iout,'(a,i3,4i4)')'parallel beta', + if(lprint)write(iout,'(a,i7,4i6)')'parallel beta', & nbeta,ii1,i1,jj1,j1 nbfrag=nbfrag+1 @@ -442,29 +442,29 @@ cd write (iout,*) i1,j1,not_done if (lprint) then - write (iout,'(a,i3,4i4)')'antiparallel beta', + write (iout,'(a,i3,4i6)')'antiparallel beta', & nbeta,ii1-1,i1,jj1,j1-1 nstrand=nstrand+1 if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') + write(12,'(a18,i1,a9,i6,a2,i6,a1)') & "DefPropRes 'strand",nstrand, & "' 'num = ",ii1-2,"..",i1-1,"'" else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') + write(12,'(a18,i2,a9,i6,a2,i6,a1)') & "DefPropRes 'strand",nstrand, & "' 'num = ",ii1-2,"..",i1-1,"'" endif nstrand=nstrand+1 if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') + write(12,'(a18,i1,a9,i6,a2,i6,a1)') & "DefPropRes 'strand",nstrand, & "' 'num = ",j1-2,"..",jj1-1,"'" else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') + write(12,'(a18,i2,a9,i6,a2,i6,a1)') & "DefPropRes 'strand",nstrand, & "' 'num = ",j1-2,"..",jj1-1,"'" endif - write(12,'(a8,4i4)') + write(12,'(a8,4i6)') & "SetNeigh",ii1-2,i1-1,jj1-1,j1-2 endif endif diff --git a/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F b/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F index c4e54bc..f92aebb 100644 --- a/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F @@ -94,9 +94,9 @@ c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon gg_lipi=0.0d0 gg_lipj=0.0d0 c do i=iatsc_s,iatsc_e - do ikont=g_listscsc_start,g_listscsc_end - i=newcontlisti(ikont) - j=newcontlistj(ikont) + do ikont=g_listscsc_start_long,g_listscsc_end_long + i=newcontlisti_long(ikont) + j=newcontlistj_long(ikont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -219,9 +219,9 @@ c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon gg_lipi=0.0d0 gg_lipj=0.0d0 c do i=iatsc_s,iatsc_e - do ikont=g_listscsc_start,g_listscsc_end - i=newcontlisti(ikont) - j=newcontlistj(ikont) + do ikont=g_listscsc_start_short,g_listscsc_end_short + i=newcontlisti_short(ikont) + j=newcontlistj_short(ikont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -340,9 +340,9 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon gg_lipi=0.0d0 gg_lipj=0.0d0 c do i=iatsc_s,iatsc_e - do ikont=g_listscsc_start,g_listscsc_end - i=newcontlisti(ikont) - j=newcontlistj(ikont) + do ikont=g_listscsc_start_long,g_listscsc_end_long + i=newcontlisti_long(ikont) + j=newcontlistj_long(ikont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -462,9 +462,9 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon gg_lipi=0.0d0 gg_lipj=0.0d0 c do i=iatsc_s,iatsc_e - do ikont=g_listscsc_start,g_listscsc_end - i=newcontlisti(ikont) - j=newcontlistj(ikont) + do ikont=g_listscsc_start_short,g_listscsc_end_short + i=newcontlisti_short(ikont) + j=newcontlistj_short(ikont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -586,9 +586,9 @@ c else c endif ind=0 c do i=iatsc_s,iatsc_e - do ikont=g_listscsc_start,g_listscsc_end - i=newcontlisti(ikont) - j=newcontlistj(ikont) + do ikont=g_listscsc_start_long,g_listscsc_end_long + i=newcontlisti_long(ikont) + j=newcontlistj_long(ikont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -734,9 +734,9 @@ c else c endif ind=0 c do i=iatsc_s,iatsc_e - do ikont=g_listscsc_start,g_listscsc_end - i=newcontlisti(ikont) - j=newcontlistj(ikont) + do ikont=g_listscsc_start_short,g_listscsc_end_short + i=newcontlisti_short(ikont) + j=newcontlistj_short(ikont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -872,7 +872,7 @@ C & xj_temp,yj_temp,zj_temp,dist_temp,sig,rij_shift,faclip double precision dist,sscale,sscagrad,sscagradlip,sscalelip double precision subchap,sss1,sssgrad1 - double precision boxshift + double precision boxshift,rij1 evdw=0.0D0 ccccc energy_dec=.false. c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon @@ -882,9 +882,12 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon c if (icall.eq.0) lprn=.false. ind=0 c do i=iatsc_s,iatsc_e - do ikont=g_listscsc_start,g_listscsc_end - i=newcontlisti(ikont) - j=newcontlistj(ikont) + if (energy_dec) + & write(2,*) "g_listscsc_start_long,g_listscsc_end_long", + & g_listscsc_start_long,g_listscsc_end_long + do ikont=g_listscsc_start_long,g_listscsc_end_long + i=newcontlisti_long(ikont) + j=newcontlistj_long(ikont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -940,9 +943,13 @@ c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) dzj=dc_norm(3,nres+j) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) - sss1=sscale(1.0d0/rij,r_cut_int) + rij1=1.0d0/rij +c sss1=sscale(1.0d0/rij,r_cut_int) + sss1=sscale(rij1,r_cut_int) if (sss1.eq.0.0d0) cycle - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)),r_cut_respa) + rij1=rij1/sigmaii(itypi,itypj) + sss=sscale(rij1,r_cut_respa) +c sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)),r_cut_respa) if (sss.lt.1.0d0) then C Calculate angle-dependent terms of energy and contributions to their C derivatives. @@ -1026,6 +1033,7 @@ C This subroutine calculates the interaction energy of nonbonded side chains C assuming the Gay-Berne potential of interaction. C implicit none + include 'mpif.h' include 'DIMENSIONS' include 'COMMON.GEO' include 'COMMON.VAR' @@ -1038,6 +1046,7 @@ C include 'COMMON.CALC' include 'COMMON.CONTROL' include "COMMON.SPLITELE" + include 'COMMON.TIME1' logical lprn double precision evdw integer itypi,itypj,itypi1,iint,ind,ikont @@ -1046,6 +1055,8 @@ C & sslipj,ssgradlipj,ssgradlipi,sig,rij_shift,faclip double precision dist,sscale,sscagrad,sscagradlip,sscalelip double precision boxshift + double precision time01 +c time01=MPI_Wtime() evdw=0.0D0 ccccc energy_dec=.false. c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon @@ -1055,9 +1066,12 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon c if (icall.eq.0) lprn=.false. ind=0 c do i=iatsc_s,iatsc_e - do ikont=g_listscsc_start,g_listscsc_end - i=newcontlisti(ikont) - j=newcontlistj(ikont) + if (energy_dec) + & write(2,*) "g_listscsc_start_short,g_listscsc_end_short", + & g_listscsc_start_short,g_listscsc_end_short + do ikont=g_listscsc_start_short,g_listscsc_end_short + i=newcontlisti_short(ikont) + j=newcontlistj_short(ikont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -1119,8 +1133,8 @@ c & (2.0d0-sslipi-sslipj)/2.0d0 rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)),r_cut_respa) - sssgrad=sscagrad((1.0d0/rij)/sigmaii(itypi,itypj),r_cut_respa) if (sss.gt.0.0d0) then + sssgrad=sscagrad((1.0d0/rij)/sigmaii(itypi,itypj),r_cut_respa) C Calculate angle-dependent terms of energy and contributions to their C derivatives. @@ -1189,6 +1203,7 @@ C Calculate angular part of the gradient. c enddo ! j c enddo ! iint enddo ! i +c time_evdw_short=time_evdw_short+MPI_Wtime()-time01 c write (iout,*) "Number of loop steps in EGB:",ind cccc energy_dec=.false. return @@ -1230,9 +1245,9 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon c if (icall.eq.0) lprn=.true. ind=0 c do i=iatsc_s,iatsc_e - do ikont=g_listscsc_start,g_listscsc_end - i=newcontlisti(ikont) - j=newcontlistj(ikont) + do ikont=g_listscsc_start_long,g_listscsc_end_long + i=newcontlisti_long(ikont) + j=newcontlistj_long(ikont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -1392,9 +1407,9 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon c if (icall.eq.0) lprn=.true. ind=0 c do i=iatsc_s,iatsc_e - do ikont=g_listscsc_start,g_listscsc_end - i=newcontlisti(ikont) - j=newcontlistj(ikont) + do ikont=g_listscsc_start_short,g_listscsc_end_short + i=newcontlisti_short(ikont) + j=newcontlistj_short(ikont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -1742,6 +1757,9 @@ c c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 c c do i=iatel_s,iatel_e + if (energy_dec) + & write(iout,*) "g_listpp_start,g_listpp_end", + & g_listpp_start,g_listpp_end do ikont=g_listpp_start,g_listpp_end i=newcontlistppi(ikont) j=newcontlistppj(ikont) @@ -2812,9 +2830,12 @@ c write (iout,*) "iatel_s_vdw",iatel_s_vdw, c & " iatel_e_vdw",iatel_e_vdw c call flush(iout) c do i=iatel_s_vdw,iatel_e_vdw - do ikont=g_listpp_vdw_start,g_listpp_vdw_end - i=newcontlistpp_vdwi(ikont) - j=newcontlistpp_vdwj(ikont) + if (energy_dec) + & write(iout,*) "g_listpp_vdw_start_short,g_listpp_vdw_end_short", + & g_listpp_vdw_start_short,g_listpp_vdw_end_short + do ikont=g_listpp_vdw_start_short,g_listpp_vdw_end_short + i=newcontlistpp_vdwi_short(ikont) + j=newcontlistpp_vdwj_short(ikont) if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) @@ -2939,9 +2960,12 @@ c if (lprint_short) c & write (iout,*) 'ESCP_LONG iatscp_s=',iatscp_s, c & ' iatscp_e=',iatscp_e c do i=iatscp_s,iatscp_e - do ikont=g_listscp_start,g_listscp_end - i=newcontlistscpi(ikont) - j=newcontlistscpj(ikont) + if (energy_dec) + & write(iout,*)"g_listscp_start_long,g_listscp_end_long", + & g_listscp_start_long,g_listscp_end_long + do ikont=g_listscp_start_long,g_listscp_end_long + i=newcontlistscpi_long(ikont) + j=newcontlistscpj_long(ikont) if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) @@ -3065,14 +3089,20 @@ C double precision ggg(3) double precision sscale,sscagrad double precision boxshift + integer ikont evdw2=0.0D0 evdw2_14=0.0d0 cd print '(a)','Enter ESCP' c if (lprint_short) c & write (iout,*) 'ESCP_SHORT iatscp_s=',iatscp_s, c & ' iatscp_e=',iatscp_e - if (energy_dec) write (iout,*) "escp_short:",r_cut_int,rlamb - do i=iatscp_s,iatscp_e +c if (energy_dec) write (iout,*) "escp_short:",r_cut_int,rlamb + if (energy_dec) + & write(iout,*) "g_listscp_start_short,g_listscp_end_short", + & g_listscp_start_short,g_listscp_end_short + do ikont=g_listscp_start_short,g_listscp_end_short + i=newcontlistscpi_short(ikont) + j=newcontlistscpj_short(ikont) if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) @@ -3083,9 +3113,9 @@ c & ' iatscp_e=',iatscp_e c if (lprint_short) c & write (iout,*) "i",i," itype",itype(i),itype(i+1), c & " nscp_gr",nscp_gr(i) - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) +c do iint=1,nscp_gr(i) +c +c do j=iscpstart(i,iint),iscpend(i,iint) itypj=iabs(itype(j)) c if (lprint_short) c & write (iout,*) "j",j," itypj",itypj @@ -3149,9 +3179,9 @@ c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) enddo endif - enddo +c enddo - enddo ! iint +c enddo ! iint enddo ! i do i=1,nct do j=1,3 diff --git a/source/unres/src-HCD-5D/energy_p_new_barrier.F b/source/unres/src-HCD-5D/energy_p_new_barrier.F index 6d6a817..2d94dc0 100644 --- a/source/unres/src-HCD-5D/energy_p_new_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new_barrier.F @@ -37,6 +37,7 @@ c include 'COMMON.MD' & eliptran,Eafmforce,Etube, & esaxs_constr,ehomology_constr,edfator,edfanei,edfabet integer n_corr,n_corr1 + double precision time01 #ifdef MPI c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank, c & " nfgtasks",nfgtasks @@ -117,6 +118,9 @@ c call chainbuild_cart endif c write (iout,*) "itime_mat",itime_mat," imatupdate",imatupdate if (mod(itime_mat,imatupdate).eq.0) then +#ifdef TIMING_ENE + time01=MPI_Wtime() +#endif call make_SCp_inter_list c write (iout,*) "Finished make_SCp_inter_list" c call flush(iout) @@ -126,9 +130,12 @@ c call flush(iout) call make_pp_inter_list c write (iout,*) "Finished make_pp_inter_list" c call flush(iout) - call make_pp_vdw_inter_list +c call make_pp_vdw_inter_list c write (iout,*) "Finished make_pp_vdw_inter_list" c call flush(iout) +#ifdef TIMING_ENE + time_list=time_list+MPI_Wtime()-time01 +#endif endif c print *,'Processor',myrank,' calling etotal ipot=',ipot c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct @@ -151,6 +158,9 @@ C C Compute the side-chain and electrostatic interaction energy C C print *,ipot +#ifdef TIMING_ENE + time01=MPI_Wtime() +#endif goto (101,102,103,104,105,106) ipot C Lennard-Jones potential. 101 call elj(evdw) @@ -175,6 +185,9 @@ C C Calculate electrostatic (H-bonding) energy of the main chain. C 107 continue +#ifdef TIMING_ENE + time_evdw=time_evdw+MPI_Wtime()-time01 +#endif #ifdef DFA C BARTEK for dfa test! c print *,"Processors",MyRank," wdfa",wdfa_dist @@ -216,6 +229,9 @@ c print *,"Processor",myrank," computed USCSC" #ifdef TIMING time_vec=time_vec+MPI_Wtime()-time01 #endif +#ifdef TIMING_ENE + time01=MPI_Wtime() +#endif C Introduction of shielding effect first for each peptide group C the shielding factor is set this factor is describing how each C peptide group is shielded by side-chains @@ -252,6 +268,9 @@ c print *,"Processor",myrank," left VEC_AND_DERIV" c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, c & eello_turn4) endif +#ifdef TIMING_ENE + time_eelec=time_eelec+MPI_Wtime()-time01 +#endif c#ifdef TIMING c time_enecalc=time_enecalc+MPI_Wtime()-time00 c#endif @@ -260,6 +279,9 @@ C C Calculate excluded-volume interaction energy between peptide groups C and side chains. C +#ifdef TIMING_ENE + time01=MPI_Wtime() +#endif if (ipot.lt.6) then if(wscp.gt.0d0) then call escp(evdw2,evdw2_14) @@ -271,6 +293,9 @@ C c write (iout,*) "Soft-sphere SCP potential" call escp_soft_sphere(evdw2,evdw2_14) endif +#ifdef TIMING_ENE + time_escp=time_escp+MPI_Wtime()-time01 +#endif c c Calculate the bond-stretching energy c @@ -839,12 +864,12 @@ c do i=nnt,nres gradbufc(k,i)=0.0d0 enddo enddo -#ifdef DEBUG - write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end - write (iout,*) (i," jgrad_start",jgrad_start(i), - & " jgrad_end ",jgrad_end(i), - & i=igrad_start,igrad_end) -#endif +c#ifdef DEBUG +c write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end +c write (iout,*) (i," jgrad_start",jgrad_start(i), +c & " jgrad_end ",jgrad_end(i), +c & i=igrad_start,igrad_end) +c#endif c c Obsolete and inefficient code; we can make the effort O(n) and, therefore, c do not parallelize this part. @@ -1510,6 +1535,7 @@ C double precision sscale,sscagrad,sscagradlip,sscalelip double precision gg_lipi(3),gg_lipj(3) double precision boxshift + external boxshift c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 gg_lipi=0.0d0 @@ -2039,6 +2065,7 @@ c do j=istart(i,iint),iend(i,iint) c write(iout,*) "PRZED ZWYKLE", evdwij call dyn_ssbond_ene(i,j,evdwij) c write(iout,*) "PO ZWYKLE", evdwij +c call flush(iout) evdw=evdw+evdwij if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') @@ -2151,7 +2178,7 @@ C I hate to put IF's in the loops, but here don't have another choice!!!! cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') cd & restyp(itypi),i,restyp(itypj),j, cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c return + return endif sigder=-sig*sigsq c--------------------------------------------------------------- @@ -3049,7 +3076,7 @@ c write(iout,*) 'b2=',(b2(k,i-2),k=1,2) #endif enddo - mu=0.0d0 + mu(:,:nres)=0.0d0 #ifdef PARMAT do i=ivec_start+2,ivec_end+2 #else @@ -5504,6 +5531,9 @@ C peptide-group centers and side chains and its gradient in virtual-bond and C side-chain vectors. C implicit none +#ifdef MPI + include 'mpif.h' +#endif include 'DIMENSIONS' include 'COMMON.GEO' include 'COMMON.VAR' @@ -5515,6 +5545,7 @@ C include 'COMMON.IOUNITS' include 'COMMON.CONTROL' include 'COMMON.SPLITELE' + include 'COMMON.TIME1' double precision ggg(3) integer i,iint,j,k,iteli,itypj,subchap,ikont double precision xi,yi,zi,xj,yj,zj,rrij,sss1,sssgrad1, @@ -5522,6 +5553,10 @@ C double precision evdw2,evdw2_14,evdwij double precision sscale,sscagrad double precision boxshift + external boxshift,to_box +c#ifdef TIMING_ENE +c double precision time01 +c#endif evdw2=0.0D0 evdw2_14=0.0d0 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla' @@ -5533,6 +5568,9 @@ C do zshift=-1,1 if (energy_dec) write (iout,*) "escp:",r_cut_int,rlamb c do i=iatscp_s,iatscp_e do ikont=g_listscp_start,g_listscp_end +c#ifdef TIMING_ENE +c time01=MPI_Wtime() +c#endif i=newcontlistscpi(ikont) j=newcontlistscpj(ikont) if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle @@ -5540,6 +5578,7 @@ c do i=iatscp_s,iatscp_e 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)) +!DIR$ INLINE call to_box(xi,yi,zi) c do iint=1,nscp_gr(i) @@ -5554,11 +5593,21 @@ C Uncomment following three lines for Ca-p interactions xj=c(1,j) yj=c(2,j) zj=c(3,j) +!DIR$ INLINE call to_box(xj,yj,zj) +c#ifdef TIMING_ENE +c time_escpsetup=time_escpsetup+MPI_Wtime()-time01 +c time01=MPI_Wtime() +c#endif +!DIR$ INLINE xj=boxshift(xj-xi,boxxsize) yj=boxshift(yj-yi,boxysize) zj=boxshift(zj-zi,boxzsize) c print *,xj,yj,zj,'polozenie j' +c#ifdef TIMING_ENE +c time_escpsetup=time_escpsetup+MPI_Wtime()-time01 +c time01=MPI_Wtime() +c#endif rrij=1.0D0/(xj*xj+yj*yj+zj*zj) c print *,rrij sss=sscale(1.0d0/(dsqrt(rrij)),r_cut_int) @@ -5619,6 +5668,9 @@ cgrad enddo gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) enddo +c#ifdef TIMING_ENE +c time_escpcalc=time_escpcalc+MPI_Wtime()-time01 +c#endif c endif !endif for sscale cutoff c enddo ! j @@ -5804,7 +5856,8 @@ C 15/02/13 CC dynamic SSbond - additional check 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 +c ehpb=ehpb+2*eij + ehpb=ehpb+eij endif cd write (iout,*) "eij",eij cd & ' waga=',waga,' fac=',fac diff --git a/source/unres/src-HCD-5D/energy_split-sep.F b/source/unres/src-HCD-5D/energy_split-sep.F index 34a1bd1..51d5b2d 100644 --- a/source/unres/src-HCD-5D/energy_split-sep.F +++ b/source/unres/src-HCD-5D/energy_split-sep.F @@ -13,7 +13,7 @@ cMS$ATTRIBUTES C :: proc_proc #ifdef MPI include "mpif.h" double precision weights_(n_ene) - double precision time00,time_Bcast,time_BcastW + double precision time00 integer ierror,ierr #endif include 'COMMON.SETUP' @@ -29,6 +29,7 @@ cMS$ATTRIBUTES C :: proc_proc include 'COMMON.QRESTR' include 'COMMON.MD' include 'COMMON.CONTROL' + include 'COMMON.TIME1' double precision evdw,evdw1,evdw2,evdw2_14,ees,eel_loc, & eello_turn3,eello_turn4,edfadis,estr,ehpb,ebe,ethetacnstr, & escloc,etors,edihcnstr,etors_d,esccor,ecorr,ecorr5,ecorr6,eturn6, @@ -36,6 +37,9 @@ cMS$ATTRIBUTES C :: proc_proc & esaxs_constr,ehomology_constr,edfator,edfanei,edfabet integer i,n_corr,n_corr1 c write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot +#ifdef TIMING_ENE + double precision time01 +#endif if (modecalc.eq.12.or.modecalc.eq.14) then #ifdef MPI c if (fg_rank.eq.0) call int_from_cart1(.false.) @@ -138,16 +142,25 @@ c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct call MPI_Bcast(itime_mat,1,MPI_INT,king,FG_COMM,IERROR) endif if (mod(itime_mat,imatupdate).eq.0) then - call make_SCp_inter_list - call make_SCSC_inter_list +#ifdef TIMING_ENE + time01=MPI_Wtime() +#endif + call make_SCp_inter_list_RESPA + call make_SCSC_inter_list_RESPA call make_pp_inter_list - call make_pp_vdw_inter_list + call make_pp_vdw_inter_list_RESPA +#ifdef TIMING_ENE + time_list=time_list+MPI_Wtime()-time01 +#endif endif #endif cd print *,'nnt=',nnt,' nct=',nct C C Compute the side-chain and electrostatic interaction energy C +#ifdef TIMING_ENE + time01=MPI_Wtime() +#endif goto (101,102,103,104,105,106) ipot C Lennard-Jones potential. 101 call elj_long(evdw) @@ -171,8 +184,20 @@ C C Calculate electrostatic (H-bonding) energy of the main chain. C 107 continue +#ifdef TIMING_ENE + time_evdw_long=time_evdw_long+MPI_Wtime()-time01 +#endif +#ifdef TIMING + time01=MPI_Wtime() +#endif call vec_and_deriv +#ifdef TIMING + time_vec=time_vec+MPI_Wtime()-time01 +#endif c write (iout,*) "etotal_long: shield_mode",shield_mode +#ifdef TIMING_ENE + time01=MPI_Wtime() +#endif if (shield_mode.eq.1) then call set_shield_fac else if (shield_mode.eq.2) then @@ -204,10 +229,16 @@ c write (iout,*) "Soft-spheer ELEC potential" call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, & eello_turn4) endif +#ifdef TIMING_ENE + time_eelec_long=time_eelec_long+MPI_Wtime()-time01 +#endif C C Calculate excluded-volume interaction energy between peptide groups C and side chains. C +#ifdef TIMING_ENE + time01=MPI_Wtime() +#endif if (ipot.lt.6) then if(wscp.gt.0d0) then call escp_long(evdw2,evdw2_14) @@ -218,6 +249,9 @@ C else call escp_soft_sphere(evdw2,evdw2_14) endif +#ifdef TIMING_ENE + time_escp_long=time_escp_long+MPI_Wtime()-time01 +#endif #ifdef FOURBODY C C 12/1/95 Multi-body terms @@ -334,12 +368,16 @@ cMS$ATTRIBUTES C :: proc_proc include 'COMMON.CONTROL' include 'COMMON.SAXS' include 'COMMON.TORCNSTR' + include 'COMMON.TIME1' double precision evdw,evdw1,evdw2,evdw2_14,ees,eel_loc, & eello_turn3,eello_turn4,edfadis,estr,ehpb,ebe,ethetacnstr, & escloc,etors,edihcnstr,etors_d,esccor,ecorr,ecorr5,ecorr6,eturn6, & eliptran,Eafmforce,Etube, & esaxs_constr,ehomology_constr,edfator,edfanei,edfabet integer i,n_corr,n_corr1 +#ifdef TIMING_ENE + double precision time01 +#endif c write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot c call flush(iout) if (modecalc.eq.12.or.modecalc.eq.14) then @@ -432,13 +470,13 @@ C FG slaves receive the WEIGHTS array wsaxs=weights(26) endif c write (iout,*),"Processor",myrank," BROADCAST weights" - call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION, + call MPI_Bcast(c(1,1),6*nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) c write (iout,*) "Processor",myrank," BROADCAST c" - call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION, + call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) c write (iout,*) "Processor",myrank," BROADCAST dc" - call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION, + call MPI_Bcast(dc_norm(1,1),6*nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) c write (iout,*) "Processor",myrank," BROADCAST dc_norm" call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION, @@ -470,6 +508,9 @@ c call int_from_cart1(.false.) C C Compute the side-chain and electrostatic interaction energy C +#ifdef TIMING_ENE + time01=MPI_Wtime() +#endif goto (101,102,103,104,105,106) ipot C Lennard-Jones potential. 101 call elj_short(evdw) @@ -494,16 +535,31 @@ C C Calculate electrostatic (H-bonding) energy of the main chain. C 107 continue +#ifdef TIMING_ENE + time_evdw_short=time_evdw_short+MPI_Wtime()-time01 +#endif c c Calculate the short-range part of Evdwpp c +#ifdef TIMING_ENE + time01=MPI_Wtime() +#endif call evdwpp_short(evdw1) +#ifdef TIMING_ENE + time_eelec_short=time_eelec_short+MPI_Wtime()-time01 +#endif c c Calculate the short-range part of ESCp c +#ifdef TIMING_ENE + time01=MPI_Wtime() +#endif if (ipot.lt.6) then call escp_short(evdw2,evdw2_14) endif +#ifdef TIMING_ENE + time_escp_short=time_escp_short+MPI_Wtime()-time01 +#endif c c Calculate the bond-stretching energy c @@ -531,7 +587,13 @@ C energy function C C Calculate the SC local energy. C +#ifdef TIMING + time01=MPI_Wtime() +#endif call vec_and_deriv +#ifdef TIMING + time_vec=time_vec+MPI_Wtime()-time01 +#endif call esc(escloc) C C Calculate the virtual-bond torsional energy. diff --git a/source/unres/src-HCD-5D/gen_rand_conf.F b/source/unres/src-HCD-5D/gen_rand_conf.F index ea009b6..603e6c0 100644 --- a/source/unres/src-HCD-5D/gen_rand_conf.F +++ b/source/unres/src-HCD-5D/gen_rand_conf.F @@ -13,7 +13,7 @@ C Generate random conformation or chain cut and regrowth. logical overlap,back,fail integer nstart integer i,j,k,it,it1,it2,nit,niter,nsi,maxsi,maxnit - double precision gen_theta,gen_phi,dist + double precision gen_theta,gen_phi,dist,ran_number cd print *,' CG Processor',me,' maxgen=',maxgen maxsi=100 cd write (iout,*) 'Gen_Rand_conf: nstart=',nstart @@ -60,12 +60,16 @@ c write(iout,*)'theta(3)=',rad2deg*theta(3) it1=iabs(itype(i-1)) it2=iabs(itype(i-2)) it=iabs(itype(i)) -c print *,'Gen_Rand_Conf: i=',i,' it=',it,' it1=',it1,' it2=',it2, -c & ' nit=',nit,' niter=',niter,' maxgen=',maxgen + if (it.eq.ntyp1 .and. it1.eq.ntyp1) then + vbld(i)=ran_number(3.8d0,10.0d0) + vbld_inv(i)=1.0d0/vbld(i) + endif +c write (iout,*) 'Gen_Rand_Conf: i=',i,' it=',it,' it1=',it1, +c & ' it2=',it2,' nit=',nit,' niter=',niter,' maxgen=',maxgen phi(i+1)=gen_phi(i+1,it1,it) if (back) then phi(i)=gen_phi(i+1,it2,it1) -c print *,'phi(',i,')=',phi(i) +c write(iout,*) 'phi(',i,')=',phi(i)," type",it1,it2,it theta(i-1)=gen_theta(it2,phi(i-1),phi(i)) if (it2.ne.10 .and. it2.ne.ntyp1) then nsi=0 @@ -78,7 +82,12 @@ c print *,'phi(',i,')=',phi(i) endif call locate_next_res(i-1) endif - theta(i)=gen_theta(it1,phi(i),phi(i+1)) + if (it1.ne.ntyp1) then + theta(i)=gen_theta(it1,phi(i),phi(i+1)) + else + theta(i)=ran_number(1.326d0,2.548d0) + endif +c write (iout,*) "i",i," theta",theta(i) if (it1.ne.10 .and. it1.ne.ntyp1) then nsi=0 fail=.true. @@ -86,10 +95,12 @@ c print *,'phi(',i,')=',phi(i) call gen_side(it1,theta(i),alph(i-1),omeg(i-1),fail) nsi=nsi+1 enddo +c write (iout,*) "After forward SC generation:",nsi,maxsi if (nsi.gt.maxsi) return1 endif call locate_next_res(i) if (overlap(i-1)) then +c write (iout,*) "overlap",i-1 if (nit.lt.maxnit) then back=.true. nit=nit+1 @@ -107,6 +118,7 @@ c print *,'phi(',i,')=',phi(i) endif endif else +c write (iout,*) "No overlap",i-1 back=.false. nit=0 i=i+1 @@ -211,11 +223,55 @@ c-------------------------------------------------------------------------- double precision function gen_phi(i,it1,it2) implicit real*8 (a-h,o-z) include 'DIMENSIONS' + include 'COMMON.IOUNITS' include "COMMON.TORCNSTR" include 'COMMON.GEO' include 'COMMON.BOUNDS' - if (raw_psipred .or. ndih_constr.eq.0) then + include 'COMMON.INTERACT' + double precision sumprob(3) + double precision pinorm + external pinorm + if (ndih_constr.eq.0) then gen_phi=ran_number(-pi,pi) + else if (raw_psipred) then + if (itype(i-3).ne.ntyp1 .and. itype(i-2).ne.ntyp1 + & .and. itype(i-1).ne.ntyp1 .and. itype(i).ne.ntyp1) then + ii=iconstr_dih(i) + sumprob(1)=vpsipred(2,ii) + sumprob(2)=sumprob(1)+vpsipred(3,ii) + sumprob(3)=sumprob(2)+vpsipred(1,ii) + aux=ran_number(0.0d0,sumprob(3)) +#ifdef DEBUG + write(iout,*)"gen_phi: residue i",i," ii",ii," vpsipred", + & vpsipred(2,ii),vpsipred(3,ii),vpsipred(1,ii)," sumprob", + & sumprob(1),sumprob(2),sumprob(3) + write (iout,*) "aux",aux +#endif + if (aux.le.sumprob(1)) then +#ifdef DEBUG + write (iout,*) "hel:", + & (phibound(1,i)-sdihed(1,ndih_constr))*rad2deg, + & (phibound(1,i)+sdihed(1,ndih_constr))*rad2deg +#endif + gen_phi=ran_number(phibound(1,i)-sdihed(1,ndih_constr) + & ,phibound(1,i)+sdihed(1,ndih_constr)) + else if (aux.le.sumprob(2)) then +#ifdef DEBUG + write (iout,*) "ext:", + & (phibound(2,i)-sdihed(2,ndih_constr))*rad2deg, + & (phibound(2,i)+sdihed(2,ndih_constr))*rad2deg +#endif + gen_phi=pinorm(ran_number(phibound(2,i)-sdihed(2,ndih_constr) + & ,phibound(2,i)+sdihed(2,ndih_constr))) + else +#ifdef DEBUG + write (iout,*) "coil:",-180.0,180.0 +#endif + gen_phi=ran_number(-pi,pi) + endif + else + gen_phi=ran_number(-pi,pi) + endif else C 8/13/98 Generate phi using pre-defined boundaries gen_phi=ran_number(phibound(1,i),phibound(2,i)) @@ -288,7 +344,7 @@ c------------------------------------------------------------------------- fail=.false. if (the.eq.0.0D0 .or. the.eq.pi) then #ifdef MPI - write (*,'(a,i4,a,i3,a,1pe14.5)') + write (iout,'(a,i4,a,i3,a,1pe14.5)') & 'CG Processor:',me,' Error in GenSide: it=',it,' theta=',the #else cd write (iout,'(a,i3,a,1pe14.5)') @@ -778,23 +834,24 @@ c overlapping residues left, or false otherwise (success) include 'COMMON.IOUNITS' logical had_overlaps,fail,scfail integer ioverlap(maxres),ioverlap_last + integer maxit_corr /5000/ had_overlaps=.false. - call overlap_sc_list(ioverlap,ioverlap_last) + call overlap_sc_list(ioverlap,ioverlap_last,.false.) if (ioverlap_last.gt.0) then write (iout,*) '#OVERLAPing residues ',ioverlap_last - write (iout,'(18i5)') (ioverlap(k),k=1,ioverlap_last) + write (iout,'(15i6)') (ioverlap(k),k=1,ioverlap_last) had_overlaps=.true. endif maxsi=1000 - do k=1,1000 + do k=1,maxit_corr if (ioverlap_last.eq.0) exit do ires=1,ioverlap_last i=ioverlap(ires) iti=iabs(itype(i)) - if (iti.ne.10) then + if (iti.ne.10 .and. iti.lt.ntyp1) then nsi=0 fail=.true. do while (fail.and.nsi.le.maxsi) @@ -805,16 +862,15 @@ c overlapping residues left, or false otherwise (success) if(fail) goto 999 endif enddo - c write (iout,*) "before chaincuild overlap_sc_list: dc0",dc(:,0) c call chainbuild_extconf c write (iout,*) "after chaincuild overlap_sc_list: dc0",dc(:,0) - call overlap_sc_list(ioverlap,ioverlap_last) - write (iout,*) 'Overlaping residues ',ioverlap_last, - & (ioverlap(j),j=1,ioverlap_last) + call overlap_sc_list(ioverlap,ioverlap_last,.false.) + write (iout,*)'#Overlaping residues @iter',k,":",ioverlap_last + write (iout,*)'Residue list:',(ioverlap(j),j=1,ioverlap_last) enddo - if (k.le.1000.and.ioverlap_last.eq.0) then + if (k.le.maxit_corr.and.ioverlap_last.eq.0) then scfail=.false. if (had_overlaps) then write (iout,*) '#OVERLAPing all corrected after ',k, @@ -823,22 +879,29 @@ c write (iout,*) "after chaincuild overlap_sc_list: dc0",dc(:,0) else scfail=.true. write (iout,*) '#OVERLAPing NOT all corrected ',ioverlap_last - write (iout,'(20i4)') (ioverlap(j),j=1,ioverlap_last) + write (iout,'(15i6)') (ioverlap(j),j=1,ioverlap_last) endif return 999 continue - write (iout,'(a30,i5,a12,i4)') + write (iout,'(a30,i5,a12,i6)') & '#OVERLAP FAIL in gen_side after',maxsi, & 'iter for RES',i scfail=.true. return end - subroutine overlap_sc_list(ioverlap,ioverlap_last) - implicit real*8 (a-h,o-z) + subroutine overlap_sc_list(ioverlap,ioverlap_last,lprn) + implicit none include 'DIMENSIONS' +#ifdef MPI + include "mpif.h" + include "COMMON.SETUP" + integer ierror + integer ioverlap_last_tab(0:max_fg_procs-1), + & ioverlap_all(maxres*max_fg_procs),displs(0:max_fg_procs-1) +#endif include 'COMMON.GEO' include 'COMMON.LOCAL' include 'COMMON.IOUNITS' @@ -847,19 +910,47 @@ c write (iout,*) "after chaincuild overlap_sc_list: dc0",dc(:,0) include 'COMMON.FFIELD' include 'COMMON.VAR' include 'COMMON.CALC' - logical fail + integer ii,itypi,itypj,itypi1,ind,ikont + logical fail,lprn integer ioverlap(maxres),ioverlap_last - data redfac /0.5D0/ + double precision redfac /0.5D0/ + double precision rrij,rij_shift,sig0ij,xi,yi,zi,rcomp,sig + double precision dist - write (iout,*) "overlap_sc_list" +#ifdef MPI + if (nfgtasks.gt.1) then + if (fg_rank.eq.0) + & call MPI_Bcast(11,1,MPI_INTEGER,king,FG_COMM,IERROR) + call MPI_Bcast(c(1,1),6*nres,MPI_DOUBLE_PRECISION,king,FG_COMM, + & IERROR) + call MPI_Bcast(dc(1,0),6*(nres+1),MPI_DOUBLE_PRECISION,king, + & FG_COMM,IERROR) + call MPI_Bcast(dc_norm(1,0),6*(nres+1),MPI_DOUBLE_PRECISION, + & king,FG_COMM,IERROR) + endif +#endif +c write (iout,*) "overlap_sc_list" c write(iout,*) "iatsc_s",iatsc_s," iatsc_e",iatsc_e - write(iout,*) "nnt",nnt," nct",nct +c write(iout,*) "nnt",nnt," nct",nct ioverlap_last=0 C Check for SC-SC overlaps and mark residues c print *,'>>overlap_sc nnt=',nnt,' nct=',nct ind=0 +#ifdef DEBUG + write (iout,*) "FG proecssor",fg_rank," g_listscsc_start", + & g_listscsc_start," g_listscsc_end",g_listscsc_end + write (*,*) "FG proecssor",fg_rank," g_listscsc_start", + & g_listscsc_start," g_listscsc_end",g_listscsc_end +#endif c do i=iatsc_s,iatsc_e - do i=nnt,nct + do ikont=g_listscsc_start,g_listscsc_end +c write (*,*) "FG processor",fg_rank," loop begins ioverlap_last", +c & ioverlap_last + i=newcontlisti(ikont) + j=newcontlistj(ikont) +c do i=nnt,nct +c write (*,*) "FG processor",fg_rank," loop begins ioverlap_last", +c & ioverlap_last,"ikont i j",ikont,i,j itypi=iabs(itype(i)) itypi1=iabs(itype(i+1)) if (itypi.eq.ntyp1) cycle @@ -873,7 +964,7 @@ c do i=iatsc_s,iatsc_e c c do iint=1,nint_gr(i) c do j=istart(i,iint),iend(i,iint) - do j=i+1,nct +c do j=i+1,nct ind=ind+1 itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle @@ -919,10 +1010,16 @@ c & " sig",sig," sig0ij",sig0ij c if ( rij_shift.le.0.0D0 ) then if ( rij_shift/sig0ij.le.0.1D0 ) then c write (iout,*) "overlap",i,j - write (iout,'(a,i5,a,i5,a,f10.5,a,3f10.5)') - & 'overlap SC-SC: i=',i,' j=',j, - & ' dist=',dist(nres+i,nres+j),' rcomp=', - & rcomp,1.0/rij,rij_shift + if (lprn) then + write (iout,'(a,i5,a,i5,a,f10.5,a,3f10.5)') + & 'overlap SC-SC: i=',i,' j=',j, + & ' dist=',dist(nres+i,nres+j),' rcomp=', + & rcomp,1.0/rij,rij_shift + write (*,'(a,i2,a,i5,a,i5,a,f10.5,a,3f10.5)') + & 'FG processor',fg_rank,' overlap SC-SC: i=',i,' j=',j, + & ' dist=',dist(nres+i,nres+j),' rcomp=', + & rcomp,1.0/rij,rij_shift + endif ioverlap_last=ioverlap_last+1 ioverlap(ioverlap_last)=i do k=1,ioverlap_last-1 @@ -933,9 +1030,73 @@ c write (iout,*) "overlap",i,j do k=1,ioverlap_last-1 if (ioverlap(k).eq.j) ioverlap_last=ioverlap_last-1 enddo +c write(*,*) "FG processor",fg_rank,i,j," ioverlap_last", +c & ioverlap_last," ioverlap",(ioverlap(k),k=1,ioverlap_last) endif - enddo +c enddo c enddo enddo +#ifdef MPI +#ifdef DEBUG + write (iout,*) "FG Processor",fg_rank," ioverlap_last", + & ioverlap_last," ioverlap",(ioverlap(i),i=1,ioverlap_last) + write (*,*) "FG Processor",fg_rank," ioverlap_last",ioverlap_last, + & " ioverlap",(ioverlap(i),i=1,ioverlap_last) + call flush(iout) +#endif + if (nfgtasks.eq.1) return +#ifdef DEBUG + write (iout,*) "Before MPI_Gather" + call flush(iout) +#endif + call MPI_Gather(ioverlap_last,1,MPI_INTEGER,ioverlap_last_tab, + & 1,MPI_INTEGER,king,FG_COMM,IERROR) +#ifdef DEBUG + write (iout,*) "After MPI_Gather" + call flush(iout) +#endif +#ifdef DEBUG + if (myrank.eq.king) + & write (iout,*) "FG Processor",fg_rank,"ioverlap_last_tab", + & (ioverlap_last_tab(i),i=0,nfgtasks-1) + call flush(iout) +#endif + displs(0)=0 + do i=1,nfgtasks-1 + displs(i)=displs(i-1)+ioverlap_last_tab(i-1) + enddo + call MPI_Gatherv(ioverlap,ioverlap_last,MPI_INTEGER, + & ioverlap_all,ioverlap_last_tab,displs,MPI_INTEGER,king, + & FG_COMM,IERROR) +#ifdef DEBUG + write (iout,*) "After Gatherv" + call flush(iout) +#endif + if (fg_rank.gt.0) return + ioverlap_last=0 + do i=0,nfgtasks-1 + ioverlap_last=ioverlap_last+ioverlap_last_tab(i) + enddo +#ifdef DEBUG + write (iout,*) "ioverlap_last",ioverlap_last," ioverlap_last", + & (ioverlap_all(i),i=1,ioverlap_last) + call flush(iout) +#endif + ii=0 + do i=1,ioverlap_last + ioverlap(ii+1)=ioverlap_all(i) + do j=ii,1,-1 + if (ioverlap(ii+1).eq.ioverlap(j)) goto 11 + enddo + ii=ii+1 + 11 continue + enddo + ioverlap_last=ii +#ifdef DEBUG + write (iout,*) "After summing: ioverlap_last",ioverlap_last, + & " ioverlap",(ioverlap(i),i=1,ioverlap_last) + call flush(iout) +#endif +#endif return end diff --git a/source/unres/src-HCD-5D/gen_rand_conf_mchain.F b/source/unres/src-HCD-5D/gen_rand_conf_mchain.F new file mode 100644 index 0000000..4614e87 --- /dev/null +++ b/source/unres/src-HCD-5D/gen_rand_conf_mchain.F @@ -0,0 +1,424 @@ + subroutine gen_rand_conf_mchain(nstart0,*) +C Generate random conformation or chain cut and regrowth. + implicit none + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.LOCAL' + include 'COMMON.VAR' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.MCM' + include 'COMMON.GEO' + include 'COMMON.CONTROL' + logical overlap_mchain,back,fail + integer nstart,nstart0 + integer i,ii,iii,j,k,it,it1,it2,nit,niter,nsi,maxsi,maxnit + integer igr,iequi,ichain,nnres + double precision aux + double precision gen_theta,gen_phi,dist,ran_number,scalar +c write (iout,*) 'gen_rand_conf_mchain: maxgen=',maxgen + nstart=nstart0 + maxsi=100 +c write (iout,*) 'Gen_Rand_conf_mchain: nstart=',nstart, +c & " nchain_group",nchain_group + + DO IGR=1,NCHAIN_GROUP + + DO IEQUI=1,NEQUIV(IGR) + + ichain=iequiv(iequi,igr) + + i=chain_border1(1,ichain)+nstart-1 + if (nstart.eq.1) then + do j=1,3 + c(j,i)=ran_number(-15.0d0,15.0d0) + dc(j,i-1)=c(j,i) + enddo + endif + if (nstart.le.2) then + + do j=1,3 + dc_norm(j,i)=ran_number(-1.0d0,1.0d0) + enddo + aux=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))) + do j=1,3 + dc_norm(j,i)=dc_norm(j,i)/aux + enddo + if (itype(i).eq.ntyp1) then + do j=1,3 + dc(j,i)=1.9d0*dc_norm(j,i) + enddo + else + do j=1,3 + dc(j,i)=3.8d0*dc_norm(j,i) + enddo + endif + do j=1,3 + c(j,i+1)=c(j,i)+dc(j,i) + enddo + endif +c if (nstart.lt.5) then + if (nstart.le.2) then + it1=iabs(itype(i+2)) + phi(i+3)=gen_phi(i+3,iabs(itype(i+1)),iabs(itype(i+2))) +c write(iout,*)'phi(4)=',rad2deg*phi(4) + theta(i+2)=gen_theta(iabs(itype(i+2)),pi,phi(i+3)) + if (it1.ne.10) then + nsi=0 + fail=.true. + do while (fail.and.nsi.le.maxsi) + call gen_side(it1,theta(i+2),alph(i+1),omeg(i+1),fail) + nsi=nsi+1 + enddo + if (nsi.gt.maxsi) then + write (iout,'(a,i7,a,i7,a,i7,a,i7)') + & 'Problem in SC rotamer generation, residue',ii, + & ' chain',ichain,' chain group',igr,'. Increase MAXSI.' + return1 + endif + endif ! it1.ne.10 + call orig_frame_chain(i) + else +c call orig_frame_chain(i-1) +c write (iout,*) "calling refsys",i + call refsys(i,i-1,i-2,prod(1,1,i-1), + & prod(1,2,i-1),prod(1,3,i-1),fail) +c write (iout,*) "after refsys",i +#ifdef DEBUG + write (iout,*) "dc_norm(:",i-1,") and prod" + do j=1,3 + write (iout,*) j,dc_norm(j,i-1),(prod(j,k,i-1),k=1,3) + enddo +#endif + endif + + ENDDO + + nstart=nstart+1 + ii=nstart + + maxnit=5000 + + nit=0 + niter=0 + back=.false. + nnres=chain_border1(2,iequiv(1,igr))- + & chain_border1(1,iequiv(1,igr))+1 +#ifdef DEBUG + write (iout,*) "chain group",igr," chains", + & (iequiv(j,igr),j=1,nequiv(igr)) + write (iout,*) "ii",ii," nnres",nnres +#endif + do while (ii.le. nnres .and. niter.lt.maxgen) + + ichain=iequiv(1,igr) + i=ii-1+chain_border1(1,ichain) +#ifdef DEBUG + write (iout,*) "ii",ii," nnres",nnres," ichain",ichain," i",i, + & "niter",niter," back",back," nstart",nstart +#endif + if (ii.lt.nstart) then +c if(iprint.gt.1) then + write (iout,'(/80(1h*)/2a/80(1h*))') + & 'Generation procedure went down to ', + & 'chain beginning. Cannot continue...' + write (*,'(/80(1h*)/2a/80(1h*))') + & 'Generation procedure went down to ', + & 'chain beginning. Cannot continue...' +c endif + return1 + endif + it1=iabs(itype(i-1)) + it2=iabs(itype(i-2)) + it=iabs(itype(i)) + if (it.eq.ntyp1 .and. it1.eq.ntyp1) then + vbld(i)=ran_number(3.8d0,10.0d0) + vbld_inv(i)=1.0d0/vbld(i) + endif +#ifdef DEBUG + write (iout,*) 'Gen_Rand_Conf: i=',i,' it=',it,' it1=',it1, + & ' it2=',it2,' nit=',nit,' niter=',niter,' maxgen=',maxgen +#endif + phi(i)=gen_phi(i,it2,it1) + phi(i+1)=gen_phi(i+1,it1,it) +#ifdef DEBUG + write (iout,*) "phi",i,phi(i)," phi",i+1,phi(i+1) +#endif + do iequi=2,nequiv(igr) + iii=ii+chain_border1(1,iequiv(iequi,igr)) + phi(iii)=phi(i+1) + enddo +#ifdef CHUJ + if (back) then + phi(i)=gen_phi(i+1,it2,it1) +#ifdef DEBUG + write(iout,*) 'phi(',i,')=',phi(i)," type",it1,it2,it +#endif + theta(i-1)=gen_theta(it2,phi(i-1),phi(i)) + if (theta(i-1).gt.2.68780478d0) theta(i-1)=2.68780478d0 + do iequi=2,nequiv(igr) + iii=ii-1+chain_border1(1,iequiv(iequi,igr)) + phi(iii)=phi(i+1) + theta(iii-1)=theta(i-1) + enddo + if (it2.ne.10 .and. it2.ne.ntyp1) then + nsi=0 + fail=.true. + do while (fail.and.nsi.le.maxsi) + call gen_side(it2,theta(i-1),alph(i-2),omeg(i-2),fail) + nsi=nsi+1 + enddo + do iequi=2,nequiv(igr) + iii=ii-3+chain_border1(1,iequiv(iequi,igr)) + alph(iii)=alph(i-2) + omeg(iii)=omeg(i-2) + enddo +#ifdef DEBUG + write (iout,*) "alpha",alph(i)," omeg",omeg(i)," fail",fail +#endif + if (nsi.gt.maxsi) then + write (iout,'(a,i7,a,i7,a,i7,a,i7)') + & 'Problem in SC rotamer generation, residue',ii, + & ' chain',ichain,' chain group',igr,'. Increase MAXSI.' + return1 + endif + + endif +c call locate_next_res(i-1) + endif +#endif + if (it1.ne.ntyp1) then + theta(i)=gen_theta(it1,phi(i),phi(i+1)) + if (theta(i).gt.2.68780478d0) theta(i)=2.68780478d0 + else + theta(i)=ran_number(1.326d0,2.548d0) + endif +#ifdef DEBUG + write (iout,*) "ii",ii," i",i," it1",it1, + & " theta",theta(i)," phi", + & phi(i),phi(i+1) +#endif + if (it1.ne.10 .and. it1.ne.ntyp1) then + nsi=0 + fail=.true. + do while (fail.and.nsi.le.maxsi) +c theta(i)=gen_theta(it1,phi(i),phi(i+1)) + call gen_side(it1,theta(i),alph(i-1),omeg(i-1),fail) + nsi=nsi+1 + enddo +#ifdef DEBUG + write (iout,*) "alpha",alph(i)," omeg",omeg(i)," fail",fail +#endif +c write (iout,*) "After forward SC generation:",nsi,maxsi + if (nsi.gt.maxsi) then + write (iout,'(a,i7,a,i7,a,i7,a,i7)') + & 'Problem in SC rotamer generation, residue',ii, + & ' chain',ichain,' chain group',igr,'. Increase MAXSI.' + return1 + endif + + endif + + do iequi=2,nequiv(igr) + iii=ii-1+chain_border1(1,iequiv(iequi,igr)) + theta(iii)=theta(i) + phi(iii)=phi(i) + alph(iii-1)=alph(i-1) + omeg(iii-1)=omeg(i-1) + enddo + + DO IEQUI=1,NEQUIV(IGR) + + ichain=iequiv(iequi,igr) + i=ii-1+chain_border1(1,ichain) +#ifdef CHUJ + if (back) call locate_next_res(i-1) +#endif + call locate_next_res(i) +#ifdef DEBUG + write (iout,*) "i",i," ii",ii," ichain",ichain + write (iout,*) theta(i)*rad2deg,phi(i)*rad2deg, + & alph(i-1)*rad2deg,omeg(i-1)*rad2deg + write (iout,*) (c(j,i),j=1,3),(c(j,i+nres-1),j=1,3) +#endif + if (overlap_mchain(i-1,ii-1,ichain,igr)) then +#ifdef DEBUG + write (iout,*) "***********overlap",i-1," nit",nit +#endif + if (nit.lt.maxnit) then + back=.true. + nit=nit+1 + exit + else +#ifdef DEBUG + write (iout,*) "***********overlap maxnit exceeded",nit +#endif + nit=0 + if (ii.gt.3) then + back=.true. + ii=ii-1 +c write (iout,*) "ii",ii + exit + else + write (iout,'(a,i7,a,i7,a,i7,a,i7)') + & 'Cannot generate non-overlaping conformation, residue',ii, + & ' chain',ichain,' chain group',igr,'. Increase MAXNIT.' + return1 + endif + endif + else +c write (iout,*) "No overlap",i-1 + back=.false. +c nit=0 +c i=i+1 + endif + + ENDDO + + if (.not.back) then +#ifdef DEBUG + write (iout,*) "++++++++++Successful generation",igr,ichain,ii +#endif + ii=ii+1 + nit=0 + endif + back=.false. +c write (iout,*) "ii",ii + niter=niter+1 + + enddo + if (niter.ge.maxgen) then + write (iout,'(a,2i7,a,i7,a,i7,a,i7)') + & 'Too many trials in conformation generation',niter,maxgen, + & ' chain group',igr,' chain',ichain,' residue',ii + return1 + endif + + ENDDO + + do i=2,nres + if (itype(i).eq.ntyp1) then + do j=1,3 + dc(j,i-1)=c(j,i)-c(j,i-1) + enddo + endif + enddo + + return + end +c------------------------------------------------------------------------- + logical function overlap_mchain(i,ii,ichain,igr) + implicit none + include 'DIMENSIONS' + include 'COMMON.IOUNITS' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.FFIELD' + double precision redfac /0.5D0/,redfacp /0.8d0/,redfacscp /0.8d0/ + integer i,ii,ichain,igr,j,jj,jchain,jgr,k,iti,itj,iteli,itelj + double precision rcomp + double precision dist + logical lprn /.false./ + overlap_mchain=.false. + iti=iabs(itype(i)) + if (iti.gt.ntyp) return +C Check for SC-SC overlaps. +cd print *,'nnt=',nnt,' nct=',nct +#ifdef DEBUG + write (iout,*) "overlap_mchain i",i," ii",ii," ichain",ichain, + & " igr",igr," iti",iti +#endif + do j=nnt,nct + if (itype(j).eq.ntyp1) cycle + jchain=ireschain(j) +c write (iout,*) "overlap_mchain j",j," jj",jj," jchain",jchain, +c & " itype",itype(j) + jgr=mapchain(jchain) + jj=j-chain_border1(1,jchain)+1 + itj=iabs(itype(j)) +c write (iout,*) "jgr",jgr + if(igr.eq.jgr.and.jj.gt.ii .or. ichain.eq.jchain .and. j.gt.i-1 + & .or. jgr.gt.igr .and. jj.gt.nran_start) cycle + if (j.lt.i-1 .or. ipot.ne.4) then + rcomp=sigmaii(iti,itj) + else + rcomp=sigma(iti,itj) + endif +cd print *,'j=',j + if (dist(nres+i,nres+j).lt.redfac*rcomp) then + overlap_mchain=.true. + if (lprn) write(iout,*)'overlap_mchain, SC-SC: i=',i,' j=',j, + & ' ichain',ichain,' jchain',jchain, + & ' dist=',dist(nres+i,nres+j),' rcomp=', + & rcomp*redfac + return + endif + enddo +#ifdef CHUJ +C Check for overlaps between the added peptide group and the preceding +C SCs. + iteli=itel(i) + if (iteli.gt.0) then + do j=1,3 + c(j,maxres2+1)=0.5D0*(c(j,i)+c(j,i+1)) + enddo + do j=nnt,nct + itj=iabs(itype(j)) + if (itj.eq.ntyp1) cycle + jchain=ireschain(j) + jgr=mapchain(jchain) + jj=j-chain_border1(1,jchain)+1 + if(igr.eq.jgr.and.jj.gt.ii .or. ichain.eq.jchain .and. j.gt.i-2 + & .or. jgr.gt.igr .and. jj.gt.nran_start) cycle +cd print *,'overlap_mchain, p-Sc: i=',i,' j=',j, +cd & ' dist=',dist(nres+j,maxres2+1) + if (dist(j,maxres2+1).lt.4.0D0*redfacscp) then + if (lprn) write (iout,*) 'overlap_mchain, p-SC: i=',i,' j=',j, + & ' ichain',ichain,' jchain',jchain, + & ' dist=',dist(nres+j,maxres2+1),' rcomp=', + & 4.0d0*redfac + overlap_mchain=.true. + return + endif + enddo + endif +C Check for p-p overlaps +#endif + iteli=itel(i) + if (iteli.eq.0) return + do j=1,3 + c(j,maxres2+1)=0.5D0*(c(j,i)+c(j,i+1)) + enddo +c do j=nnt,i-2 + do j=nnt,nct + itelj=itel(j) + if (itelj.eq.0) cycle + do k=1,3 + c(k,maxres2+2)=0.5D0*(c(k,j)+c(k,j+1)) + enddo + jchain=ireschain(j) + jgr=mapchain(jchain) +c if(iteli.ne.0.and.itelj.ne.0)then +c write (iout,*) i,j,dist(maxres2+1,maxres2+2),rpp(iteli,itelj) + jj=j-chain_border1(1,jchain)+1 +c write (iout,*) "jgr",jgr + if(igr.eq.jgr.and.jj.gt.ii .or. ichain.eq.jchain .and. j.gt.i-2 + & .or. jgr.gt.igr .and. jj.gt.nran_start) cycle +#ifdef DEBUG + write (iout,*)'overlap_mchain, p-p: i=',i,' j=',j,' igr',igr, + & ' jgr',jgr,' ichain',ichain,' jchain',jchain, + & ' dist=',dist(maxres2+1,maxres2+2) +#endif + if (dist(maxres2+1,maxres2+2).lt.rpp(iteli,itelj)*redfacp) then + if (lprn) write (iout,*) 'overlap_mchain, p-p: i=',i,' j=',j, + & ' ichain',ichain,' jchain',jchain, + & ' dist=',dist(maxres2+1,maxres2+2),' rcomp=', + & rpp(iteli,itelj)*redfacp + overlap_mchain=.true. + return + endif +c endif + enddo + return + end + diff --git a/source/unres/src-HCD-5D/geomout.F b/source/unres/src-HCD-5D/geomout.F index d1a3a87..3dcde10 100644 --- a/source/unres/src-HCD-5D/geomout.F +++ b/source/unres/src-HCD-5D/geomout.F @@ -16,7 +16,10 @@ #endif character*50 tytul integer iunit - character*1 chainid(10) /'A','B','C','D','E','F','G','H','I','J'/ + character*1 chainid(52) /'A','B','C','D','E','F','G','H','I','J', + & 'K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z', + & 'a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p', + & 'q','r','s','t','u','v','w','x','y','z'/ integer ica(maxres) integer i,j,k,iti,itj,itk,itl,iatom,ichain,ires double precision etot @@ -90,8 +93,8 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 do i=1,nss if (dyn_ss) then write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') - & 'SSBOND',i,'CYS',idssb(i)-nnt+1, - & 'CYS',jdssb(i)-nnt+1 + & 'SSBOND',i,'CYS',iss(idssb(i))-nnt+1, + & 'CYS',iss(jdssb(i))-nnt+1 else write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres, @@ -107,9 +110,10 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 iti=itype(i) if ((iti.eq.ntyp1).and.((itype(i+1)).eq.ntyp1)) then ichain=ichain+1 + if (ichain.gt.52) ichain=1 ires=0 write (iunit,'(a)') 'TER' - else + else if (iti.ne.ntyp1) then ires=ires+1 iatom=iatom+1 ica(i)=iatom @@ -149,7 +153,7 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 write (iunit,'(a6)') 'ENDMDL' 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3) 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,f15.3) - 30 FORMAT ('CONECT',8I5) + 30 FORMAT ('CONECT',8I7) return end c------------------------------------------------------------------------------ @@ -541,7 +545,7 @@ C print *,'A CHUJ',potEcomp(23) if(itime.eq.0) then write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, & ",31a12)" - write (istat,format) "#","", + write (istat,format) "#"," ", & (ename(print_order(i)),i=1,nprint_ene) endif write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, diff --git a/source/unres/src-HCD-5D/gradient_p.F b/source/unres/src-HCD-5D/gradient_p.F index 67275ed..af7978b 100644 --- a/source/unres/src-HCD-5D/gradient_p.F +++ b/source/unres/src-HCD-5D/gradient_p.F @@ -210,6 +210,7 @@ C------------------------------------------------------------------------- include 'COMMON.IOUNITS' include 'COMMON.TIME1' integer i,j,kk + double precision time00,time01 c c This subrouting calculates total Cartesian coordinate gradient. c The subroutine chainbuild_cart and energy MUST be called beforehand. diff --git a/source/unres/src-HCD-5D/initialize_p.F b/source/unres/src-HCD-5D/initialize_p.F index 710f907..6a297b8 100644 --- a/source/unres/src-HCD-5D/initialize_p.F +++ b/source/unres/src-HCD-5D/initialize_p.F @@ -351,7 +351,7 @@ c------------------------------------------------------------------------- 1 "WSC ","WSCP ","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC", ! 8 9 10 11 12 13 14 8 "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR ","WTORD ", -!  15 16 17 18 19 20 21 +!  15 16 17 18 19 20 21 5 "WSTRAIN","WVDWPP","WBOND","SCAL14","WDIHC","WUMB","WSCCOR", ! 22 23 24 25 26 27 28 2 "WLT","WAFM","WTHETCNSR","WTUBE","WSAXS","WHOMO","WDFAD", @@ -453,8 +453,13 @@ c--------------------------------------------------------------------------- integer iturn3_start_all,iturn3_end_all,iturn4_start_all, & iturn4_end_all,iatel_s_all, & iatel_e_all,ielstart_all,ielend_all,ntask_cont_from_all, - & itask_cont_from_all,ntask_cont_to_all,itask_cont_to_all, - & n_sc_int_tot,my_sc_inds,my_sc_inde,ind_sctint,ind_scint_old + & itask_cont_from_all,ntask_cont_to_all,itask_cont_to_all + integer*8 n_sc_int_tot,my_sc_inds,my_sc_inde,ind_scint, + & ind_scint_old,nele_int_tot,ind_eleint,my_ele_inds,my_ele_inde, + & ind_eleint_old,nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw, + & ind_eleint_vdw,ind_eleint_vdw_old,nscp_int_tot,my_scp_inds, + & my_scp_inde,ind_scpint,ind_scpint_old,nsumgrad,nlen,ngrad_start, + & ngrad_end common /przechowalnia/ iturn3_start_all(0:max_fg_procs), & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), @@ -466,12 +471,8 @@ c--------------------------------------------------------------------------- & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1) integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP logical scheck,lprint,flag - integer i,j,k,ii,jj,iint,npept,nele_int_tot,ind_eleint,ind_scint, - & my_ele_inds,my_ele_inde,ind_eleint_old,nele_int_tot_vdw, - & my_ele_inds_vdw,my_ele_inde_vdw,ind_eleint_vdw,ijunk, - & ind_eleint_vdw_old,nscp_int_tot,my_scp_inds,my_scp_inde, - & ind_scpint,ind_scpint_old,nsumgrad,nlen,ngrad_start,ngrad_end, - & iaux,ind_typ,ncheck_from,ncheck_to,ichunk + integer i,j,k,ii,jj,iint,npept, + & ijunk,iaux,ind_typ,ncheck_from,ncheck_to,ichunk #ifdef MPI integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs), & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs) @@ -486,14 +487,14 @@ C... to deal with by current processor. lprint=energy_dec if (lprint) &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct - n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss - call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde) + n_sc_int_tot=int(nct-nnt+1,8)*int(nct-nnt,8)/2-nss + call int_bounds8(n_sc_int_tot,my_sc_inds,my_sc_inde) if (lprint) & write (iout,*) 'Processor',fg_rank,' CG group',kolor, & ' absolute rank',MyRank, & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds, & ' my_sc_inde',my_sc_inde - ind_sctint=0 + ind_scint=0 iatsc_s=0 iatsc_e=0 #endif @@ -530,7 +531,7 @@ cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj if (jj.eq.i+1) then #ifdef MPI c write (iout,*) 'jj=i+1' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, + call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i, & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12) #else nint_gr(i)=1 @@ -540,7 +541,7 @@ c write (iout,*) 'jj=i+1' else if (jj.eq.nct) then #ifdef MPI c write (iout,*) 'jj=nct' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, + call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i, & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12) #else nint_gr(i)=1 @@ -549,10 +550,10 @@ c write (iout,*) 'jj=nct' #endif else #ifdef MPI - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, + call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i, & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12) ii=nint_gr(i)+1 - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, + call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i, & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12) #else nint_gr(i)=2 @@ -564,7 +565,7 @@ c write (iout,*) 'jj=nct' endif else #ifdef MPI - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, + call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i, & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12) #else nint_gr(i)=1 @@ -588,9 +589,10 @@ c write (iout,*) 'jj=nct' & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e #endif if (lprint) then + write (iout,*) 'iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e write (iout,'(a)') 'Interaction array:' do i=iatsc_s,iatsc_e - write (iout,'(i3,2(2x,2i3))') + write (iout,'(i7,2(2x,2i7))') & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i)) enddo endif @@ -598,8 +600,8 @@ c write (iout,*) 'jj=nct' #ifdef MPI C Now partition the electrostatic-interaction array npept=nct-nnt - nele_int_tot=(npept-ispp)*(npept-ispp+1)/2 - call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde) + nele_int_tot=int(npept-ispp,8)*int(npept-ispp+1,8)/2 + call int_bounds8(nele_int_tot,my_ele_inds,my_ele_inde) if (lprint) & write (*,*) 'Processor',fg_rank,' CG group',kolor, & ' absolute rank',MyRank, @@ -611,14 +613,14 @@ C Now partition the electrostatic-interaction array ind_eleint_old=0 do i=nnt,nct-3 ijunk=0 - call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i, + call int_partition8(ind_eleint,my_ele_inds,my_ele_inde,i, & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13) enddo ! i 13 continue if (iatel_s.eq.0) iatel_s=1 - nele_int_tot_vdw=(npept-2)*(npept-2+1)/2 + nele_int_tot_vdw=int(npept-2,8)*int(npept-2+1,8)/2 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw - call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw) + call int_bounds8(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw) c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw, c & " my_ele_inde_vdw",my_ele_inde_vdw ind_eleint_vdw=0 @@ -627,7 +629,7 @@ c & " my_ele_inde_vdw",my_ele_inde_vdw iatel_e_vdw=0 do i=nnt,nct-3 ijunk=0 - call int_partition(ind_eleint_vdw,my_ele_inds_vdw, + call int_partition8(ind_eleint_vdw,my_ele_inds_vdw, & my_ele_inde_vdw,i, & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i), & ielend_vdw(i),*15) @@ -655,15 +657,15 @@ c & " ielend_vdw",ielend_vdw(i) & ' absolute rank',MyRank write (iout,*) 'Electrostatic interaction array:' do i=iatel_s,iatel_e - write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i) + write (iout,'(i7,2(2x,2i7))') i,ielstart(i),ielend(i) enddo endif ! lprint c iscp=3 iscp=2 C Partition the SC-p interaction array #ifdef MPI - nscp_int_tot=(npept-iscp+1)*(npept-iscp+1) - call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde) + nscp_int_tot=int(npept-iscp+1,8)*int(npept-iscp+1,8) + call int_bounds8(nscp_int_tot,my_scp_inds,my_scp_inde) if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor, & ' absolute rank',myrank, & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds, @@ -675,20 +677,20 @@ C Partition the SC-p interaction array do i=nnt,nct-1 if (i.lt.nnt+iscp) then cd write (iout,*) 'i.le.nnt+iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, + call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i, & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1), & iscpend(i,1),*14) else if (i.gt.nct-iscp) then cd write (iout,*) 'i.gt.nct-iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, + call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i, & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), & iscpend(i,1),*14) else - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, + call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i, & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), & iscpend(i,1),*14) ii=nscp_gr(i)+1 - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, + call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i, & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii), & iscpend(i,ii),*14) endif @@ -719,7 +721,7 @@ cd write (iout,*) 'i.gt.nct-iscp' if (lprint) then write (iout,'(a)') 'SC-p interaction array:' do i=iatscp_s,iatscp_e - write (iout,'(i3,2(2x,2i3))') + write (iout,'(i7,2(2x,2i7))') & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) enddo endif ! lprint @@ -782,24 +784,24 @@ c & " ivec_start",ivec_start," ivec_end",ivec_end endif c nsumgrad=(nres-nnt)*(nres-nnt+1)/2 c nlen=nres-nnt+1 - nsumgrad=(nres-nnt)*(nres-nnt+1)/2 - nlen=nres-nnt+1 - call int_bounds(nsumgrad,ngrad_start,ngrad_end) - igrad_start=((2*nlen+1) - & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2 - jgrad_start(igrad_start)= - & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2 - & +igrad_start - jgrad_end(igrad_start)=nres - igrad_end=((2*nlen+1) - & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2 - if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1 - jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2 - & +igrad_end - do i=igrad_start+1,igrad_end-1 - jgrad_start(i)=i+1 - jgrad_end(i)=nres - enddo +c nsumgrad=(nres-nnt)*(nres-nnt+1)/2 +c nlen=nres-nnt+1 +c call int_bounds(nsumgrad,ngrad_start,ngrad_end) +c igrad_start=((2*nlen+1) +c & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2 +c jgrad_start(igrad_start)= +c & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2 +c & +igrad_start +c jgrad_end(igrad_start)=nres +c igrad_end=((2*nlen+1) +c & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2 +c if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1 +c jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2 +c & +igrad_end +c do i=igrad_start+1,igrad_end-1 +c jgrad_start(i)=i+1 +c jgrad_end(i)=nres +c enddo if (lprint) then write (*,*) 'Processor:',fg_rank,' CG group',kolor, & ' absolute rank',myrank, @@ -818,13 +820,13 @@ c nlen=nres-nnt+1 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end', & ithetaconstr_end - write (*,*) 'Processor:',fg_rank,myrank,' igrad_start', - & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start, - & ' ngrad_end',ngrad_end - do i=igrad_start,igrad_end - write(*,*) 'Processor:',fg_rank,myrank,i, - & jgrad_start(i),jgrad_end(i) - enddo +c write (*,*) 'Processor:',fg_rank,myrank,' igrad_start', +c & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start, +c & ' ngrad_end',ngrad_end +c do i=igrad_start,igrad_end +c write(*,*) 'Processor:',fg_rank,myrank,i, +c & jgrad_start(i),jgrad_end(i) +c enddo endif if (nfgtasks.gt.1) then call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1, @@ -1502,6 +1504,31 @@ c--------------------------------------------------------------------------- return end c--------------------------------------------------------------------------- + subroutine int_bounds8(total_ints,lower_bound,upper_bound) + implicit none + include 'DIMENSIONS' + include 'mpif.h' + include 'COMMON.SETUP' + integer*8 total_ints,lower_bound,upper_bound,nint + integer*8 int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs) + integer i,nexcess + nint=total_ints/nfgtasks + do i=1,nfgtasks + int4proc(i-1)=nint + enddo + nexcess=total_ints-nint*nfgtasks + do i=1,nexcess + int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1 + enddo + lower_bound=0 + do i=0,fg_rank-1 + lower_bound=lower_bound+int4proc(i) + enddo + upper_bound=lower_bound+int4proc(fg_rank) + lower_bound=lower_bound+1 + return + end +c--------------------------------------------------------------------------- subroutine int_bounds1(total_ints,lower_bound,upper_bound) implicit none include 'DIMENSIONS' @@ -1566,6 +1593,47 @@ c--------------------------------------------------------------------------- endif return end +c--------------------------------------------------------------------------- + subroutine int_partition8(int_index,lower_index,upper_index,atom, + & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*) + implicit none + include 'DIMENSIONS' + include 'COMMON.IOUNITS' + integer*8 int_index,lower_index,upper_index + integer atom,at_start,at_end, + & first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old + logical lprn + lprn=.false. + if (lprn) write (iout,*) 'int_index=',int_index + int_index_old=int_index + int_index=int_index+last_atom-first_atom+1 + if (lprn) + & write (iout,*) 'int_index=',int_index, + & ' int_index_old',int_index_old, + & ' lower_index=',lower_index, + & ' upper_index=',upper_index, + & ' atom=',atom,' first_atom=',first_atom, + & ' last_atom=',last_atom + if (int_index.ge.lower_index) then + int_gr=int_gr+1 + if (at_start.eq.0) then + at_start=atom + jat_start=first_atom-1+lower_index-int_index_old + else + jat_start=first_atom + endif + if (lprn) write (iout,*) 'jat_start',jat_start + if (int_index.ge.upper_index) then + at_end=atom + jat_end=first_atom-1+upper_index-int_index_old + return1 + else + jat_end=last_atom + endif + if (lprn) write (iout,*) 'jat_end',jat_end + endif + return + end #endif c------------------------------------------------------------------------------ subroutine hpb_partition diff --git a/source/unres/src-HCD-5D/lagrangian_lesyng.F b/source/unres/src-HCD-5D/lagrangian_lesyng.F index 1180645..6dd113b 100644 --- a/source/unres/src-HCD-5D/lagrangian_lesyng.F +++ b/source/unres/src-HCD-5D/lagrangian_lesyng.F @@ -8,7 +8,7 @@ c------------------------------------------------------------------------- include 'DIMENSIONS' #ifdef MPI include 'mpif.h' - integer time00 + double precision time00 #endif include 'COMMON.VAR' include 'COMMON.CHAIN' @@ -55,7 +55,7 @@ c------------------------------------------------------------------------- #endif #ifdef FIVEDIAG call grad_transform - d_a=0.0d0 + d_a(:,:2*nres)=0.0d0 if (lprn) then write (iout,*) "Potential forces backbone" do i=1,nres @@ -459,9 +459,9 @@ c write (iout,*) "i",i," itype",itype(i),ntyp1 endif enddo enddo - DMorig=DM - DU1orig=DU1 - DU2orig=DU2 + DMorig(:2*nres)=DM(:2*nres) + DU1orig(:2*nres)=DU1(:2*nres) + DU2orig(:2*nres)=DU2(:2*nres) if (gmatout) then write (iout,*)"The upper part of the five-diagonal inertia matrix" endif @@ -886,6 +886,9 @@ c--------------------------------------------------------------------------- c--------------------------------------------------------------------------- subroutine fivediaginv_mult(ndim,forces,d_a_vec) implicit none +#ifdef MPI + include 'mpif.h' +#endif include 'DIMENSIONS' include 'COMMON.CHAIN' include 'COMMON.IOUNITS' @@ -896,7 +899,12 @@ c--------------------------------------------------------------------------- double precision forces(3*ndim),accel(3,0:maxres2),rs(ndim), & xsolv(ndim),d_a_vec(6*nres) integer i,j,ind,ichain,n,iposc,innt,inct,inct_prev - accel=0.0d0 +#ifdef TIMING + include 'COMMON.TIME1' + double precision time01 + time01=MPI_Wtime() +#endif + accel(:,:2*nres)=0.0d0 do j=1,3 Compute accelerations in Calpha and SC do ichain=1,nchain @@ -996,6 +1004,9 @@ C Convert d_a to virtual-bon-vector basis ind=ind+3 endif enddo +#ifdef TIMING + time_ginvmult=time_ginvmult+MPI_Wtime()-time01 +#endif #ifdef DEBUG write (iout,*) "d_a_vec" write (iout,'(3f10.5)') (d_a_vec(j),j=1,3*(nct-nnt+nside)) diff --git a/source/unres/src-HCD-5D/make_xx_list.F b/source/unres/src-HCD-5D/make_xx_list.F index 480aeb2..a1f6b45 100644 --- a/source/unres/src-HCD-5D/make_xx_list.F +++ b/source/unres/src-HCD-5D/make_xx_list.F @@ -22,6 +22,7 @@ ! print *,"START make_SC" #ifdef DEBUG write (iout,*) "make_SCSC_inter_list maxint_res",maxint_res + write (iout,*) "iatsc_s",iatsc_s," iatsc_e",iatsc_e #endif r_buff_list=5.0d0 ilist_sc=0 @@ -100,9 +101,9 @@ #ifdef MPI #ifdef DEBUG write (iout,*) "before MPIREDUCE",ilist_sc - do i=1,ilist_sc - write (iout,*) i,contlisti(i),contlistj(i) - enddo +c do i=1,ilist_sc +c write (iout,*) i,contlisti(i),contlistj(i) +c enddo #endif if (nfgtasks.gt.1)then @@ -171,10 +172,226 @@ c write (iout,*) "SCSC after bcast ierr",ierr write (iout,*) i,newcontlisti(i),newcontlistj(i) enddo #endif - call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end) + call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end) +#ifdef DEBUG + write (iout,*) "g_listscsc_start",g_listscsc_start, + & "g_listscsc_end",g_listscsc_end return +#endif end -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine make_SCSC_inter_list_RESPA + implicit none + include "DIMENSIONS" +#ifdef MPI + include 'mpif.h' + include "COMMON.SETUP" +#endif + include "COMMON.CONTROL" + include "COMMON.CHAIN" + include "COMMON.INTERACT" + include "COMMON.SPLITELE" + include "COMMON.IOUNITS" + double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe, + & xj_temp,yj_temp,zj_temp + double precision dist_init, dist_temp,r_buff_list + integer contlisti_long(maxint_res*maxres), + & contlisti_short(maxint_res*maxres), + & contlistj_long(maxint_res*maxres), + & contlistj_short(maxint_res*maxres) +! integer :: newcontlisti(200*nres),newcontlistj(200*nres) + integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, + & ilist_sc_long,g_ilist_sc_long,ilist_sc_short,g_ilist_sc_short + integer displ(0:max_fg_procs),i_ilist_sc_long(0:max_fg_procs), + & i_ilist_sc_short(0:max_fg_procs),ierr + logical lprn /.false./ + double precision boxshift + double precision d_scale,r_respa_buf +! print *,"START make_SC" +#ifdef DEBUG + write (iout,*) "make_SCSC_inter_list maxint_res",maxint_res + write (iout,*) "iatsc_s",iatsc_s," iatsc_e",iatsc_e +#endif + r_buff_list=5.0d0 + r_respa_buf=rlamb + ilist_sc_long=0 + ilist_sc_short=0 + do i=iatsc_s,iatsc_e + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + call to_box(xi,yi,zi) + do iint=1,nint_gr(i) + do j=istart(i,iint),iend(i,iint) + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + dist_init=dsqrt(xj*xj+yj*yj+zj*zj) +! r_buff_list is a read value for a buffer + if (dist_init.le.(r_cut_int+r_buff_list)) then +! Here the list is created + d_scale=dist_init/sigmaii(itypi,itypj) + if (d_scale.le.r_cut_respa+r_respa_buf) then + ilist_sc_short=ilist_sc_short+1 + contlisti_short(ilist_sc_short)=i + contlistj_short(ilist_sc_short)=j + endif + if (d_scale.gt.r_cut_respa-rlamb-r_respa_buf) then + ilist_sc_long=ilist_sc_long+1 +! this can be substituted by cantor and anti-cantor + contlisti_long(ilist_sc_long)=i + contlistj_long(ilist_sc_long)=j + endif + endif + enddo + enddo + enddo +#ifdef MPI +#ifdef DEBUG + write (iout,*) "before MPIREDUCE ilist_sc_long",ilist_sc_long +c do i=1,ilist_sc_long +c write (iout,*) i,contlisti_long(i),contlistj_long(i) +c enddo + write (iout,*) "before MPIREDUCE ilist_sc_short",ilist_sc_short +c do i=1,ilist_sc_short +c write (iout,*) i,contlisti_short(i),contlistj_short(i) +c enddo +#endif + if (nfgtasks.gt.1)then + + call MPI_Reduce(ilist_sc_long,g_ilist_sc_long,1, + & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) + call MPI_Reduce(ilist_sc_short,g_ilist_sc_short,1, + & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +c write (iout,*) "SCSC after reduce ierr",ierr + if (fg_rank.eq.0.and.(g_ilist_sc_long.gt.maxres*maxint_res .or. + & g_ilist_sc_short.gt.maxres*maxint_res)) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many SCSC interactions", + & g_ilist_sc_long,g_ilist_sc_short, + & " only",maxres*maxint_res," allowed." + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many SCSC interactions", + & g_ilist_sc_long+g_ilist_sc_short," only", + & maxres*maxint_res," allowed." + write (*,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif +c write(iout,*) "before bcast",g_ilist_sc_long + call MPI_Gather(ilist_sc_long,1,MPI_INTEGER, + & i_ilist_sc_long,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "SCSC after gather ierr",ierr + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_sc_long(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlisti_long,ilist_sc_long,MPI_INTEGER, + & newcontlisti_long,i_ilist_sc_long,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCSC after gatherv ierr",ierr + call MPI_Gatherv(contlistj_long,ilist_sc_long,MPI_INTEGER, + & newcontlistj_long,i_ilist_sc_long,displ,MPI_INTEGER, + & king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_sc_long,1,MPI_INT,king,FG_COMM,IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr +! write(iout,*) "before bcast",g_ilist_sc_long +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlisti_long,g_ilist_sc_long,MPI_INT,king, + & FG_COMM,IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr + call MPI_Bcast(newcontlistj_long,g_ilist_sc_long,MPI_INT,king, + & FG_COMM,IERR) +c write (iout,*) "SCSC after bcast ierr",ierr +! write(iout,*) "before gather",displ(0),displ(1) +c write(iout,*) "before bcast",g_ilist_sc_short + call MPI_Gather(ilist_sc_short,1,MPI_INTEGER, + & i_ilist_sc_short,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "SCSC after gather ierr",ierr + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_sc_short(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlisti_short,ilist_sc_short,MPI_INTEGER, + & newcontlisti_short,i_ilist_sc_short,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCSC after gatherv ierr",ierr + call MPI_Gatherv(contlistj_short,ilist_sc_short,MPI_INTEGER, + & newcontlistj_short,i_ilist_sc_short,displ,MPI_INTEGER, + & king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_sc_short,1,MPI_INT,king,FG_COMM,IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr +! write(iout,*) "before bcast",g_ilist_sc_short +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlisti_short,g_ilist_sc_short,MPI_INT,king, + & FG_COMM,IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr + call MPI_Bcast(newcontlistj_short,g_ilist_sc_short,MPI_INT,king, + ^ FG_COMM,IERR) +c write (iout,*) "SCSC after bcast ierr",ierr + else +#endif + g_ilist_sc_long=ilist_sc_long + + do i=1,ilist_sc_long + newcontlisti_long(i)=contlisti_long(i) + newcontlistj_long(i)=contlistj_long(i) + enddo + + g_ilist_sc_short=ilist_sc_short + + do i=1,ilist_sc_short + newcontlisti_short(i)=contlisti_short(i) + newcontlistj_short(i)=contlistj_short(i) + enddo +#ifdef MPI + endif +#endif + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + & write (iout,'(a30,2i10,a,2i4)') + & "Number of long- and short-range SC-SC interactions", + & g_ilist_sc_long,g_ilist_sc_short," per residue on average", + & g_ilist_sc_long/nres,g_ilist_sc_short/nres +#ifdef DEBUG + write (iout,*) + & "make_SCSC_inter_list: g_ilist_sc_long after GATHERV", + & g_ilist_sc_long + write (iout,*) "List of long-range SCSC interactions" + do i=1,g_ilist_sc_long + write (iout,*) i,newcontlisti_long(i),newcontlistj_long(i) + enddo + write (iout,*) + & "make_SCSC_inter_list: g_ilist_sc_short after GATHERV", + & g_ilist_sc_short + write (iout,*) "List of short-range SCSC interactions" + do i=1,g_ilist_sc_short + write (iout,*) i,newcontlisti_short(i),newcontlistj_short(i) + enddo +#endif + call int_bounds(g_ilist_sc_long,g_listscsc_start_long, + & g_listscsc_end_long) + call int_bounds(g_ilist_sc_short,g_listscsc_start_short, + & g_listscsc_end_short) +#ifdef DEBUG + write (iout,*) "g_list_sc_start",g_listscsc_start_long, + & "g_list_sc_end",g_listscsc_end_long + write (iout,*)"g_list_sc_start_short",g_listscsc_start_short, + & "g_list_sc_end_short",g_listscsc_end_short +#endif + return + end +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine make_SCp_inter_list implicit none include "DIMENSIONS" @@ -204,8 +421,8 @@ c & contlistscpj_f(2*maxint_res*maxres) write (iout,*) "make_SCp_inter_list maxint_res",maxint_res #endif r_buff_list=5.0 - ilist_scp=0 - ilist_scp_first=0 + ilist_scp=0 + ilist_scp_first=0 do i=iatscp_s,iatscp_e if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle xi=0.5D0*(c(1,i)+c(1,i+1)) @@ -377,11 +594,234 @@ c write (iout,*) "SCp bcast reduce ierr",ierr ! enddo #endif call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end) +#ifdef DEBUG + write (iout,*) "g_listscp_start",g_listscp_start, + & "g_listscp_end",g_listscp_end +#endif + return + end +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine make_SCp_inter_list_RESPA + implicit none + include "DIMENSIONS" +#ifdef MPI + include 'mpif.h' + include "COMMON.SETUP" +#endif + include "COMMON.CONTROL" + include "COMMON.CHAIN" + include "COMMON.INTERACT" + include "COMMON.SPLITELE" + include "COMMON.IOUNITS" + double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe, + & xj_temp,yj_temp,zj_temp + double precision dist_init, dist_temp,r_buff_list + integer contlistscpi_long(2*maxint_res*maxres), + & contlistscpi_short(2*maxint_res*maxres), + & contlistscpj_long(2*maxint_res*maxres), + & contlistscpj_short(2*maxint_res*maxres) +! integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres) + integer i,j,iteli,itypj,subchap,xshift,yshift,zshift,iint, + & ilist_scp_long,ilist_scp_short,g_ilist_scp_long,g_ilist_scp_short + integer displ(0:max_fg_procs),i_ilist_scp_long(0:max_fg_procs), + & i_ilist_scp_short(0:max_fg_procs),ierr +c integer contlistscpi_f(2*maxint_res*maxres), +c & contlistscpj_f(2*maxint_res*maxres) + double precision boxshift + double precision d_scale,r_respa_buf +! print *,"START make_SC" +#ifdef DEBUG + write (iout,*) "make_SCp_inter_list maxint_res",maxint_res +#endif + r_buff_list=5.0 + r_respa_buf=rlamb + ilist_scp_long=0 + ilist_scp_short=0 + do i=iatscp_s,iatscp_e + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle + 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)) + call to_box(xi,yi,zi) + iteli=itel(i) + do iint=1,nscp_gr(i) + do j=iscpstart(i,iint),iscpend(i,iint) + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle +! Uncomment following three lines for SC-p interactions +! xj=c(1,nres+j)-xi +! yj=c(2,nres+j)-yi +! zj=c(3,nres+j)-zi +! 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) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + dist_init=dsqrt(xj*xj+yj*yj+zj*zj) +! r_buff_list is a read value for a buffer + if (dist_init.le.(r_cut_int+r_buff_list)) then + d_scale=dist_init/rscp(itypj,iteli) + if (d_scale.le.r_cut_respa+r_respa_buf) then +! Here the list is created + ilist_scp_short=ilist_scp_short+1 + contlistscpi_short(ilist_scp_short)=i + contlistscpj_short(ilist_scp_short)=j + endif + if (d_scale.gt.r_cut_respa-rlamb-r_respa_buf) then +! this can be substituted by cantor and anti-cantor + ilist_scp_long=ilist_scp_long+1 + contlistscpi_long(ilist_scp_long)=i + contlistscpj_long(ilist_scp_long)=j + endif + endif + enddo + enddo + enddo +#ifdef MPI +#ifdef DEBUG + write (iout,*) "before MPIREDUCE",ilist_scp_long,ilist_scp_short + write (iout,*) "Long-range scp interaction list" + do i=1,ilist_scp_long + write (iout,*) i,contlistscpi_long(i),contlistscpj_long(i) + enddo + write (iout,*) "Short-range scp interaction list" + do i=1,ilist_scp_short + write (iout,*) i,contlistscpi_short(i),contlistscpj_short(i) + enddo +#endif + if (nfgtasks.gt.1)then + + call MPI_Reduce(ilist_scp_long,g_ilist_scp_long,1, + & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) + call MPI_Reduce(ilist_scp_short,g_ilist_scp_short,1, + & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +c write (iout,*) "SCp after reduce ierr",ierr + if (fg_rank.eq.0.and.(g_ilist_scp_long.gt. + & 2*maxres*maxint_res .or. g_ilist_scp_short.gt. + & 2*maxres*maxint_res)) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many SCp interactions", + & g_ilist_scp_long+g_ilist_scp_short," only", + & 2*maxres*maxint_res," allowed." + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many SCp interactions", + & g_ilist_scp_long+g_ilist_scp_short," only", + & 2*maxres*maxint_res," allowed." + write (*,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif +c write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_scp_long,1,MPI_INTEGER, + & i_ilist_scp_long,1,MPI_INTEGER,king,FG_COMM,IERR) + call MPI_Gather(ilist_scp_short,1,MPI_INTEGER, + & i_ilist_scp_short,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "SCp after gather ierr",ierr + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_scp_long(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistscpi_long,ilist_scp_long,MPI_INTEGER, + & newcontlistscpi_long,i_ilist_scp_long,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr + call MPI_Gatherv(contlistscpj_long,ilist_scp_long,MPI_INTEGER, + & newcontlistscpj_long,i_ilist_scp_long,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr + call MPI_Bcast(g_ilist_scp_long,1,MPI_INT,king,FG_COMM,IERR) +c write (iout,*) "SCp after bcast ierr",ierr +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistscpi_long,g_ilist_scp_long,MPI_INT, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after bcast ierr",ierr + call MPI_Bcast(newcontlistscpj_long,g_ilist_scp_long,MPI_INT, + & king,FG_COMM,IERR) +c write (iout,*) "SCp bcast reduce ierr",ierr +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_scp_short(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistscpi_short,ilist_scp_short,MPI_INTEGER, + & newcontlistscpi_short,i_ilist_scp_short,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr + call MPI_Gatherv(contlistscpj_short,ilist_scp_short,MPI_INTEGER, + & newcontlistscpj_short,i_ilist_scp_short,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr + call MPI_Bcast(g_ilist_scp_short,1,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistscpi_short,g_ilist_scp_short,MPI_INT, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after bcast ierr",ierr + call MPI_Bcast(newcontlistscpj_short,g_ilist_scp_short,MPI_INT, + & king,FG_COMM,IERR) + else +#endif + g_ilist_scp_long=ilist_scp_long + + do i=1,ilist_scp_long + newcontlistscpi_long(i)=contlistscpi_long(i) + newcontlistscpj_long(i)=contlistscpj_long(i) + enddo + g_ilist_scp_short=ilist_scp_short + + do i=1,ilist_scp_short + newcontlistscpi_short(i)=contlistscpi_short(i) + newcontlistscpj_short(i)=contlistscpj_short(i) + enddo +#ifdef MPI + endif +#endif + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,'(a30,i10,a,i4)') + & "Number of long-range SC-p interactions", + & g_ilist_scp_long," per residue on average",g_ilist_scp_long/nres + write (iout,'(a30,i10,a,i4)') + & "Number of short-range SC-p interactions", + &g_ilist_scp_short," per residue on average",g_ilist_scp_short/nres + endif +#ifdef DEBUG + write (iout,*) "make_SCp_inter_list: after GATHERV long-range", + & g_ilist_scp_long + do i=1,g_ilist_scp_long + write (iout,*) i,newcontlistscpi_long(i),newcontlistscpj_long(i) + enddo + write (iout,*) "make_SCp_inter_list: after GATHERV short-range", + & g_ilist_scp_short + do i=1,g_ilist_scp_short + write (iout,*) i,newcontlistscpi_short(i), + & newcontlistscpj_short(i) + enddo +#endif + call int_bounds(g_ilist_scp_long,g_listscp_start_long, + & g_listscp_end_long) + call int_bounds(g_ilist_scp_short,g_listscp_start_short, + & g_listscp_end_short) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,*) "g_listscp_start",g_listscp_start_long, + & "g_listscp_end",g_listscp_end_long + write (iout,*)"g_listscp_start_short",g_listscp_start_short, + & "g_listscp_end_short",g_listscp_end_short + endif return end !----------------------------------------------------------------------------- - subroutine make_pp_vdw_inter_list + subroutine make_pp_vdw_inter_list_RESPA implicit none include "DIMENSIONS" #ifdef MPI @@ -398,164 +838,148 @@ c write (iout,*) "SCp bcast reduce ierr",ierr double precision xmedj,ymedj,zmedj double precision dist_init, dist_temp,r_buff_list,dxi,dyi,dzi, & xmedi,ymedi,zmedi - double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj, - & dx_normj,dy_normj,dz_normj - integer contlistpp_vdwi(maxint_res*maxres), - & contlistpp_vdwj(maxint_res*maxres) -! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres) + double precision dxj,dyj,dzj + integer contlistpp_vdwi_short(maxint_res*maxres), + & contlistpp_vdwj_short(maxint_res*maxres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, - & ilist_pp_vdw,g_ilist_pp_vdw - integer displ(0:max_fg_procs),i_ilist_pp_vdw(0:max_fg_procs),ierr + & ilist_pp_vdw_short,g_ilist_pp_vdw_short + integer displ(0:max_fg_procs), + & i_ilist_pp_vdw_short(0:max_fg_procs),ierr ! print *,"START make_SC" + double precision boxshift + double precision d_scale,r_respa_buf #ifdef DEBUG write (iout,*) "make_pp_vdw_inter_list" #endif - ilist_pp_vdw=0 + ilist_pp_vdw_short=0 r_buff_list=5.0 + r_respa_buf=rlamb do i=iatel_s_vdw,iatel_e_vdw if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi - xmedi=dmod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=dmod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=dmod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize + call to_box(xmedi,ymedi,zmedi) do j=ielstart_vdw(i),ielend_vdw(i) ! write (iout,*) i,j,itype(i),itype(j) if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle - ! 1,j) dxj=dc(1,j) dyj=dc(2,j) dzj=dc(3,j) - dx_normj=dc_norm(1,j) - dy_normj=dc_norm(2,j) - dz_normj=dc_norm(3,j) ! xj=c(1,j)+0.5D0*dxj-xmedi ! yj=c(2,j)+0.5D0*dyj-ymedi ! zj=c(3,j)+0.5D0*dzj-zmedi 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 - 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 - endif - enddo - enddo - enddo + call to_box(xj,yj,zj) + xj=boxshift(xj-xmedi,boxxsize) + yj=boxshift(yj-ymedi,boxysize) + zj=boxshift(zj-zmedi,boxzsize) + dist_init=dsqrt(xj*xj+yj*yj+zj*zj) - if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then + if (dist_init.le.(r_cut_int+r_buff_list)) then + d_scale=dist_init/rpp(itel(i),itel(j)) + if (d_scale.le.r_cut_respa+r_respa_buf) then ! Here the list is created - ilist_pp_vdw=ilist_pp_vdw+1 + ilist_pp_vdw_short=ilist_pp_vdw_short+1 ! this can be substituted by cantor and anti-cantor - contlistpp_vdwi(ilist_pp_vdw)=i - contlistpp_vdwj(ilist_pp_vdw)=j + contlistpp_vdwi_short(ilist_pp_vdw_short)=i + contlistpp_vdwj_short(ilist_pp_vdw_short)=j + endif endif - enddo - enddo + enddo + enddo ! enddo #ifdef MPI #ifdef DEBUG - write (iout,*) "before MPIREDUCE",ilist_pp_vdw - do i=1,ilist_pp_vdw - write (iout,*) i,contlistpp_vdwi(i),contlistpp_vdwj(i) + write (iout,*) "before MPIREDUCE longrange",ilist_pp_vdw_long + do i=1,ilist_pp_vdw_long + write (iout,*) i,contlistpp_vdwi_long(i),contlistpp_vdwj_long(i) + enddo + write (iout,*) "before MPIREDUCE shortrange",ilist_pp_vdw_short + do i=1,ilist_pp_vdw_short + write (iout,*) i,contlistpp_vdwi_short(i), + & contlistpp_vdwj_short(i) enddo #endif if (nfgtasks.gt.1)then - call MPI_Reduce(ilist_pp_vdw,g_ilist_pp_vdw,1, + call MPI_Reduce(ilist_pp_vdw_short,g_ilist_pp_vdw_short,1, & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) - if (fg_rank.eq.0.and.g_ilist_pp_vdw.gt.maxres*maxint_res) then + if (fg_rank.eq.0.and.g_ilist_pp_vdw_short.gt.maxres*maxint_res) + & then if ((me.eq.king.or.out1file).and.energy_dec) then write (iout,*) "Too many pp VDW interactions", - & g_ilist_pp_vdw," only",maxres*maxint_res," allowed." + & g_ilist_pp_vdw_short," only",maxres*maxint_res," allowed." write (iout,*) "Specify a smaller r_cut_int and resubmit" call flush(iout) endif write (*,*) "Processor:",me,": Too many pp VDW interactions", - & g_ilist_pp_vdw," only",maxres*maxint_res," allowed." + & g_ilist_pp_vdw_short," only",maxres*maxint_res," allowed." write (8,*) "Specify a smaller r_cut_int and resubmit" call MPI_Abort(MPI_COMM_WORLD,ierr) endif ! write(iout,*) "before bcast",g_ilist_sc - call MPI_Gather(ilist_pp_vdw,1,MPI_INTEGER, - & i_ilist_pp_vdw,1,MPI_INTEGER,king,FG_COMM,IERR) + call MPI_Gather(ilist_pp_vdw_short,1,MPI_INTEGER, + & i_ilist_pp_vdw_short,1,MPI_INTEGER,king,FG_COMM,IERR) displ(0)=0 do i=1,nfgtasks-1,1 - displ(i)=i_ilist_pp_vdw(i-1)+displ(i-1) + displ(i)=i_ilist_pp_vdw_short(i-1)+displ(i-1) enddo ! write(iout,*) "before gather",displ(0),displ(1) - call MPI_Gatherv(contlistpp_vdwi,ilist_pp_vdw,MPI_INTEGER, - & newcontlistpp_vdwi,i_ilist_pp_vdw,displ,MPI_INTEGER, - & king,FG_COMM,IERR) - call MPI_Gatherv(contlistpp_vdwj,ilist_pp_vdw,MPI_INTEGER, - & newcontlistpp_vdwj,i_ilist_pp_vdw,displ,MPI_INTEGER, - & king,FG_COMM,IERR) - call MPI_Bcast(g_ilist_pp_vdw,1,MPI_INT,king,FG_COMM,IERR) + call MPI_Gatherv(contlistpp_vdwi_short,ilist_pp_vdw_short, + & MPI_INTEGER,newcontlistpp_vdwi_short,i_ilist_pp_vdw_short,displ, + & MPI_INTEGER,king,FG_COMM,IERR) + call MPI_Gatherv(contlistpp_vdwj_short,ilist_pp_vdw_short, + & MPI_INTEGER,newcontlistpp_vdwj_short,i_ilist_pp_vdw_short,displ, + & MPI_INTEGER,king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_pp_vdw_short,1,MPI_INT,king,FG_COMM,IERR) ! write(iout,*) "before bcast",g_ilist_sc ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) - call MPI_Bcast(newcontlistpp_vdwi,g_ilist_pp_vdw,MPI_INT,king, - & FG_COMM,IERR) - call MPI_Bcast(newcontlistpp_vdwj,g_ilist_pp_vdw,MPI_INT,king, - & FG_COMM,IERR) - + call MPI_Bcast(newcontlistpp_vdwi_short,g_ilist_pp_vdw_short, + & MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistpp_vdwj_short,g_ilist_pp_vdw_short, + & MPI_INT,king,FG_COMM,IERR) ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) - - else + else #endif - g_ilist_pp_vdw=ilist_pp_vdw + g_ilist_pp_vdw_short=ilist_pp_vdw_short - do i=1,ilist_pp_vdw - newcontlistpp_vdwi(i)=contlistpp_vdwi(i) - newcontlistpp_vdwj(i)=contlistpp_vdwj(i) + do i=1,ilist_pp_vdw_short + newcontlistpp_vdwi_short(i)=contlistpp_vdwi_short(i) + newcontlistpp_vdwj_short(i)=contlistpp_vdwj_short(i) enddo #ifdef MPI - endif + endif #endif - call int_bounds(g_ilist_pp_vdw,g_listpp_vdw_start, - & g_listpp_vdw_end) - if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) - &write (iout,'(a30,i10,a,i4)') "Number of p-p VDW interactions", - & g_ilist_pp_vdw," per residue on average",g_ilist_pp_vdw/nres + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,*) "Number of short-range p-p VDW interactions", + & g_ilist_pp_vdw_short," per residue on average", + & g_ilist_pp_vdw_short/nres + endif #ifdef DEBUG - write (iout,*) "g_listpp_vdw_start",g_listpp_vdw_start, - & "g_listpp_vdw_end",g_listpp_vdw_end + write (iout,*) "Short-range pp_vdw" write (iout,*) "make_pp_vdw_inter_list: after GATHERV", - & g_ilist_pp_vdw - do i=1,g_ilist_pp_vdw - write (iout,*) i,newcontlistpp_vdwi(i),newcontlistpp_vdwj(i) + & g_ilist_pp_vdw_short + do i=1,g_ilist_pp_vdw_short + write (iout,*) i,newcontlistpp_vdwi_short(i), + & newcontlistpp_vdwj_short(i) enddo #endif + call int_bounds(g_ilist_pp_vdw_short,g_listpp_vdw_start_short, + & g_listpp_vdw_end_short) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,*)"g_listpp_vdw_start_short", + & g_listpp_vdw_start_short, + & "g_listpp_vdw_end_short",g_listpp_vdw_end_short + endif return end !----------------------------------------------------------------------------- @@ -716,18 +1140,17 @@ c write (iout,*) "After bcast ierr",ierr ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) - else + else #endif g_ilist_pp=ilist_pp do i=1,ilist_pp - newcontlistppi(i)=contlistppi(i) - newcontlistppj(i)=contlistppj(i) + newcontlistppi(i)=contlistppi(i) + newcontlistppj(i)=contlistppj(i) enddo #ifdef MPI - endif + endif #endif - call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end) if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) & write (iout,'(a30,i10,a,i4)') "Number of p-p interactions", & g_ilist_pp," per residue on average",g_ilist_pp/nres @@ -737,5 +1160,11 @@ c write (iout,*) "After bcast ierr",ierr write (iout,*) i,newcontlistppi(i),newcontlistppj(i) enddo #endif + call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,*) "g_listpp_start",g_listpp_start, + & "g_listpp_end",g_listpp_end + endif return end diff --git a/source/unres/src-HCD-5D/minimize_p.F b/source/unres/src-HCD-5D/minimize_p.F index 41a1a27..0b16d55 100644 --- a/source/unres/src-HCD-5D/minimize_p.F +++ b/source/unres/src-HCD-5D/minimize_p.F @@ -197,11 +197,11 @@ c---------------------------------------------------------------------------- #endif include 'COMMON.TIME1' double precision z(maxres6),d_a_tmp(maxres6) - double precision edum(0:n_ene),time_order(0:10) + double precision edum(0:n_ene),time_order(0:11) c double precision Gcopy(maxres2,maxres2) c common /przechowalnia/ Gcopy integer icall /0/ - integer i,j,iorder + integer i,j,iorder,ioverlap(maxres),ioverlap_last C Workers wait for variables and NF, and NFL from the boss iorder=0 do while (iorder.ge.0) @@ -301,6 +301,8 @@ c call MATOUT2(my_ng_count,dimen3,maxres2,maxers2,ginv_block) #endif else if (iorder.eq.10) then call setup_fricmat + else if (iorder.eq.11) then + call overlap_sc_list(ioverlap,ioverlap_last,.false.) endif enddo write (*,*) 'Processor',fg_rank,' CG group',kolor, diff --git a/source/unres/src-HCD-5D/orig_frame_chain.F b/source/unres/src-HCD-5D/orig_frame_chain.F new file mode 100644 index 0000000..07053ce --- /dev/null +++ b/source/unres/src-HCD-5D/orig_frame_chain.F @@ -0,0 +1,85 @@ + subroutine orig_frame_chain(istart) +C +C Define the origin and orientation of the coordinate system starting +C at residue istart and locate sites istart+1 and istart+2. The +C coordinates of site istart and the respective dc and dc_norm must be +C pre-defined +C + implicit none + integer i,j,istart,ichain + double precision cost,sint,cosg,sing,aux + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.IOUNITS' + include 'COMMON.LOCAL' + include 'COMMON.GEO' + include 'COMMON.VAR' + cost=dc_norm(1,istart) + aux=dsqrt(dc_norm(2,istart)**2+dc_norm(3,istart)**2) + cosg=dc_norm(2,istart)/aux + sing=dc_norm(3,istart)/aux + cost=dcos(theta(istart+2)) + sint=dsin(theta(istart+2)) + prod(1,1,istart)=cost + prod(1,2,istart)=-sint + prod(1,3,istart)=0.0d0 + prod(2,1,istart)=sint*cosg + prod(2,2,istart)=cost*cosg + prod(2,3,istart)=-sing + prod(3,1,istart)=sint*sing + prod(3,2,istart)=cost*sing + prod(3,3,istart)=cosg + aux=prod(1,1,istart)*(prod(2,2,istart)*prod(3,3,istart) + & -prod(3,2,istart)*prod(2,3,istart)) + & -prod(1,2,istart)*(prod(2,1,istart)*prod(3,3,istart) + & -prod(3,1,istart)*prod(2,3,istart)) + & +prod(1,3,istart)*(prod(2,1,istart)*prod(3,2,istart) + & -prod(3,1,istart)*prod(2,2,istart)) +c write (iout,*) "orig_frame_chain prod",istart +c do i=1,3 +c write(iout,'(i5,3f10.5)') i,(prod(i,j,istart),j=1,3) +c enddo +c write (iout,*) "orig_frame_chain: prod",istart," determinant",aux + t(1,1,istart)=cost + t(1,2,istart)=-sint + t(1,3,istart)= 0.0D0 + t(2,1,istart)=sint + t(2,2,istart)=cost + t(2,3,istart)= 0.0D0 + t(3,1,istart)= 0.0D0 + t(3,2,istart)= 0.0D0 + t(3,3,istart)= 1.0D0 + r(1,1,istart)= 1.0D0 + r(1,2,istart)= 0.0D0 + r(1,3,istart)= 0.0D0 + r(2,1,istart)= 0.0D0 + r(2,2,istart)= 1.0D0 + r(2,3,istart)= 0.0D0 + r(3,1,istart)= 0.0D0 + r(3,2,istart)= 0.0D0 + r(3,3,istart)= 1.0D0 + do i=1,3 + do j=1,3 + rt(i,j,istart)=t(i,j,istart) + enddo + enddo + call matmult(prod(1,1,istart),rt(1,1,istart),prod(1,1,istart+1)) +c aux=prod(1,1,istart+1)*(prod(2,2,istart+1)*prod(3,3,istart+1) +c & -prod(3,2,istart+1)*prod(2,3,istart+1)) +c & -prod(1,2,istart+1)*(prod(2,1,istart+1)*prod(3,3,istart+1) +c & -prod(3,1,istart+1)*prod(2,3,istart+1)) +c & +prod(1,3,istart+1)*(prod(2,1,istart+1)*prod(3,2,istart+1) +c & -prod(3,1,istart+1)*prod(2,2,istart+1)) +c write (iout,*) "orig_frame_chain prod",istart+1 +c do i=1,3 +c write(iout,'(i5,3f10.5)') i,(prod(i,j,istart+1),j=1,3) +c enddo +c write (iout,*)"orig_frame_chain: prod",istart+1," determinant",aux + do j=1,3 + dc_norm(j,istart+1)=prod(j,1,istart+1) + dc(j,istart+1)=vbld(istart+2)*prod(j,1,istart+1) + c(j,istart+2)=c(j,istart+1)+dc(j,istart+1) + enddo + call locate_side_chain(istart+1) + return + end diff --git a/source/unres/src-HCD-5D/readpdb-mult.F b/source/unres/src-HCD-5D/readpdb-mult.F index 41fe7f6..12d011e 100644 --- a/source/unres/src-HCD-5D/readpdb-mult.F +++ b/source/unres/src-HCD-5D/readpdb-mult.F @@ -64,9 +64,9 @@ c call flush(iout) iterter(ires_old-1)=1 itype(ires_old)=ntyp1 iterter(ires_old)=1 - ishift1=ishift1+1 +c ishift1=ishift1+1 ibeg=2 - write (iout,*) "Chain ended",ires,ishift,ires_old + write (iout,*) "Chain ended",ires,ishift,ires_old,ibeg if (unres_pdb) then do j=1,3 dc(j,ires)=sccor(j,iii) @@ -95,8 +95,8 @@ c write (iout,*) "! ",atom," !",ires read (card(18:20),'(a3)') res c write (iout,*) "ires",ires,ires-ishift+ishift1, c & " ires_old",ires_old -c write (iout,*) "ishift",ishift," ishift1",ishift1 -c write (iout,*) "IRES",ires-ishift+ishift1,ires_old +c write (iout,*) "ishift",ishift," ishift1",ishift1 +c write (iout,*) "IRES",ires-ishift+ishift1,ires_old if (ires-ishift+ishift1.ne.ires_old) then ! Calculate the CM of the preceding residue. ! if (ibeg.eq.0) call sccenter(ires,iii,sccor) @@ -115,6 +115,7 @@ c write (iout,'(i5,3f10.5)') ires,(sccor(j,iii),j=1,3) sccalc=.true. endif ! Start new residue. +c write (iout,*) "ibeg",ibeg if (res.eq.'Cl-' .or. res.eq.'Na+') then ires=ires_old cycle @@ -133,10 +134,13 @@ c write (iout,*) "BEG ires",ires else if (ibeg.eq.2) then ! Start a new chain ishift=-ires_old+ires-1 !!!!! - ishift1=ishift1-1 !!!!! -c write (iout,*) "New chain started",ires,ishift,ishift1,"!" +c ishift1=ishift1-1 !!!!! +c write (iout,*) "New chain started",ires,ires_old,ishift, +c & ishift1 ires=ires-ishift+ishift1 + write (iout,*) "New chain started ires",ires ires_old=ires +c ires=ires_old+1 ibeg=0 else ishift=ishift-(ires-ishift+ishift1-ires_old-1) @@ -159,7 +163,9 @@ c write (2,*) "ires",ires," res ",res!," ity"!,ity if (atom.eq.'CA' .or. atom.eq.'CH3' .or. & res.eq.'NHE'.and.atom(:2).eq.'HN') then read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) -! write (iout,*) "backbone ",atom + read(card(61:66),*) bfac(ires) +c write (iout,*) "backbone ",atom +c write (iout,*) ires,res,(c(j,ires),j=1,3) #ifdef DEBUG write (iout,'(i6,i3,2x,a,3f8.3)') & ires,itype(ires),res,(c(j,ires),j=1,3) @@ -181,7 +187,7 @@ c write (2,*) "iii",iii endif enddo 10 if(me.eq.king.or..not.out1file) - & write (iout,'(a,i5)') ' Nres: ',ires + & write (iout,'(a,i7)') ' Nres: ',ires c write (iout,*) "iii",iii C Calculate dummy residue coordinates inside the "chain" of a multichain C system @@ -229,7 +235,7 @@ C 2/15/2013 by Adam: corrected insertion of the first dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,i)=c(j,i+1)-1.9d0*e2(j) + c(j,i)=c(j,i+1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) enddo else !unres_pdb do j=1,3 @@ -316,9 +322,9 @@ C Calculate internal coordinates. write (iout,'(/a)') & "Cartesian coordinates of the reference structure" write (iout,'(a,3(3x,a5),5x,3(3x,a5))') - & "Residue ","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" + & "Residue ","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" do ires=1,nres - write (iout,'(a3,1x,i4,3f8.3,5x,3f8.3)') + write (iout,'(a3,1x,i6,3f8.3,5x,3f8.3)') & restyp(itype(ires)),ires,(c(j,ires),j=1,3), & (c(j,ires+nres),j=1,3) enddo @@ -412,8 +418,9 @@ C and convert the peptide geometry into virtual-chain geometry. character*3 seq,res character*5 atom character*80 card - double precision sccor(3,20) + double precision sccor(3,50) integer rescode,iterter(maxres) + logical zero do i=1,maxres iterter(i)=0 enddo @@ -541,7 +548,7 @@ c write (iout,*) "sidechain ",atom endif enddo 10 if(me.eq.king.or..not.out1file) - & write (iout,'(a,i5)') ' Nres: ',ires + & write (iout,'(a,i7)') ' Nres: ',ires C Calculate dummy residue coordinates inside the "chain" of a multichain C system nres=ires @@ -581,7 +588,7 @@ C 2/15/2013 by Adam: corrected insertion of the first dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,i)=c(j,i+1)-1.9d0*e2(j) + c(j,i)=c(j,i+1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) enddo else !unres_pdb do j=1,3 @@ -616,7 +623,7 @@ C 2/15/2013 by Adam: corrected insertion of the last dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,nres)=c(j,nres-1)-1.9d0*e2(j) + c(j,nres)=c(j,nres-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0) enddo else do j=1,3 @@ -648,7 +655,7 @@ C 2/15/2013 by Adam: corrected insertion of the first dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,1)=c(j,2)-1.9d0*e2(j) + c(j,1)=c(j,2)+1.9d0*(e1(j)-e2(j))/dsqrt(2.0d0) enddo else do j=1,3 @@ -676,6 +683,18 @@ C Calculate internal coordinates. & (c(j,ires+nres),j=1,3) enddo endif + zero=.false. + do ires=1,nres + zero=zero.or.itype(ires).eq.0 + enddo + if (zero) then + write (iout,'(2a)') "Gaps in PDB coordinates detected;", + & " look for ZERO in the control output above." + write (iout,'(2a)') "Repair the PDB file using MODELLER", + & " or other softwared and resubmit." + call flush(iout) + stop + endif C Calculate internal coordinates. call int_from_cart(.true.,out_template_coord) call sc_loc_geom(.false.) @@ -683,6 +702,7 @@ C Calculate internal coordinates. thetaref(i)=theta(i) phiref(i)=phi(i) enddo + dc(:,0)=c(:,1) do i=1,nres-1 do j=1,3 dc(j,i)=c(j,i+1)-c(j,i) diff --git a/source/unres/src-HCD-5D/readrtns_CSA.F b/source/unres/src-HCD-5D/readrtns_CSA.F index 4fbc0f1..58b86cc 100644 --- a/source/unres/src-HCD-5D/readrtns_CSA.F +++ b/source/unres/src-HCD-5D/readrtns_CSA.F @@ -149,6 +149,7 @@ C constrains on theta angles WITH_THETA_CONSTR is the keyword out_template_coord = index(controlcard,"OUT_TEMPLATE_COORD").gt.0 out_template_restr = index(controlcard,"OUT_TEMPLATE_RESTR").gt.0 call readi(controlcard,'SYM',symetr,1) + call readi(controlcard,'PERMUT',npermut,1) call reada(controlcard,'TIMLIM',timlim,2800.0D0) ! default 16 hours unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0 call reada(controlcard,'SAFETY',safety,30.0D0) ! default 30 minutes @@ -167,6 +168,8 @@ c write (iout,'(a,f10.1)') 'Time limit (min):',timlim c endif call readi(controlcard,'NZ_START',nz_start,0) call readi(controlcard,'NZ_END',nz_end,0) + call readi(controlcard,'NRAN_START',nran_start,0) + write (iout,*) "nran_start",nran_start c call readi(controlcard,'IZ_SC',iz_sc,0) timlim=60.0D0*timlim safety = 60.0d0*safety @@ -481,6 +484,7 @@ C call readi(controlcard,"NSTEP",n_timestep,1000000) call readi(controlcard,"NTWE",ntwe,100) call readi(controlcard,"NTWX",ntwx,1000) + call readi(controlcard,"REST_FREQ",irest_freq,1000) call reada(controlcard,"DT",d_time,1.0d-1) call reada(controlcard,"DVMAX",dvmax,2.0d1) call reada(controlcard,"DAMAX",damax,1.0d1) @@ -556,6 +560,7 @@ c if performing umbrella sampling, fragments constrained are read from the frag & " A" write(iout,'(a60,i5)')"Frequency of updating interaction list", & imatupdate + write(iout,'(a60,i5)')"Restart writing frequency",irest_freq if (RESPA) then write (iout,'(2a,i4,a)') & "A-MTS algorithm used; initial time step for fast-varying", @@ -741,7 +746,7 @@ C integer ilen external ilen integer iperm,tperm - integer i,j,ii,k,l,itrial,itmp,i1,i2,it1,it2,nres_temp,itemp + integer i,j,ii,k,l,itrial,itmp,i1,i2,it1,it2,nres_temp double precision sumv C C Read PDB structure if applicable @@ -857,16 +862,19 @@ cd print *,'NNT=',NNT,' NCT=',NCT & chain_border(2,i),chain_border1(1,i),chain_border1(2,i) enddo call chain_symmetry(nchain,nres,itype,chain_border, - & chain_length,npermchain,tabpermchain) + & chain_length,npermchain,tabpermchain,nchain_group,nequiv, + & iequiv,mapchain) c do i=1,nres c write(iout,*) i,(tperm(ireschain(i),ii,tabpermchain), c & ii=1,npermchain) c enddo +#ifdef DEBUG write(iout,*) "residue permutations" do i=1,nres write(iout,*) i,(iperm(i,ii),ii=1,npermchain) enddo call flush(iout) +#endif if (itype(1).eq.ntyp1) nnt=2 if (itype(nres).eq.ntyp1) nct=nct-1 write (iout,*) "nnt",nnt," nct",nct @@ -971,25 +979,34 @@ C & write (iout,*) 'FTORS',ftors call reada(weightcard,"WDIHC",wdihc,0.591D0) write (iout,*) "Weight of dihedral angle restraints",wdihc read(inp,'(9x,3f7.3)') +c & (secprob(1,i),secprob(2,i),secprob(3,i),i=nnt,nct) & (secprob(1,i),secprob(2,i),secprob(3,i),i=nnt,nct) write (iout,*) "The secprob array" do i=nnt,nct write (iout,'(i5,3f8.3)') i,(secprob(j,i),j=1,3) enddo ndih_constr=0 + iconstr_dih=0 do i=nnt+3,nct if (itype(i-3).ne.ntyp1 .and. itype(i-2).ne.ntyp1 & .and. itype(i-1).ne.ntyp1 .and. itype(i).ne.ntyp1) then ndih_constr=ndih_constr+1 idih_constr(ndih_constr)=i + iconstr_dih(i)=ndih_constr sumv=0.0d0 do j=1,3 vpsipred(j,ndih_constr)=secprob(j,i-1)*secprob(j,i-2) sumv=sumv+vpsipred(j,ndih_constr) enddo - do j=1,3 - vpsipred(j,ndih_constr)=vpsipred(j,ndih_constr)/sumv - enddo + if (sumv.gt.0.0d0) then + do j=1,3 + vpsipred(j,ndih_constr)=vpsipred(j,ndih_constr)/sumv + enddo + else + vpsipred(1,ndih_constr)=1.0d0 + vpsipred(2,ndih_constr)=0.0d0 + vpsipred(3,ndih_constr)=0.0d0 + endif phibound(1,ndih_constr)=phihel*deg2rad phibound(2,ndih_constr)=phibet*deg2rad sdihed(1,ndih_constr)=sigmahel*deg2rad @@ -1125,8 +1142,11 @@ c write (iout,*) "After read_dist_constr nhpb",nhpb endif write (iout,*) "calling read_saxs_consrtr",nsaxs if (nsaxs.gt.0) call read_saxs_constr - +c write (iout,*) "After read_saxs_constr" +c call flush(iout) if (constr_homology.gt.0) then +c write (iout,*) "Calling read_constr_homology" +c call flush(iout) call read_constr_homology if (indpdb.gt.0 .or. pdbref) then do i=1,2*nres @@ -1184,7 +1204,8 @@ c write (iout,*) "After read_dist_constr nhpb",nhpb 335 continue unres_pdb=.false. nres_temp=nres - call readpdb +c call readpdb + call readpdb_template(nmodel_start+1) close(ipdbin) if (nres.ge.nres_temp) then nmodel_start=nmodel_start+1 @@ -1195,22 +1216,11 @@ c write (iout,*) "After read_dist_constr nhpb",nhpb enddo enddo else -c itemp=nres -c nres=nres_temp -c call gen_rand_conf(itemp,*115) -c nmodel_start=nmodel_start+1 -c do i=1,2*nres -c do j=1,3 -c chomo(j,i,nmodel_start)=c(j,i) -c enddo -c enddo -c goto 116 - 115 if (me.eq.king .or. .not. out1file) - & write (iout,'(a,2i5,1x,a)') + if (me.eq.king .or. .not. out1file) + & write (iout,'(a,2i7,1x,a)') & "Different number of residues",nres_temp,nres, & " model skipped." endif - 116 continue nres=nres_temp enddo 332 continue @@ -2341,6 +2351,7 @@ c1out open(iout,file=outname,status='unknown') #else if (me.eq.king .or. .not.out1file) & open(iout,file=outname,status='unknown') +#define DEBUG #ifdef DEBUG if (fg_rank.gt.0) then write (liczba,'(i3.3)') myrank/nfgtasks @@ -2349,6 +2360,7 @@ c1out open(iout,file=outname,status='unknown') & status='unknown') endif #endif +#undef DEBUG if(me.eq.king) then open(igeom,file=intname,status='unknown',access='append') open(ipdb,file=pdbname,status='unknown') @@ -2734,10 +2746,10 @@ c write (iout,*) "j",j," k",k endif #ifdef MPI if (.not.out1file .or. me.eq.king) - & write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.restr ", + & write (iout,'(a,3i6,f8.2,1pe12.2)') "+dist.restr ", & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) #else - write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.restr ", + write (iout,'(a,3i6,f8.2,1pe12.2)') "+dist.restr ", & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) #endif enddo @@ -2781,10 +2793,10 @@ c write (iout,*) "j",j," k",k endif #ifdef MPI if (.not.out1file .or. me.eq.king) - & write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.restr ", + & write (iout,'(a,3i6,f8.2,1pe12.2)') "+dist.restr ", & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) #else - write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.restr ", + write (iout,'(a,3i6,f8.2,1pe12.2)') "+dist.restr ", & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) #endif enddo @@ -2811,13 +2823,13 @@ c & fordepth_peak(nhpb_peak+1),npeak ipeak(2,npeak)=i #ifdef MPI if (.not.out1file .or. me.eq.king) - & write (iout,'(a,5i5,2f8.2,2f10.5,i5)') "+dist.restr ", + & write (iout,'(a,5i6,2f8.2,2f10.5,i5)') "+dist.restr ", & nhpb_peak,ihpb_peak(nhpb_peak),jhpb_peak(nhpb_peak), & ibecarb_peak(nhpb_peak),npeak,dhpb_peak(nhpb_peak), & dhpb1_peak(nhpb_peak),forcon_peak(nhpb_peak), & fordepth_peak(nhpb_peak),irestr_type_peak(nhpb_peak) #else - write (iout,'(a,5i5,2f8.2,2f10.5,i5)') "+dist.restr ", + write (iout,'(a,5i6,2f8.2,2f10.5,i5)') "+dist.restr ", & nhpb_peak,ihpb_peak(nhpb_peak),jhpb_peak(nhpb_peak), & ibecarb_peak(nhpb_peak),npeak,dhpb_peak(nhpb_peak), & dhpb1_peak(nhpb_peak),forcon_peak(nhpb_peak), @@ -2840,11 +2852,11 @@ c fordepth(nhpb+1)=fordepth(nhpb+1)/forcon(nhpb+1) irestr_type(nhpb)=11 #ifdef MPI if (.not.out1file .or. me.eq.king) - & write (iout,'(a,4i5,2f8.2,2f10.5,i5)') "+dist.restr ", + & write (iout,'(a,4i6,2f8.2,2f10.5,i5)') "+dist.restr ", & nhpb,ihpb(nhpb),jhpb(nhpb),ibecarb(nhpb),dhpb(nhpb), & dhpb1(nhpb),forcon(nhpb),fordepth(nhpb),irestr_type(nhpb) #else - write (iout,'(a,4i5,2f8.2,2f10.5,i5)') "+dist.restr ", + write (iout,'(a,4i6,2f8.2,2f10.5,i5)') "+dist.restr ", & nhpb,ihpb(nhpb),jhpb(nhpb),ibecarb(nhpb),dhpb(nhpb), & dhpb1(nhpb),forcon(nhpb),fordepth(nhpb),irestr_type(nhpb) #endif @@ -2904,12 +2916,12 @@ c & dhpb(nhpb+1),dhpb1(nhpb+1),forcon(nhpb+1),fordepth(nhpb+1) endif #ifdef MPI if (.not.out1file .or. me.eq.king) - & write (iout,'(a,4i5,2f8.2,3f10.5,i5)') "+dist.restr ", + & write (iout,'(a,4i6,2f8.2,3f10.5,i5)') "+dist.restr ", & nhpb,ihpb(nhpb),jhpb(nhpb),ibecarb(nhpb),dhpb(nhpb), & dhpb1(nhpb),forcon(nhpb),fordepth(nhpb),xlscore(nhpb), & irestr_type(nhpb) #else - write (iout,'(a,4i5,2f8.2,3f10.5,i5)') "+dist.restr ", + write (iout,'(a,4i6,2f8.2,3f10.5,i5)') "+dist.restr ", & nhpb,ihpb(nhpb),jhpb(nhpb),ibecarb(nhpb),dhpb(nhpb), & dhpb1(nhpb),forcon(nhpb),fordepth(nhpb),xlscore(nhpb), & irestr_type(nhpb) @@ -2938,10 +2950,10 @@ C print *,"in else" endif #ifdef MPI if (.not.out1file .or. me.eq.king) - & write (iout,'(a,4i5,f8.2,f10.1)') "+dist.restr ", + & write (iout,'(a,4i6,f8.2,f10.1)') "+dist.restr ", & nhpb,ihpb(nhpb),jhpb(nhpb),ibecarb(i),dhpb(nhpb),forcon(nhpb) #else - write (iout,'(a,4i5,f8.2,f10.1)') "+dist.restr ", + write (iout,'(a,4i6,f8.2,f10.1)') "+dist.restr ", & nhpb,ihpb(nhpb),jhpb(nhpb),ibecarb(i),dhpb(nhpb),forcon(nhpb) #endif endif @@ -2984,13 +2996,13 @@ C dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb)) dhpb(nhpb)=dist(i+nres*ii,j+nres*jj) #ifdef MPI if (.not.out1file .or. me.eq.king) then - write (iout,'(a,4i5,2f8.2,3f10.5,i5)') "+dist.restr ", + write (iout,'(a,4i6,2f8.2,3f10.5,i5)') "+dist.restr ", & nhpb,ihpb(nhpb),jhpb(nhpb),ibecarb(nhpb),dhpb(nhpb), & dhpb1(nhpb),forcon(nhpb),fordepth(nhpb),xlscore(nhpb), & irestr_type(nhpb) endif #else - write (iout,'(a,4i5,2f8.2,3f10.5,i5)') "+dist.restr ", + write (iout,'(a,4i6,2f8.2,3f10.5,i5)') "+dist.restr ", & nhpb,ihpb(nhpb),jhpb(nhpb),ibecarb(nhpb),dhpb(nhpb), & dhpb1(nhpb),forcon(nhpb),fordepth(nhpb),xlscore(nhpb), & irestr_type(nhpb) @@ -3054,8 +3066,8 @@ c & sigma_odl_temp(maxres,maxres,max_template) character*2 kic2 character*24 model_ki_dist, model_ki_angle character*500 controlcard - integer ki,i,ii,j,k,l,ii_in_use(maxdim),i_tmp,idomain_tmp,irec, - & ik,iistart,nres_temp + integer ki,i,ii,j,k,l,ii_in_use(maxdim_cont),i_tmp,idomain_tmp, + & irec,ik,iistart,nres_temp integer ilen external ilen logical liiflag,lfirst @@ -3108,7 +3120,7 @@ c endif call card_concat(controlcard) read(controlcard,*) (waga_homology(i),i=1,homol_nset) if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then - write(iout,*) "iset homology_weight " +c write(iout,*) "iset homology_weight " do i=1,homol_nset write(iout,*) i,waga_homology(i) enddo @@ -3122,30 +3134,30 @@ c endif cd write (iout,*) "nnt",nnt," nct",nct cd call flush(iout) + if (read_homol_frag) then + call read_klapaucjusz + else lim_odl=0 lim_dih=0 c c write(iout,*) 'nnt=',nnt,'nct=',nct c - do i = nnt,nct - do k=1,constr_homology - idomain(k,i)=0 - enddo - enddo - - ii=0 - do i = nnt,nct-2 - do j=i+2,nct - ii=ii+1 - ii_in_use(ii)=0 - enddo - enddo - - if (read_homol_frag) then - call read_klapaucjusz - else +c do i = nnt,nct +c do k=1,constr_homology +c idomain(k,i)=0 +c enddo +c enddo + idomain=0 +c ii=0 +c do i = nnt,nct-2 +c do j=i+2,nct +c ii=ii+1 +c ii_in_use(ii)=0 +c enddo +c enddo + ii_in_use=0 do k=1,constr_homology read(inp,'(a)') pdbfile @@ -3265,8 +3277,8 @@ c & constr_homology endif sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii)) else - ii=ii+1 - l_homo(k,ii)=.false. +c ii=ii+1 +c l_homo(k,ii)=.false. endif enddo enddo @@ -3456,26 +3468,26 @@ 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))') + write(iout,'(3i7,100(2f8.2,1x,l1,4x))') & ii,ires_homo(ii),jres_homo(ii), & (odl(ki,ii),1.0d0/dsqrt(sigma_odl(ki,ii)),l_homo(ki,ii), & ki=1,constr_homology) enddo write (iout,*) "Dihedral angle restraints from templates" do i=nnt+3,nct - write (iout,'(i5,a4,100(2f8.2,4x))') i,restyp(itype(i)), + write (iout,'(i7,a4,100(2f8.2,4x))') i,restyp(itype(i)), & (rad2deg*dih(ki,i), & rad2deg/dsqrt(sigma_dih(ki,i)),ki=1,constr_homology) enddo write (iout,*) "Virtual-bond angle restraints from templates" do i=nnt+2,nct - write (iout,'(i5,a4,100(2f8.2,4x))') i,restyp(itype(i)), + write (iout,'(i7,a4,100(2f8.2,4x))') i,restyp(itype(i)), & (rad2deg*thetatpl(ki,i), & rad2deg/dsqrt(sigma_theta(ki,i)),ki=1,constr_homology) enddo write (iout,*) "SC restraints from templates" do i=nnt,nct - write(iout,'(i5,100(4f8.2,4x))') i, + write(iout,'(i7,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 @@ -3641,14 +3653,17 @@ c---------------------------------------------------------------------- character*2 kic2 character*24 model_ki_dist, model_ki_angle character*500 controlcard - integer ki, i, j, k, l, ii_in_use(maxdim),i_tmp,idomain_tmp, - & ik,ll,ii,kk,iistart,iishift,lim_xx + integer ki, i, j, jj,k, l, ii_in_use(maxdim_cont),i_tmp, + & idomain_tmp, + & ik,ll,lll,ii_old,ii,iii,ichain,kk,iistart,iishift,lim_xx,igr, + & i01,i10,nnt_chain,nct_chain + integer itype_temp(maxres) double precision distal logical lprn /.true./ integer nres_temp integer ilen external ilen - logical liiflag + logical liiflag,lfirst c c double precision rescore_tmp,x12,y12,z12,rescore2_tmp @@ -3662,14 +3677,48 @@ c For new homol impl c include 'COMMON.VAR' c +c write (iout,*) "READ_KLAPAUCJUSZ" +c print *,"READ_KLAPAUCJUSZ" +c call flush(iout) call getenv("FRAGFILE",fragfile) + write (iout,*) "Opening", fragfile + call flush(iout) open(ientin,file=fragfile,status="old",err=10) - read(ientin,*) constr_homology,nclust - nmodel_start=constr_homology - l_homo = .false. +c write (iout,*) " opened" +c call flush(iout) + sigma_theta=0.0 sigma_d=0.0 sigma_dih=0.0 + l_homo = .false. + + nres_temp=nres + itype_temp=itype + ii=0 + lim_odl=0 + +c write (iout,*) "Entering loop" +c call flush(iout) + + DO IGR = 1,NCHAIN_GROUP + +c write (iout,*) "igr",igr + call flush(iout) + read(ientin,*) constr_homology,nclust + + if (start_from_model) then + nmodel_start=constr_homology + else + nmodel_start=0 + endif + + ii_old=lim_odl + + ichain=iequiv(1,igr) + nnt_chain=chain_border(1,ichain)-chain_border1(1,ichain)+1 + nct_chain=chain_border(2,ichain)-chain_border1(1,ichain)+1 +c write (iout,*) "nnt_chain",nnt_chain," nct_chain",nct_chain + c Read pdb files do k=1,constr_homology read(ientin,'(a)') pdbfile @@ -3683,10 +3732,10 @@ c Read pdb files stop 34 continue unres_pdb=.false. - nres_temp=nres +c nres_temp=nres call readpdb_template(k) nres_chomo(k)=nres - nres=nres_temp +c nres=nres_temp do i=1,nres rescore(k,i)=0.2d0 rescore2(k,i)=1.0d0 @@ -3705,6 +3754,7 @@ c do ll = 1,ninclust(l) k = inclust(ll,l) +c write (iout,*) "l",l," ll",ll," k",k do i=1,nres idomain(k,i)=0 enddo @@ -3720,7 +3770,7 @@ c Distance restraints c c ... --> odl(k,ii) C Copy the coordinates from reference coordinates (?) - nres_temp=nres +c nres_temp=nres nres=nres_chomo(k) do i=1,2*nres do j=1,3 @@ -3734,11 +3784,13 @@ c write (iout,*) "c(",j,i,") =",c(j,i) thetaref(i)=theta(i) phiref(i)=phi(i) enddo - nres=nres_temp +c nres=nres_temp if (waga_dist.ne.0.0d0) then - ii=0 - do i = nnt,nct-2 - do j=i+2,nct + ii=ii_old +c do i = nnt,nct-2 + do i = nnt_chain,nct_chain-2 +c do j=i+2,nct + do j=i+2,nct_chain x12=c(1,i)-c(1,j) y12=c(2,i)-c(2,j) @@ -3755,9 +3807,9 @@ c write (iout,*) k,i,j,distal,dist2_cut 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 +c & constr_homology + ires_homo(ii)=i+chain_border1(1,igr)-1 + jres_homo(ii)=j+chain_border1(1,igr)-1 odl(k,ii)=distal if (read2sigma) then sigma_odl(k,ii)=0 @@ -3793,50 +3845,55 @@ c c Theta, dihedral and SC retraints c if (waga_angle.gt.0.0d0) then - do i = nnt+3,nct + do i = nnt_chain+3,nct_chain + iii=i+chain_border1(1,igr)-1 if (idomain(k,i).eq.0) then c sigma_dih(k,i)=0.0 cycle endif - dih(k,i)=phiref(i) - sigma_dih(k,i)=(rescore(k,i)+rescore(k,i-1)+ + dih(k,iii)=phiref(i) + sigma_dih(k,iii)= + & (rescore(k,i)+rescore(k,i-1)+ & rescore(k,i-2)+rescore(k,i-3))/4.0 c write (iout,*) "k",k," l",l," i",i," rescore",rescore(k,i), c & " sigma_dihed",sigma_dih(k,i) - if (sigma_dih(k,i).ne.0) - & sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i)) + if (sigma_dih(k,iii).ne.0) + & sigma_dih(k,iii)=1.0d0/(sigma_dih(k,iii)*sigma_dih(k,iii)) enddo - lim_dih=nct-nnt-2 +c lim_dih=nct-nnt-2 endif if (waga_theta.gt.0.0d0) then - do i = nnt+2,nct + do i = nnt_chain+2,nct_chain + iii=i+chain_border1(1,igr)-1 if (idomain(k,i).eq.0) then c sigma_theta(k,i)=0.0 cycle endif - thetatpl(k,i)=thetaref(i) - sigma_theta(k,i)=(rescore(k,i)+rescore(k,i-1)+ + thetatpl(k,iii)=thetaref(i) + sigma_theta(k,iii)=(rescore(k,i)+rescore(k,i-1)+ & rescore(k,i-2))/3.0 - if (sigma_theta(k,i).ne.0) - & sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i)) + if (sigma_theta(k,iii).ne.0) + & sigma_theta(k,iii)=1.0d0/ + & (sigma_theta(k,iii)*sigma_theta(k,iii)) enddo endif if (waga_d.gt.0.0d0) then - do i = nnt,nct + do i = nnt_chain,nct_chain + iii=i+chain_border1(1,igr)-1 if (itype(i).eq.10) cycle if (idomain(k,i).eq.0 ) then c sigma_d(k,i)=0.0 cycle endif - xxtpl(k,i)=xxref(i) - yytpl(k,i)=yyref(i) - zztpl(k,i)=zzref(i) - sigma_d(k,i)=rescore(k,i) - if (sigma_d(k,i).ne.0) - & sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i)) - if (i-nnt+1.gt.lim_xx) lim_xx=i-nnt+1 + xxtpl(k,iii)=xxref(i) + yytpl(k,iii)=yyref(i) + zztpl(k,iii)=zzref(i) + sigma_d(k,iii)=rescore(k,i) + if (sigma_d(k,iii).ne.0) + & sigma_d(k,iii)=1.0d0/(sigma_d(k,iii)*sigma_d(k,iii)) +c if (i-nnt+1.gt.lim_xx) lim_xx=i-nnt+1 enddo endif enddo ! l @@ -3845,41 +3902,101 @@ c c remove distance restraints not used in any model from the list c shift data in all arrays c +c write (iout,*) "ii_old",ii_old if (waga_dist.ne.0.0d0) then - ii=0 +#ifdef DEBUG + write (iout,*) "Distance restraints from templates" + do iii=1,lim_odl + write(iout,'(4i5,100(2f8.2,1x,l1,4x))') + & iii,ii_in_use(iii),ires_homo(iii),jres_homo(iii), + & (odl(ki,iii),1.0d0/dsqrt(sigma_odl(ki,iii)),l_homo(ki,iii), + & ki=1,constr_homology) + enddo +#endif + ii=ii_old liiflag=.true. - do i=nnt,nct-2 - do j=i+2,nct + lfirst=.true. + do i=nnt_chain,nct_chain-2 + do j=i+2,nct_chain ii=ii+1 - if (ii_in_use(ii).eq.0.and.liiflag) then +c if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0 +c & .and. distal.le.dist2_cut ) then +c write (iout,*) "i",i," j",j," ii",ii," i_in_use",ii_in_use(ii) +c call flush(iout) + if (ii_in_use(ii).eq.0.and.liiflag.or. + & ii_in_use(ii).eq.1.and.liiflag.and.ii.eq.lim_odl) then liiflag=.false. - iistart=ii + i10=ii + if (lfirst) then + lfirst=.false. + iistart=ii + else + if(i10.eq.lim_odl) i10=i10+1 + do ki=0,i10-i01-1 + ires_homo(iistart+ki)=ires_homo(ki+i01) + jres_homo(iistart+ki)=jres_homo(ki+i01) + ii_in_use(iistart+ki)=ii_in_use(ki+i01) + do k=1,constr_homology + odl(k,iistart+ki)=odl(k,ki+i01) + sigma_odl(k,iistart+ki)=sigma_odl(k,ki+i01) + l_homo(k,iistart+ki)=l_homo(k,ki+i01) + enddo + enddo + iistart=iistart+i10-i01 + endif endif - if (ii_in_use(ii).ne.0.and..not.liiflag.or. - & .not.liiflag.and.ii.eq.lim_odl) then - if (ii.eq.lim_odl) then - iishift=ii-iistart+1 - else - iishift=ii-iistart - endif + if (ii_in_use(ii).ne.0.and..not.liiflag) then + i01=ii liiflag=.true. - do ki=iistart,lim_odl-iishift - ires_homo(ki)=ires_homo(ki+iishift) - jres_homo(ki)=jres_homo(ki+iishift) - ii_in_use(ki)=ii_in_use(ki+iishift) - do k=1,constr_homology - odl(k,ki)=odl(k,ki+iishift) - sigma_odl(k,ki)=sigma_odl(k,ki+iishift) - l_homo(k,ki)=l_homo(k,ki+iishift) - enddo - enddo - ii=ii-iishift - lim_odl=lim_odl-iishift endif enddo enddo + lim_odl=iistart-1 endif + lll=lim_odl-ii_old + + do i=2,nequiv(igr) + + ichain=iequiv(i,igr) + + do j=nnt_chain,nct_chain + jj=j+chain_border1(1,ichain)-chain_border1(1,iequiv(1,igr)) + do k=1,constr_homology + dih(k,jj)=dih(k,j) + sigma_dih(k,jj)=sigma_dih(k,j) + thetatpl(k,jj)=thetatpl(k,j) + sigma_theta(k,jj)=sigma_theta(k,j) + xxtpl(k,jj)=xxtpl(k,j) + yytpl(k,jj)=yytpl(k,j) + zztpl(k,jj)=zztpl(k,j) + sigma_d(k,jj)=sigma_d(k,j) + enddo + enddo + + jj=chain_border1(1,ichain)-chain_border1(1,iequiv(i-1,igr)) +c write (iout,*) "igr",igr," i",i," ichain",ichain," jj",jj + do j=ii_old+1,lim_odl + ires_homo(j+lll)=ires_homo(j)+jj + jres_homo(j+lll)=jres_homo(j)+jj + do k=1,constr_homology + odl(k,j+lll)=odl(k,j) + sigma_odl(k,j+lll)=sigma_odl(k,j) + l_homo(k,j+lll)=l_homo(k,j) + enddo + enddo + + ii_old=ii_old+lll + lim_odl=lim_odl+lll + + enddo + + ENDDO ! IGR + + if (waga_angle.gt.0.0d0) lim_dih=nct-nnt-2 + nres=nres_temp + itype=itype_temp + return 10 stop "Error in fragment file" end diff --git a/source/unres/src-HCD-5D/refsys.f b/source/unres/src-HCD-5D/refsys.f index 4b7b763..5573f05 100644 --- a/source/unres/src-HCD-5D/refsys.f +++ b/source/unres/src-HCD-5D/refsys.f @@ -21,12 +21,12 @@ c print *,'just initialize' c print *,fail s1=0.0 s2=0.0 - print *,s1,s2 +c print *,s1,s2 do 1 i=1,3 - print *, i2,i3,i4 +c print *, i2,i3,i4 zi=c(i,i2)-c(i,i3) ui=c(i,i4)-c(i,i3) - print *,zi,ui +c print *,zi,ui s1=s1+zi*zi s2=s2+ui*ui z(i)=zi @@ -41,7 +41,7 @@ c print *,fail write(iout,1000) i3,i4,i1 fail=.true. return - print *,'two if pass' +c print *,'two if pass' 4 s1=1.0/s1 s2=1.0/s2 v1=z(2)*u(3)-z(3)*u(2) diff --git a/source/unres/src-HCD-5D/stochfric.F b/source/unres/src-HCD-5D/stochfric.F index c83e9ce..946fb58 100644 --- a/source/unres/src-HCD-5D/stochfric.F +++ b/source/unres/src-HCD-5D/stochfric.F @@ -1,5 +1,8 @@ subroutine friction_force implicit none +#ifdef MPI + include 'mpif.h' +#endif include 'DIMENSIONS' include 'COMMON.VAR' include 'COMMON.CHAIN' @@ -37,8 +40,12 @@ logical lprn /.false./, checkmode /.false./ #ifdef FIVEDIAG +#ifdef TIMING + include 'COMMON.TIME1' + double precision time01 +#endif c Here accelerations due to friction forces are computed right after forces. - d_t_work=0.0d0 + d_t_work(:6*nres)=0.0d0 do j=1,3 v_work(j,1)=d_t(j,0) v_work(j,nnt)=d_t(j,0) @@ -86,8 +93,14 @@ c inct=chain_border(2,1) write (iout,'(f10.5)') (vvec(i),i=iposc,ind) #endif c write (iout,*) "chain",i," ind",ind," n",n +#ifdef TIMING + time01=MPI_Wtime() +#endif call fivediagmult(n,DMfric(iposc),DU1fric(iposc), & DU2fric(iposc),vvec(iposc),rs) +#ifdef TIMING + time_fricmatmult=time_fricmatmult+MPI_Wtime()-time01 +#endif #ifdef DEBUG write (iout,*) "rs" write (iout,'(f10.5)') (rs(i),i=1,n) @@ -104,7 +117,7 @@ c & "index",3*(i-1)+j,"rs",rs(i-iposc+1) write (iout,'(3f10.5)') (fric_work(j),j=1,dimen3) #endif #else - do i=0,MAXRES2 + do i=0,2*nres do j=1,3 friction(j,i)=0.0d0 enddo @@ -277,7 +290,7 @@ c----------------------------------------------------- integer ichain,innt,inct,iposc #endif - do i=0,MAXRES2 + do i=0,2*nres do j=1,3 stochforc(j,i)=0.0d0 enddo @@ -567,9 +580,9 @@ C gamsc(ntyp1)=1.0d0 enddo endif #ifdef FIVEDIAG - DMfric=0.0d0 - DU1fric=0.0d0 - DU2fric=0.0d0 + DMfric(:2*nres)=0.0d0 + DU1fric(:2*nres)=0.0d0 + DU2fric(:2*nres)=0.0d0 ind=1 do ichain=1,nchain innt=chain_border(1,ichain) diff --git a/source/unres/src-HCD-5D/timing.F b/source/unres/src-HCD-5D/timing.F index 7bd51b8..98ce59a 100644 --- a/source/unres/src-HCD-5D/timing.F +++ b/source/unres/src-HCD-5D/timing.F @@ -50,6 +50,18 @@ C Calculate the initial time, if it is not zero (e.g. for the SUN). time_fricmatmult=0.0d0 time_fsample=0.0d0 time_SAXS=0.0d0 + time_list=0.0d0 + time_evdw=0.0d0 + time_evdw_short=0.0d0 + time_evdw_long=0.0d0 + time_eelec=0.0d0 + time_eelec_short=0.0d0 + time_eelec_long=0.0d0 + time_escp=0.0d0 + time_escp_short=0.0d0 + time_escp_long=0.0d0 + time_escpsetup=0.0d0 + time_escpcalc=0.0d0 #endif cd print *,' in SET_TIMERS stime=',stime return @@ -287,6 +299,7 @@ C--------------------------------------------------------------------------- include 'COMMON.IOUNITS' include 'COMMON.TIME1' include 'COMMON.SETUP' + include 'COMMON.MD' #ifdef MPI time1=MPI_WTIME() write (iout,'(80(1h=)/a/(80(1h=)))') @@ -318,6 +331,30 @@ C--------------------------------------------------------------------------- & time_bcast+time_reduce+time_gather+time_scatter+ & time_sendrecv+time_barrier_g+time_barrier_e+time_bcastc write (*,*) "Processor",fg_rank,myrank," enecalc",time_enecalc +#ifdef TIMING_ENE + if (RESPA) then + write (*,*) "Processor",fg_rank,myrank," evdw_long", + & time_evdw_long + write (*,*) "Processor",fg_rank,myrank," evdw_short", + & time_evdw_short + write (*,*) "Processor",fg_rank,myrank," eelec_long", + & time_eelec_long + write (*,*) "Processor",fg_rank,myrank," eelec_short", + & time_eelec_short + write (*,*) "Processor",fg_rank,myrank," escp_long", + & time_escp_long + write (*,*) "Processor",fg_rank,myrank," escp_short", + & time_escp_short + else + write (*,*) "Processor",fg_rank,myrank," evdw",time_evdw + write (*,*) "Processor",fg_rank,myrank," eelec",time_eelec + write (*,*) "Processor",fg_rank,myrank," escp",time_escp + write (*,*) "Processor",fg_rank,myrank," escpsetup", + & time_escpsetup + write (*,*) "Processor",fg_rank,myrank," escpcalc", + & time_escpcalc + endif +#endif write (*,*) "Processor",fg_rank,myrank," sumene",time_sumene write (*,*) "Processor",fg_rank,myrank," intfromcart", & time_intfcart diff --git a/source/unres/src-HCD-5D/unres.F b/source/unres/src-HCD-5D/unres.F index 978fa59..2e0ebaf 100644 --- a/source/unres/src-HCD-5D/unres.F +++ b/source/unres/src-HCD-5D/unres.F @@ -213,11 +213,11 @@ c include 'COMMON.CONTACTS' include 'COMMON.REMD' include 'COMMON.MD' include 'COMMON.SBRIDGE' - integer i,icall,iretcode,nfun + integer i,it,icall,iretcode,nfun common /srutu/ icall integer nharp,iharp(4,maxres/3) integer nft_sc - logical fail + logical fail,secondary_str /.true./ double precision energy(0:n_ene),etot,etota double precision energy_long(0:n_ene),energy_short(0:n_ene) double precision rms,frac,frac_nn,co @@ -243,6 +243,24 @@ c include 'COMMON.CONTACTS' write (iout,*) "Energy evaluation/minimization" call chainbuild_cart c print *,'dc',dc(1,0),dc(2,0),dc(3,0) + if (nran_start.gt.0) then + write (iout,*) + & "Chains will be regenerated starting from residue",nran_start + do it=1,100 + call gen_rand_conf_mchain(nran_start,*10) + write (iout,*) "Conformation successfully generated",it + goto 11 + 10 write (iout,*) "Problems with regenerating chains",it + enddo + 11 continue + write (iout,*) "Cartesian coords after chain rebuild" + call cartprint + call chainbuild_cart + write (iout,*) "Cartesian coords after chainbuild_ecart" + call cartprint + call int_from_cart1(.false.) + call intout + endif if (split_ene) then print *,"Processor",myrank," after chainbuild" icall=1 @@ -274,9 +292,11 @@ c print *,"after etotal" etota = energy(0) etot =etota call enerprint(energy(0)) + if (secondary_str) then call hairpin(.true.,nharp,iharp) c print *,'after hairpin' call secondary2(.true.) + endif c print *,'after secondary' if (minim) then crc overlap test @@ -292,6 +312,9 @@ crc overlap test write (iout,*) 'Calling OVERLAP_SC' call overlap_sc(fail) write (iout,*) "After overlap_sc" +c cartname=prefix(:ilen(prefix))//'.x' +c potE=etot +c call cartoutx(0.0d0) endif if (searchsc) then @@ -330,10 +353,12 @@ c print *,'Calling MINIMIZE.' #endif print *,'# eval/s',evals print *,'refstr=',refstr + if (secondary_str) then call hairpin(.false.,nharp,iharp) - print *,'after hairpin' +c print *,'after hairpin' call secondary2(.true.) - print *,'after secondary' +c print *,'after secondary' + endif call etotal(energy(0)) etot = energy(0) call enerprint(energy(0)) -- 1.7.9.5 From cfa451a3eb66a31043e1dce4685deb8e98e4a52a Mon Sep 17 00:00:00 2001 From: czarek Date: Thu, 17 Feb 2022 10:01:56 +0100 Subject: [PATCH 14/16] cluster_wham --- source/cluster/wham/src-HCD/energy_p_new.F | 4 ++-- source/cluster/wham/src-HCD/read_coords.F | 16 ++++++++-------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/source/cluster/wham/src-HCD/energy_p_new.F b/source/cluster/wham/src-HCD/energy_p_new.F index e969ea3..6286514 100644 --- a/source/cluster/wham/src-HCD/energy_p_new.F +++ b/source/cluster/wham/src-HCD/energy_p_new.F @@ -2439,12 +2439,12 @@ C fac_shield(j)=0.6 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*faclipij2 + ees=ees+eesij*sss*faclipij2 else fac_shield(i)=1.0 fac_shield(j)=1.0 eesij=(el1+el2) - ees=ees+eesij*faclipij2 + ees=ees+eesij*sss*faclipij2 endif evdw1=evdw1+evdwij*sss*faclipij2 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') diff --git a/source/cluster/wham/src-HCD/read_coords.F b/source/cluster/wham/src-HCD/read_coords.F index 20abce5..09af6e6 100644 --- a/source/cluster/wham/src-HCD/read_coords.F +++ b/source/cluster/wham/src-HCD/read_coords.F @@ -221,11 +221,11 @@ c call flush(iout) do k=1,nss call xdrfint(ixdrf, idssb(k), iret) call xdrfint(ixdrf, jdssb(k), iret) - ihpb(k)=iss(idssb(k)-nres)+nres - jhpb(k)=iss(jdssb(k)-nres)+nres + ihpb(k)=iss(idssb(k))+nres + jhpb(k)=iss(jdssb(k))+nres #ifdef DEBUG - write (iout,*) "jj",jj+1," dyn_ss:",idssb(k)-nres, - & jdssb(k)-nres,ihpb(k),jhpb(k) + write (iout,*) "jj",jj+1," dyn_ss:",idssb(k), + & jdssb(k),ihpb(k),jhpb(k) #endif enddo else @@ -262,11 +262,11 @@ c write (iout,*) "nss",nss do k=1,nss call xdrfint(ixdrf, idssb(k), iret) call xdrfint(ixdrf, jdssb(k), iret) - ihpb(k)=iss(idssb(k)-nres)+nres - jhpb(k)=iss(jdssb(k)-nres)+nres + ihpb(k)=iss(idssb(k))+nres + jhpb(k)=iss(jdssb(k))+nres #ifdef DEBUG - write (iout,*) "jj",jj+1," dyn_ss:",idssb(k)-nres, - & jdssb(k)-nres,ihpb(k),jhpb(k) + write (iout,*) "jj",jj+1," dyn_ss:",idssb(k), + & jdssb(k),ihpb(k),jhpb(k) #endif enddo else -- 1.7.9.5 From f1bb6ae8b2bf72b19b8a537cdadfb5e5033e29fe Mon Sep 17 00:00:00 2001 From: czarek Date: Thu, 17 Feb 2022 10:04:24 +0100 Subject: [PATCH 15/16] wham --- source/wham/src-HCD/cxread.F | 2 -- source/wham/src-HCD/enecalc1.F | 4 ++-- source/wham/src-HCD/energy_p_new.F | 4 ++-- 3 files changed, 4 insertions(+), 6 deletions(-) diff --git a/source/wham/src-HCD/cxread.F b/source/wham/src-HCD/cxread.F index 2cfb938..3f6c70b 100644 --- a/source/wham/src-HCD/cxread.F +++ b/source/wham/src-HCD/cxread.F @@ -69,8 +69,6 @@ c call flush(iout) 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) diff --git a/source/wham/src-HCD/enecalc1.F b/source/wham/src-HCD/enecalc1.F index 2edf349..b369fbd 100644 --- a/source/wham/src-HCD/enecalc1.F +++ b/source/wham/src-HCD/enecalc1.F @@ -727,8 +727,8 @@ c call flush(iout) call xdrfint_(ixdrf, nss, iret) do j=1,nss if (dyn_ss) then - call xdrfint(ixdrf, idssb(j)+nres, iret) - call xdrfint(ixdrf, jdssb(j)+nres, iret) + 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) diff --git a/source/wham/src-HCD/energy_p_new.F b/source/wham/src-HCD/energy_p_new.F index 3a83918..6e1c491 100644 --- a/source/wham/src-HCD/energy_p_new.F +++ b/source/wham/src-HCD/energy_p_new.F @@ -2459,12 +2459,12 @@ C fac_shield(j)=0.6 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*faclipij2 + ees=ees+eesij*sss*faclipij2 else fac_shield(i)=1.0 fac_shield(j)=1.0 eesij=(el1+el2) - ees=ees+eesij*faclipij2 + ees=ees+eesij*sss*faclipij2 endif evdw1=evdw1+evdwij*sss*faclipij2 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') -- 1.7.9.5 From d8d858b9bab2c9d98e9aa4229aa6f34ba81d0f5b Mon Sep 17 00:00:00 2001 From: czarek Date: Thu, 17 Feb 2022 10:09:54 +0100 Subject: [PATCH 16/16] unres --- source/unres/src-HCD-5D/COMMON.INTERACT | 4 +- source/unres/src-HCD-5D/elecont.f | 2 +- source/unres/src-HCD-5D/energy_p_new_barrier.F | 174 ++++++++++++++++++------ source/unres/src-HCD-5D/geomout.F | 23 +++- source/unres/src-HCD-5D/readpdb-mult.F | 1 + source/unres/src-HCD-5D/readrtns_CSA.F | 9 +- source/unres/src-HCD-5D/unres.F | 4 +- 7 files changed, 162 insertions(+), 55 deletions(-) diff --git a/source/unres/src-HCD-5D/COMMON.INTERACT b/source/unres/src-HCD-5D/COMMON.INTERACT index 9b023e5..2a55393 100644 --- a/source/unres/src-HCD-5D/COMMON.INTERACT +++ b/source/unres/src-HCD-5D/COMMON.INTERACT @@ -1,6 +1,6 @@ double precision aa,bb,augm,aad,bad,app,bpp,ale6,ael3,ael6, &aa_lip,bb_lip,aa_aq,bb_aq,sc_aa_tube_par,sc_bb_tube_par, - & pep_aa_tube,pep_bb_tube + & pep_aa_tube,pep_bb_tube,alpha_GB,alpha_GB1 integer expon,expon2 integer nnt,nct,nint_gr,istart,iend,itype,itel,itypro, @@ -11,7 +11,7 @@ common /interact/aa_aq(ntyp,ntyp),bb_aq(ntyp,ntyp), & aa_lip(ntyp,ntyp),bb_lip(ntyp,ntyp), & sc_aa_tube_par(ntyp),sc_bb_tube_par(ntyp), - & pep_aa_tube,pep_bb_tube, + & pep_aa_tube,pep_bb_tube,alpha_GB,alpha_GB1, & augm(ntyp,ntyp), & aad(ntyp,2),bad(ntyp,2),app(2,2),bpp(2,2),ael6(2,2),ael3(2,2), & expon,expon2,nnt,nct,nint_gr(maxres),istart(maxres,maxint_gr), diff --git a/source/unres/src-HCD-5D/elecont.f b/source/unres/src-HCD-5D/elecont.f index 7c024ea..79d6a7e 100644 --- a/source/unres/src-HCD-5D/elecont.f +++ b/source/unres/src-HCD-5D/elecont.f @@ -428,7 +428,7 @@ cd write (iout,*) i1,j1,not_done iii1=max0(ii1-1,1) do ij=iii1,i1 nsec(ij)=nsec(ij)+1 - if (nsec(ij).le.2) then + if (nsec(ij).le.2 .and. nsec(ij).gt.0) then isec(ij,nsec(ij))=nbeta endif enddo diff --git a/source/unres/src-HCD-5D/energy_p_new_barrier.F b/source/unres/src-HCD-5D/energy_p_new_barrier.F index 2d94dc0..9ec8107 100644 --- a/source/unres/src-HCD-5D/energy_p_new_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new_barrier.F @@ -2013,6 +2013,11 @@ C & sslipj,ssgradlipj,ssgradlipi,sig,rij_shift,faclip double precision dist,sscale,sscagrad,sscagradlip,sscalelip double precision boxshift + double precision x0,y0,r012,rij12,facx0, + & facx02,afacx0,bfacx0,abfacx0,Afac,BBfac,Afacsig,Bfacsig +c alpha_GB=0.5d0 +c alpha_GB=0.01d0 +c alpha_GB1=1.0d0+1.0d0/alpha_GB evdw=0.0D0 ccccc energy_dec=.false. C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon @@ -2173,67 +2178,150 @@ c & " sig",sig," sig0ij",sig0ij c for diagnostics; uncomment c rij_shift=1.2*sig0ij C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 +c if (rij_shift.le.0.0D0) then + x0=alpha_GB*(sig-sig0ij) + if (energy_dec) write (iout,*) i,j," x0",x0 + if (rij_shift.le.x0) then +c sig=2.0d0*sig0ij + sigder=-sig*sigsq +c sigder=0.0d0 + fac=rij**expon + rij12=fac*fac +c rij12=1.0d0 + x0=alpha_GB*(sig-sig0ij) + facx0=1.0d0/x0**expon + facx02=facx0*facx0 + r012=((1.0d0+alpha_GB)*(sig-sig0ij))**(2*expon) + afacx0=aa*facx02 + bfacx0=bb*facx0 + abfacx0=afacx0+0.5d0*bfacx0 + Afac=alpha_GB1*abfacx0 + Afacsig=0.5d0*alpha_GB1*bfacx0/(sig-sig0ij) + BBfac=Afac-(afacx0+bfacx0) +c BBfac=0.0d0 + Bfacsig=(-alpha_GB1*(abfacx0+afacx0)+ + & (afacx0+afacx0+bfacx0))/(sig-sig0ij) +c Bfacsig=0.0d0 + Afac=Afac*r012 + Afacsig=Afacsig*r012 +c Afac=1.0d0 +c Afacsig=0.0d0 +c w(x)=4*eps*((1.0+1.0/alpha_GB)*(y0**12-0.5*y0**6)*(r0/x)**12-(1+1/alpha)*(y0**12-0.5*y0**6)+y0**12-y0**6) +c eps1=1.0d0 +c eps2rt=1.0d0 +c eps3rt=1.0d0 + e1 = eps1*eps2rt*eps3rt*Afac*rij12 + e2 = -eps1*eps2rt*eps3rt*BBfac + evdwij = e1+e2 + eps2der=evdwij*eps3rt + eps3der=evdwij*eps2rt +c eps2der=0.0d0 +c eps3der=0.0d0 +c eps1_om12=0.0d0 + evdwij=evdwij*eps2rt*eps3rt +c Afacsig=0.d0 +c Bfacsig=0.0d0 + if (lprn) then + write (iout,*) "aa",aa," bb",bb," sig0ij",sig0ij + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa + write (iout,'(2(a3,i3,2x),18(0pf9.5))') + & restyp(itypi),i,restyp(itypj),j, + & epsi,sigm,chi1,chi2,chip1,chip2, + & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, + & eps1*eps2rt**2*eps3rt**2,om1,om2,om12, + & 1.0D0/rij,rij_shift, + & evdwij + endif + if (energy_dec) write (iout,'(a,2i5,4f10.5,e15.5)') + & 'RE r sss evdw',i,j,1.0d0/rij,sss,sslipi,sslipj,evdwij + evdw=evdw+evdwij*sss +C Calculate gradient components. + e1=e1*eps2rt*eps3rt + sigder=-expon*eps1*eps2rt*eps2rt*eps3rt*eps3rt + & *(Afacsig*rij12-Bfacsig)*sigder + fac=-2.0d0*expon*e1*rij*rij +c print '(2i4,6f8.4)',i,j,sss,sssgrad* +c & evdwij,fac,sigma(itypi,itypj),expon + fac=fac+evdwij*sssgrad/sss*rij +c fac=0.0d0 +c write (iout,*) "sigder",sigder," fac",fac," e1",e1, +c & " e2",e2," sss",sss," sssgrad",sssgrad,"esp123", +c & eps1*eps2rt**2*eps3rt**2 +C Calculate the radial part of the gradient + gg_lipi(3)=eps1*(eps2rt*eps2rt) + & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))) + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi +C gg_lipi(3)=0.0d0 +C gg_lipj(3)=0.0d0 + gg(1)=xj*fac + gg(2)=yj*fac + gg(3)=zj*fac +c evdw=1.0D20 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') cd & restyp(itypi),i,restyp(itypj),j, cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) - return - endif - sigder=-sig*sigsq +c return + else + rij_shift=1.0D0/rij_shift + sigder=-sig*sigsq c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon + fac=rij_shift**expon C here to start with C if (c(i,3).gt. - faclip=fac - e1=fac*fac*aa - e2=fac*bb - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt + faclip=fac + e1=fac*fac*aa + e2=fac*bb + evdwij=eps1*eps2rt*eps3rt*(e1+e2) + eps2der=evdwij*eps3rt + eps3der=evdwij*eps2rt C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij, C &((sslipi+sslipj)/2.0d0+ C &(2.0d0-sslipi-sslipj)/2.0d0) c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij*sss - if (lprn) then - sigm=dabs(aa/bb)**(1.0D0/6.0D0) - epsi=bb**2/aa - write (iout,'(2(a3,i3,2x),17(0pf7.3))') - & restyp(itypi),i,restyp(itypj),j, - & epsi,sigm,chi1,chi2,chip1,chip2, - & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, - & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, - & evdwij - endif + evdwij=evdwij*eps2rt*eps3rt + evdw=evdw+evdwij*sss + if (energy_dec) write (iout,'(a,2i5,4f10.5,e15.5)') + & 'GB r sss evdw',i,j,1.0d0/rij,sss,sslipi,sslipj,evdwij + if (lprn) then + write (iout,*) "aa",aa," bb",bb," sig0ij",sig0ij + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa + write (iout,'(2(a3,i3,2x),17(0pf7.3))') + & restyp(itypi),i,restyp(itypj),j, + & epsi,sigm,chi1,chi2,chip1,chip2, + & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, + & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, + & evdwij + endif - if (energy_dec) write (iout,'(a,2i5,4f10.5,e15.5)') - & 'r sss evdw',i,j,1.0d0/rij,sss,sslipi,sslipj,evdwij C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac -c print '(2i4,6f8.4)',i,j,sss,sssgrad* -c & evdwij,fac,sigma(itypi,itypj),expon - fac=fac+evdwij*sssgrad/sss*rij -c fac=0.0d0 + e1=e1*eps1*eps2rt**2*eps3rt**2 + fac=-expon*(e1+evdwij)*rij_shift + sigder=fac*sigder + fac=rij*fac +c print '(2i4,6f8.4)',i,j,sss,sssgrad* +c & evdwij,fac,sigma(itypi,itypj),expon + fac=fac+evdwij*sssgrad/sss*rij +c fac=0.0d0 C Calculate the radial part of the gradient - gg_lipi(3)=eps1*(eps2rt*eps2rt) + gg_lipi(3)=eps1*(eps2rt*eps2rt) & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip* & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))) - gg_lipj(3)=ssgradlipj*gg_lipi(3) - gg_lipi(3)=gg_lipi(3)*ssgradlipi -C gg_lipi(3)=0.0d0 -C gg_lipj(3)=0.0d0 - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi +C gg_lipi(3)=0.0d0 +C gg_lipj(3)=0.0d0 + gg(1)=xj*fac + gg(2)=yj*fac + gg(3)=zj*fac + endif C Calculate angular part of the gradient. c call sc_grad_scale(sss) call sc_grad diff --git a/source/unres/src-HCD-5D/geomout.F b/source/unres/src-HCD-5D/geomout.F index 3dcde10..553dbf6 100644 --- a/source/unres/src-HCD-5D/geomout.F +++ b/source/unres/src-HCD-5D/geomout.F @@ -145,7 +145,7 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 endif do i=1,nss if (dyn_ss) then - write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1 + write (iunit,30) ica(iss(idssb(i)))+1,ica(iss(jdssb(i)))+1 else write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 endif @@ -153,7 +153,7 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 write (iunit,'(a6)') 'ENDMDL' 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3) 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,f15.3) - 30 FORMAT ('CONECT',8I7) + 30 FORMAT ('CONECT',8I5) return end c------------------------------------------------------------------------------ @@ -335,6 +335,7 @@ c----------------------------------------------------------------- #else parameter (me=0) #endif + include 'COMMON.CONTROL' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.NAMES' @@ -359,8 +360,13 @@ c----------------------------------------------------------------- call xdrfint_(ixdrf, nss, iret) do j=1,nss if (dyn_ss) then - call xdrfint_(ixdrf, idssb(j)+nres, iret) - call xdrfint_(ixdrf, jdssb(j)+nres, iret) + if (modecalc.eq.14) then + call xdrfint_(ixdrf, idssb(j), iret) + call xdrfint_(ixdrf, jdssb(j), iret) + else + call xdrfint_(ixdrf, iss(idssb(j))+nres, iret) + call xdrfint_(ixdrf, iss(jdssb(j))+nres, iret) + endif else call xdrfint_(ixdrf, ihpb(j), iret) call xdrfint_(ixdrf, jhpb(j), iret) @@ -391,8 +397,13 @@ c & " nss",nss call xdrfint(ixdrf, nss, iret) do j=1,nss if (dyn_ss) then - call xdrfint(ixdrf, idssb(j)+nres, iret) - call xdrfint(ixdrf, jdssb(j)+nres, iret) + if (modecalc.eq.14) then + call xdrfint(ixdrf, idssb(j), iret) + call xdrfint(ixdrf, jdssb(j), iret) + else + call xdrfint(ixdrf, iss(idssb(j))+nres, iret) + call xdrfint(ixdrf, iss(jdssb(j))+nres, iret) + endif else call xdrfint(ixdrf, ihpb(j), iret) call xdrfint(ixdrf, jhpb(j), iret) diff --git a/source/unres/src-HCD-5D/readpdb-mult.F b/source/unres/src-HCD-5D/readpdb-mult.F index 12d011e..e603267 100644 --- a/source/unres/src-HCD-5D/readpdb-mult.F +++ b/source/unres/src-HCD-5D/readpdb-mult.F @@ -28,6 +28,7 @@ C geometry. iterter(i)=0 enddo ibeg=1 + ishift=0 ishift1=0 lsecondary=.false. nhfrag=0 diff --git a/source/unres/src-HCD-5D/readrtns_CSA.F b/source/unres/src-HCD-5D/readrtns_CSA.F index 58b86cc..aeafdc3 100644 --- a/source/unres/src-HCD-5D/readrtns_CSA.F +++ b/source/unres/src-HCD-5D/readrtns_CSA.F @@ -196,6 +196,12 @@ c print *,'AFMlog',AFMlog,selfguide,"KUPA" call readi(controlcard,'TUBEMOD',tubelog,0) c write (iout,*) TUBElog,"TUBEMODE" call readi(controlcard,'IPRINT',iprint,0) +c 6/22/2021 AL: alpha_GB: parameter to switch between the GB SC-SC +c interaction potential and the all-repulsive potential with singularity +c at zero site-site distance + call reada(controlcard,'ALPHA_GB',alpha_GB,1.0d-2) + alpha_GB1 = 1.0d0+1.0d0/alpha_GB + write (iout,*) "alpha_GB",alpha_GB," alpha_GB1",alpha_GB1 C SHIELD keyword sets if the shielding effect of side-chains is used C 0 denots no shielding is used all peptide are equally despite the C solvent accesible area @@ -3066,7 +3072,8 @@ c & sigma_odl_temp(maxres,maxres,max_template) character*2 kic2 character*24 model_ki_dist, model_ki_angle character*500 controlcard - integer ki,i,ii,j,k,l,ii_in_use(maxdim_cont),i_tmp,idomain_tmp, + integer ki,i,ii,j,k,l,ii_in_use(maxchain*maxdim),i_tmp, + & idomain_tmp, & irec,ik,iistart,nres_temp integer ilen external ilen diff --git a/source/unres/src-HCD-5D/unres.F b/source/unres/src-HCD-5D/unres.F index 2e0ebaf..4c60573 100644 --- a/source/unres/src-HCD-5D/unres.F +++ b/source/unres/src-HCD-5D/unres.F @@ -294,10 +294,10 @@ c print *,"after etotal" call enerprint(energy(0)) if (secondary_str) then call hairpin(.true.,nharp,iharp) -c print *,'after hairpin' + print *,'after hairpin' call secondary2(.true.) endif -c print *,'after secondary' + print *,'after secondary' if (minim) then crc overlap test if (indpdb.ne.0 .and. .not.dccart) then -- 1.7.9.5