X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fcompare.F90;h=058b20177cfa781fbfd0bae1bdd709905b86349f;hb=bc23440fbe68672d430f71f22f46b11265f003db;hp=cbbb35d56c8ea4ea1492a50ff562e49a9d990153;hpb=4367d241fbb2bc284580092d2d177b7c79ac3a42;p=unres4.git diff --git a/source/unres/compare.F90 b/source/unres/compare.F90 index cbbb35d..058b201 100644 --- a/source/unres/compare.F90 +++ b/source/unres/compare.F90 @@ -37,18 +37,29 @@ ! include 'COMMON.NAMES' real(kind=8) :: facont=1.569D0 ! facont = (2/(1-sqrt(1-1/4)))**(1/6) integer :: ncont - integer,dimension(2,12*nres) :: icont!(2,12*nres) !(2,maxcont) (maxcont=12*maxres) + integer,dimension(2,100*nres) :: icont!(2,100*nres) !(2,maxcont) (maxcont=12*maxres) logical :: lprint !el local variables real(kind=8) :: co,rcomp - integer :: kkk,i,j,i1,i2,it1,it2,iti,itj + integer :: kkk,i,j,i1,i2,it1,it2,iti,itj,inum,jnum ncont=0 kkk=3 do i=nnt+kkk,nct - iti=iabs(itype(i,1)) + iti=iabs(itype(i,molnum(i))) + if (molnum(i).lt.3) then + inum=i+nres + else + inum=i + endif + do j=nnt,i-kkk - itj=iabs(itype(j,1)) + itj=iabs(itype(j,molnum(i))) + if (molnum(j).lt.3) then + jnum=j+nres + else + jnum=j + endif if (ipot.ne.4) then ! rcomp=sigmaii(iti,itj)+1.0D0 rcomp=facont*sigmaii(iti,itj) @@ -58,7 +69,7 @@ endif ! rcomp=6.5D0 ! print *,'rcomp=',rcomp,' dist=',dist(nres+i,nres+j) - if (dist(nres+i,nres+j).lt.rcomp) then + if (dist(inum,jnum).lt.rcomp) then ncont=ncont+1 icont(1,ncont)=i icont(2,ncont)=j @@ -73,7 +84,7 @@ it1=itype(i1,1) it2=itype(i2,1) write (iout,'(i3,2x,a,i4,2x,a,i4)') & - i,restyp(it1),i1,restyp(it2),i2 + i,restyp(it1,1),i1,restyp(it2,1),i2 enddo endif co = 0.0d0 @@ -90,7 +101,7 @@ ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' integer :: ncont,ncont_ref - integer,dimension(2,12*nres) :: icont,icont_ref !(2,12*nres) (2,maxcont) (maxcont=12*maxres) + integer,dimension(2,100*nres) :: icont,icont_ref !(2,100*nres) (2,maxcont) (maxcont=12*maxres) !el local variables integer :: i,j,nmatch nmatch=0 @@ -117,7 +128,7 @@ ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' integer :: ncont,ncont_ref - integer,dimension(2,12*nres) :: icont,icont_ref !(2,12*nres) (2,maxcont) (maxcont=12*maxres) + integer,dimension(2,100*nres) :: icont,icont_ref !(2,100*nres) (2,maxcont) (maxcont=12*maxres) !el local variables integer :: i,j,nmatch nmatch=0 @@ -149,14 +160,14 @@ ! include 'COMMON.FFIELD' ! include 'COMMON.NAMES' integer :: ncont - integer,dimension(2,12*nres) :: icont !(2,maxcont) (maxcont=12*maxres) + integer,dimension(2,100*nres) :: icont !(2,maxcont) (maxcont=12*maxres) integer :: nharp - integer,dimension(4,nres/3) :: iharp !(4,nres/3)(4,maxres/3) + integer,dimension(4,nres) :: iharp !(4,nres/3)(4,maxres/3) logical :: lprint,not_done real(kind=8) :: rcomp=6.0d0 !el local variables integer :: i,j,kkk,k,i1,i2,it1,it2,j1,ii1,jj1 -! allocate(icont(2,12*nres)) +! allocate(icont(2,100*nres)) ncont=0 kkk=0 @@ -184,7 +195,7 @@ it1=itype(i1,1) it2=itype(i2,1) write (iout,'(i3,2x,a,i4,2x,a,i4)') & - i,restyp(it1),i1,restyp(it2),i2 + i,restyp(it1,1),i1,restyp(it2,1),i2 enddo endif ! finding hairpins @@ -230,8 +241,8 @@ ii1=iharp(3,i) jj1=iharp(4,i) write (iout,*) - write (iout,'(20(a,i3,1x))') (restyp(itype(k,1)),k,k=i1,ii1) - write (iout,'(20(a,i3,1x))') (restyp(itype(k,1)),k,k=j1,jj1,-1) + write (iout,'(20(a,i3,1x))') (restyp(itype(k,1),1),k,k=i1,ii1) + write (iout,'(20(a,i3,1x))') (restyp(itype(k,1),1),k,k=j1,jj1,-1) ! do k=jj1,j1,-1 ! write (iout,'(a,i3,$)') restyp(itype(k,1)),k ! enddo @@ -257,8 +268,8 @@ real(kind=8) :: ael6_i,ael3_i real(kind=8),dimension(2,2) :: app_,bpp_,rpp_ integer :: ncont - integer,dimension(2,12*nres) :: icont !(2,12*nres)(2,maxcont) (maxcont=12*maxres) - real(kind=8),dimension(12*nres) :: econt !(maxcont) + integer,dimension(2,100*nres) :: icont !(2,100*nres)(2,maxcont) (maxcont=12*maxres) + real(kind=8),dimension(100*nres) :: econt !(maxcont) !el local variables integer :: i,j,k,iteli,itelj,i1,i2,it1,it2,ic1,ic2 real(kind=8) :: elcutoff,elecutoff_14,rri,ees,evdw @@ -279,7 +290,7 @@ data elpp_6 /-0.2379d0,-0.2056d0,-0.2056d0,-0.0610d0/ data elpp_3 / 0.0503d0, 0.0000d0, 0.0000d0, 0.0692d0/ -!el allocate(econt(12*nres)) !(maxcont) +!el allocate(econt(100*nres)) !(maxcont) elcutoff = -0.3d0 elecutoff_14 = -0.5d0 @@ -300,6 +311,7 @@ ncont=0 ees=0.0 evdw=0.0 + print *, "nntt,nct",nnt,nct-2 do 1 i=nnt,nct-2 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) goto 1 xi=c(1,i) @@ -366,7 +378,7 @@ it1=itype(i1,1) it2=itype(i2,1) write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') & - i,restyp(it1),i1,restyp(it2),i2,econt(i) + i,restyp(it1,1),i1,restyp(it2,1),i2,econt(i) enddo endif ! For given residues keep only the contacts with the greatest energy. @@ -452,7 +464,7 @@ it1=itype(i1,1) it2=itype(i2,1) write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') & - i,restyp(it1),i1,restyp(it2),i2,econt(i) + i,restyp(it1,1),i1,restyp(it2,1),i2,econt(i) enddo endif return @@ -470,14 +482,14 @@ ! include 'COMMON.CONTROL' integer :: ncont,i,j,i1,j1,nbeta,nstrand,ii1,jj1,ij,nhelix,& iii1,jjj1 - integer,dimension(2,12*nres) :: icont !(2,maxcont) (maxcont=12*maxres) - integer,dimension(nres,4) :: isec !(maxres,4) + integer,dimension(2,100*nres) :: icont !(2,maxcont) (maxcont=12*maxres) + integer,dimension(nres,0:4) :: isec !(maxres,4) integer,dimension(nres) :: nsec !(maxres) logical :: lprint,not_done !,freeres real(kind=8) :: p1,p2 !el external freeres -!el allocate(icont(2,12*nres),isec(nres,4),nsec(nres)) +!el allocate(icont(2,100*nres),isec(nres,4),nsec(nres)) if(.not.dccart) call chainbuild_cart if(.not.allocated(hfrag)) allocate(hfrag(2,nres/3)) !(2,maxres/3) @@ -492,6 +504,8 @@ enddo call elecont(lprint,ncont,icont) + print *,"after elecont" + if (nres_molec(1).eq.0) return ! finding parallel beta !d write (iout,*) '------- looking for parallel beta -----------' @@ -742,7 +756,7 @@ write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'" write(12,'(a20)') "XMacStand ribbon.mac" - + if (nres_molec(1).eq.0) return write(iout,*) 'UNRES seq:' do j=1,nbfrag write(iout,*) 'beta ',(bfrag(i,j),i=1,4) @@ -815,6 +829,7 @@ ! & obr,non_conv) ! rms=dsqrt(rms) call rmsd(rms) +! print *,"before contact" !elte(iout,*) "rms_nacc before contact" call contact(.false.,ncont,icont,co) frac=contact_fract(ncont,ncont_ref,icont,icont_ref) @@ -877,6 +892,7 @@ ! else ! do kkk=1,nperm iatom=0 + print *,nz_start,nz_end,nstart_seq-nstart_sup do i=nz_start,nz_end iatom=iatom+1 iti=itype(i,1) @@ -4180,7 +4196,7 @@ do i=nnt,nct if (itype(i,1).ne.10) then !d print *,'i=',i,' itype=',itype(i,1),' theta=',theta(i+1) - call gen_side(itype(i,1),theta(i+1),alph(i),omeg(i),fail) + call gen_side(itype(i,1),theta(i+1),alph(i),omeg(i),fail,1) endif enddo call chainbuild @@ -4196,7 +4212,7 @@ alph0=alph(ind_sc) omeg0=omeg(ind_sc) call gen_side(itype(ind_sc,1),theta(ind_sc+1),alph(ind_sc),& - omeg(ind_sc),fail) + omeg(ind_sc),fail,1) call chainbuild call etotal(energia) !d write (iout,'(a,i5,a,i4,2(a,f8.3),2(a,1pe14.5))')