subroutine rms_nac_nnc(rms,frac,frac_nn,co,lprn) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.CHAIN' include 'COMMON.CONTACTS' include 'COMMON.IOUNITS' double precision przes(3),obr(3,3) logical non_conv,lprn c call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, c & obr,non_conv) c rms=dsqrt(rms) call rmsd(rms) call contact(.false.,ncont,icont,co) frac=contact_fract(ncont,ncont_ref,icont,icont_ref) frac_nn=contact_fract_nn(ncont,ncont_ref,icont,icont_ref) if (lprn) write (iout,'(a,f8.3/a,f8.3/a,f8.3/a,f8.3)') & 'RMS deviation from the reference structure:',rms, & ' % of native contacts:',frac*100, & ' % of nonnative contacts:',frac_nn*100, & ' contact order:',co return end c--------------------------------------------------------------------------- subroutine rmsd(drms) implicit real*8 (a-h,o-z) include 'DIMENSIONS' #ifdef MPI include 'mpif.h' #endif include 'COMMON.CHAIN' include 'COMMON.IOUNITS' include 'COMMON.INTERACT' include 'COMMON.CONTROL' logical non_conv double precision przes(3),obrot(3,3) double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2) nperm=1 do i=1,symetr nperm=nperm*i enddo iatom=0 rminroz=100d2 c print *,"nz_start",nz_start," nz_end",nz_end c if (symetr.le.1) then C print *,nperm,"nperm" do kkk=1,nperm c do i=nz_start,nz_end c iatom=iatom+1 c iti=itype(i) c do k=1,3 c ccopy(k,iatom)=c(k,i+nstart_seq-nstart_sup) c crefcopy(k,iatom,kkk)=cref(k,i,kkk) c enddo c if (iz_sc.eq.1.and.iti.ne.10) then c iatom=iatom+1 c do k=1,3 c ccopy(k,iatom)=c(k,nres+i+nstart_seq-nstart_sup) c crefcopy(k,iatom,kkk)=cref(k,nres+i,kkk) c enddo c endif c enddo c else c do kkk=1,nperm iatom=0 do i=nz_start,nz_end iatom=iatom+1 iti=itype(i) do k=1,3 ccopy(k,iatom)=c(k,i+nstart_seq-nstart_sup) crefcopy(k,iatom)=cref(k,i,kkk) enddo if (iz_sc.eq.1.and.iti.ne.10) then iatom=iatom+1 do k=1,3 ccopy(k,iatom)=c(k,nres+i+nstart_seq-nstart_sup) crefcopy(k,iatom)=cref(k,nres+i,kkk) enddo endif enddo c enddo c endif c ----- diagnostics C do kkk=1,nperm C write (iout,*) 'Ccopy and CREFcopy adasko',iatom C print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), C & (crefcopy(j,k),j=1,3),k=1,iatom) C write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), C & (crefcopy(j,k),j=1,3),k=1,iatom) C enddo Cc ----- end diagnostics c do kkk=1,nperm call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom, & przes,obrot,non_conv) if (non_conv) then print *,'Problems in FITSQ!!! rmsd' write (iout,*) 'Problems in FITSQ!!! rmsd' print *,'Ccopy and CREFcopy' write (iout,*) 'Ccopy and CREFcopy' print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), & (crefcopy(j,k),j=1,3),k=1,iatom) write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), & (crefcopy(j,k),j=1,3),k=1,iatom) #ifdef MPI c call mpi_abort(mpi_comm_world,ierror,ierrcode) roznica=100.0d10 #else stop #endif endif C write (iout,*) "roznica", roznica,kkk if (roznica.le.rminroz) rminroz=roznica enddo drms=dsqrt(dabs(rminroz)) c ---- diagnostics c write (iout,*) "nperm,symetr", nperm,symetr c ---- end diagnostics return end c-------------------------------------------- subroutine rmsd_csa(drms) implicit real*8 (a-h,o-z) include 'DIMENSIONS' #ifdef MPI include 'mpif.h' #endif include 'COMMON.CHAIN' include 'COMMON.IOUNITS' include 'COMMON.INTERACT' logical non_conv double precision przes(3),obrot(3,3) double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2) kkk=1 iatom=0 do i=nz_start,nz_end iatom=iatom+1 iti=itype(i) do k=1,3 ccopy(k,iatom)=c(k,i) crefcopy(k,iatom)=crefjlee(k,i) enddo if (iz_sc.eq.1.and.iti.ne.10) then iatom=iatom+1 do k=1,3 ccopy(k,iatom)=c(k,nres+i) crefcopy(k,iatom)=crefjlee(k,nres+i) enddo endif enddo call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom, & przes,obrot,non_conv) if (non_conv) then print *,'Problems in FITSQ!!! rmsd_csa' write (iout,*) 'Problems in FITSQ!!! rmsd_csa' print *,'Ccopy and CREFcopy' write (iout,*) 'Ccopy and CREFcopy' print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), & (crefcopy(j,k),j=1,3),k=1,iatom) write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), & (crefcopy(j,k),j=1,3),k=1,iatom) #ifdef MPI call mpi_abort(mpi_comm_world,ierror,ierrcode) #else stop #endif endif drms=dsqrt(dabs(roznica)) return end