subroutine natsimil(jcon,iii,iprot,lprn) implicit none include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include 'DIMENSIONS.COMPAR' include 'COMMON.IOUNITS' include 'COMMON.COMPAR' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.VAR' include 'COMMON.CLASSES' include 'COMMON.VMCPAR' logical lprn integer jcon,iprot,ib integer i,iii,j,k,ik,kk,inat,lat,jfrag double precision fract double precision rmscalc,rms,rmsnat,qwolynes,gyrate, & strand_signature character*4 liczba character*64 sbin ib = kbatch(jcon,iprot) if (lprn) then write(iout,*) "Protein",iprot," batch",ib," conformation",jcon, & " nlevel",nlevel(iprot) endif c if (lprn) then c write (iout,*) "NATSIMIL: Complete reference structure" c do i=1,nres c write(iout,'(i4,3f10.5)') i,(cref(j,i,iprot),j=1,3) c enddo c endif inat=0 ik = iscore(jcon,1,iprot) if (nlevel(iprot).gt.0) then c Level 1: local structure, Q value, and rmsd do j=1,nfrag(1,iprot) c Calculate the difference between the angles of the target structure and those of the native structure call angnorm(j,0,0,ang_cut1(j,ik,iprot), & nu(inat+1,iii,iprot),fract,ib,iprot,.false.) nu(inat+2,iii,iprot)=qwolynes(1,j,ib,iprot) nu(inat+3,iii,iprot)=rmscalc(0,1,j,jcon,ib,iprot,.false.) nu(inat+3,iii,iprot)=nu(inat+3,iii,iprot)/ & len_frag(j,1,ib,iprot) nu(inat+4,iii,iprot)=gyrate(1,j,ib,iprot) nu(inat+5,iii,iprot)=1.0d0-strand_signature(j,ib,iprot,.false.) if (lprn) write (iout,'(a,i2,a,i2,a,f8.3,a,f10.5,a,f10.5, & a,f10.5)') & "i",1," j",j, & " rms",nu(inat+3,iii,iprot), & " diffang",nu(inat+1,iii,iprot)," Q",nu(inat+2,iii,iprot), & " signature",nu(inat+5,iii,iprot) c Calculate fragment RMSD inat=inat+5 enddo c Level 2: Q value and rmsd do j=1,nfrag(2,iprot) nu(inat+1,iii,iprot)=qwolynes(2,j,ib,iprot) nu(inat+2,iii,iprot)=rmscalc(0,2,j,jcon,ib,iprot,.false.) nu(inat+2,iii,iprot)=nu(inat+2,iii,iprot)/ & len_frag(j,2,ib,iprot) nu(inat+3,iii,iprot)=gyrate(2,j,ib,iprot) if (lprn) write (iout,'(a,i2,a,i2,a,f8.3,a,f10.5)') & "i",2," j",j," rms", & nu(inat+2,iii,iprot)," Q",nu(inat+1,iii,iprot) inat=inat+3 enddo c Next levels: rmsd only do i=3,nlevel(iprot) do j=1,nfrag(i,iprot) nu(inat+1,iii,iprot)=rmscalc(0,i,j,jcon,ib,iprot,.false.) nu(inat+1,iii,iprot)=nu(inat+1,iii,iprot) & /len_frag(j,i,ib,iprot) nu(inat+2,iii,iprot)=gyrate(i,j,ib,iprot) if (lprn) write (iout,'(a,i2,a,i2,a,f8.3)') & "i",i," j",j," rms",nu(inat+1,iii,iprot) inat=inat+2 enddo enddo endif call angnorm12(nu(inat+1,iii,iprot),iprot) nu(inat+2,iii,iprot)=qwolynes(0,1,ib,iprot) nu(inat+3,iii,iprot)=rmsnat(jcon,iprot) nu(inat+3,iii,iprot)=nu(inat+3,iii,iprot)/(nct-nnt+1) nu(inat+4,iii,iprot)=gyrate(0,1,ib,iprot) if (lprn) write (iout,'(a,f8.3,a,f10.5,a,f10.5)') & "angnorm_nat",nu(inat+1,iii,iprot), & " qnat",nu(inat+2,iii,iprot)," rmsnat",nu(inat+3,iii,iprot), & " rgy",nu(inat+4,iii,iprot) inat=inat+4 if (lprn) write (iout,*) "inat",inat," natlike",natlike(iprot) RETURN END c--------------------------------------------------------------------------------------------------- subroutine fragment_list(iprot) implicit none include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include 'DIMENSIONS.COMPAR' include 'COMMON.IOUNITS' include 'COMMON.ALLPROT' include 'COMMON.COMPAR' include 'COMMON.CLASSES' logical lprn /.false./ integer ib,iprot integer i,ilevel,j,k,jfrag do ib=1,nclass(iprot)-1 do jfrag=1,nfrag(1,iprot) nlist_frag(jfrag,ib,iprot)=0 do i=1,npiece(jfrag,1,ib,iprot) if (lprn) write (iout,*) "Protein",iprot," batch",ib, & " jfrag=",jfrag, & "i=",i," fragment",ifrag(1,i,jfrag,ib,iprot), & ifrag(2,i,jfrag,ib,iprot) do j=ifrag(1,i,jfrag,ib,iprot),ifrag(2,i,jfrag,ib,iprot) do k=1,nlist_frag(jfrag,ib,iprot) if (list_frag(k,jfrag,ib,iprot).eq.j) goto 10 enddo nlist_frag(jfrag,ib,iprot)=nlist_frag(jfrag,ib,iprot)+1 list_frag(nlist_frag(jfrag,ib,iprot),jfrag,ib,iprot)=j enddo 10 continue enddo enddo if (lprn) then write (iout,*) "Fragment list for protein",iprot," batch",ib do j=1,nfrag(1,iprot) write (iout,*)"Fragment",j," list",(list_frag(k,j,ib,iprot), & k=1,nlist_frag(j,ib,iprot)) enddo endif enddo return end c----------------------------------------------------------------------------- subroutine find_near_pept_cont(iprot) implicit none include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include 'DIMENSIONS.COMPAR' include 'COMMON.IOUNITS' include 'COMMON.ALLPROT' include 'COMMON.COMPAR' include 'COMMON.CLASSES' include 'COMMON.PEPTCONT' include 'COMMON.INTERACT' include 'COMMON.NAMES' logical lprn /.false./ integer ib,iprot integer i,ii,ilevel,j,lj,k,k1,k2,l do ib=1,nclass(iprot)-1 do j=1,nfrag(1,iprot) if (lprn) write (iout,*) "Protein",iprot," batch",ib, & " jfrag=",j," list",(list_frag(k,j,ib,iprot), & k=1,nlist_frag(j,ib,iprot)) do k=1,nlist_frag(j,ib,iprot) ii=0 lj=list_frag(k,j,ib,iprot) c write (iout,*) "j",j," k",k," lj",lj," sec",isec_ref(lj,iprot) if (isec_ref(lj,iprot).eq.1) then do l=1,ncont_pept_ref(iprot) k1 = icont_pept_ref(1,l,iprot) k2 = icont_pept_ref(2,l,iprot) if (k1.eq.lj .and. isec_ref(k2,iprot).eq.1 c & .and. k2-lj.gt.3 ) then & .and. iabs(k2-lj).gt.3 ) then c write (iout,*) "k2",k2," sec",isec_ref(k2,iprot) if (ii.lt.2) then ii=ii+1 icont_pept_near(ii,lj,ib,iprot)=k2 else write (iout,*) & "Warning number of near contacts for beta fragment", & j," residue",lj," exceeds 2, truncated." goto 10 endif endif if (k2.eq.lj .and. isec_ref(k1,iprot).eq.1 c & .and. k1-lj.gt.3) then & .and. iabs(k1-lj).gt.3) then c write (iout,*) "k1",k1," sec",isec_ref(k1,iprot) if (ii.lt.2) then ii=ii+1 icont_pept_near(ii,lj,ib,iprot)=k1 else write (iout,*) & "Warning number of near contacts for beta fragment", & j," residue",lj," exceeds 2, truncated." goto 10 endif endif enddo endif ncont_pept_near(lj,ib,iprot)=ii enddo 10 continue enddo write (iout,*) & "Near peptide group contacts for beta sheet fragments ", & "protein",iprot," class",ib do j=1,nfrag(1,iprot) write (iout,*) "fragment",j do k=1,nlist_frag(j,ib,iprot) lj=list_frag(k,j,ib,iprot) write (iout,'(a4,1h(,i2,1h),2i5)') restyp(itype(lj)),lj, & (icont_pept_near(ii,lj,ib,iprot), & ii=1,ncont_pept_near(lj,ib,iprot)) enddo enddo call flush(iout) enddo return end c--------------------------------------------------------------- subroutine calc_ref_beta_signatures(iprot) implicit none include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include 'DIMENSIONS.COMPAR' include 'COMMON.IOUNITS' include 'COMMON.ALLPROT' include 'COMMON.COMPAR' include 'COMMON.CLASSES' include 'COMMON.PEPTCONT' include 'COMMON.INTERACT' include 'COMMON.NAMES' logical lprn /.false./ integer ib,iprot integer i,ii,ilevel,j,lj,lj1,jc,jc1,k,k1,k2,l double precision signature external signature do ib=1,nclass(iprot)-1 do j=1,nfrag(1,iprot) if (lprn) write (iout,*) "Protein",iprot," batch",ib, & " jfrag=",j," list",(list_frag(k,j,ib,iprot), & k=1,nlist_frag(j,ib,iprot)) ii=0 do k=1,nlist_frag(j,ib,iprot) lj=list_frag(k,j,ib,iprot) if (isec_ref(lj,iprot).eq.1) then do l=1,ncont_pept_near(lj,ib,iprot) jc=icont_pept_near(l,lj,ib,iprot) call find_dir(lj,jc,lj1,jc1,ib,iprot) sig_ref(l,lj,ib,iprot)=signature(lj,jc,lj1,jc1,lprn) c write (iout,*) "lj",lj," jc",jc," lj1",lj1," jc1",jc1, c & " sig_ref",sig_ref(l,lj,ib,iprot) enddo endif enddo enddo write (iout,*) & "Reference signatures protein",iprot," class",ib do j=1,nfrag(1,iprot) write (iout,*) "fragment",j do k=1,nlist_frag(j,ib,iprot) lj=list_frag(k,j,ib,iprot) write (iout,'(a4,1h(,i2,1h),8f10.5)') restyp(itype(lj)),lj, & (sig_ref(ii,lj,ib,iprot),ii=1,ncont_pept_near(lj,ib,iprot)) enddo enddo call flush(iout) enddo return end c--------------------------------------------------------------- double precision function gyrate(ilevel,jfrag,ib,iprot) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include 'DIMENSIONS.COMPAR' include 'COMMON.INTERACT' include 'COMMON.CHAIN' include 'COMMON.IOUNITS' include 'COMMON.COMPAR' include 'COMMON.VAR' double precision cen(3),rg logical iadded(maxres),lprn /.false./ double precision creff(3,maxres2),cc(3,maxres2) integer inumber(2,maxres) common /ccc/ creff,cc,iadded,inumber IF (ilevel.eq.0) then do j=1,3 cen(j)=0.0d0 enddo do i=nnt,nct do j=1,3 cen(j)=cen(j)+c(j,i) enddo enddo do j=1,3 cen(j)=cen(j)/dble(nct-nnt+1) enddo rg = 0.0d0 do i = nnt, nct do j=1,3 rg = rg + (c(j,i)-cen(j))**2 enddo end do gyrate = dsqrt(rg/dble(nct-nnt+1)) ELSE ii=0 do l=1,nres iadded(l)=.false. enddo do k=1,npiece(jfrag,ilevel,ib,iprot) if (ilevel.eq.1) then if (lprn) & write (iout,*) "Level 1: jfrag=",jfrag,"k=",k, & " adding fragment", & ifrag(1,k,jfrag,ib,iprot),ifrag(2,k,jfrag,ib,iprot) call cprep(ifrag(1,k,jfrag,ib,iprot), & ifrag(2,k,jfrag,ib,iprot),0,ii,iprot) else kk = ipiece(k,jfrag,ilevel,ib,iprot) do l=1,npiece(kk,1,ib,iprot) if (lprn) & write (iout,*) "Level",i,": jfrag=",jfrag,"k=",k," kk=",kk, & " l=",l," adding fragment", & ifrag(1,l,kk,ib,iprot),ifrag(2,l,kk,ib,iprot) call cprep(ifrag(1,l,kk,ib,iprot),ifrag(2,l,kk,ib,iprot), & 0,ii,iprot) enddo endif enddo if (lprn) then do k=1,ii write(iout,'(5i4,2(3f10.5,5x))') ilevel,jfrag,k,inumber(1,k), & inumber(2,k),(creff(l,k),l=1,3),(cc(l,k),l=1,3) enddo endif do j=1,3 cen(j)=0.0d0 enddo do i=1,ii do j=1,3 cen(j)=cen(j)+cc(j,i) enddo enddo do j=1,3 cen(j)=cen(j)/dble(ii) enddo rg = 0.0d0 do i = 1, ii do j=1,3 rg = rg + (cc(j,i)-cen(j))**2 enddo end do gyrate = dsqrt(rg/dble(ii)) ENDIF return end