X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc_MD-NEWSC%2Frmsd.F;fp=source%2Funres%2Fsrc_MD-NEWSC%2Frmsd.F;h=52e7b3719f1f87387d5e5a50f407ecf09b1f58dc;hb=d101c97dea752458d76055fdbae49c26fff03c1f;hp=0000000000000000000000000000000000000000;hpb=325eda160c9ad2982501e091ca40606a29043712;p=unres.git

diff --git a/source/unres/src_MD-NEWSC/rmsd.F b/source/unres/src_MD-NEWSC/rmsd.F
new file mode 100644
index 0000000..52e7b37
--- /dev/null
+++ b/source/unres/src_MD-NEWSC/rmsd.F
@@ -0,0 +1,140 @@
+      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'
+      logical non_conv
+      double precision przes(3),obrot(3,3)
+      double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2)
+
+      iatom=0
+c      print *,"nz_start",nz_start," nz_end",nz_end
+      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)
+        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)
+          enddo
+        endif
+      enddo
+
+c ----- diagnostics
+c          write (iout,*) 'Ccopy and CREFcopy'
+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 ----- end diagnostics
+
+      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.0
+#else          
+          stop
+#endif
+       endif
+       drms=dsqrt(dabs(roznica))
+c ---- diagnostics
+c       write (iout,*) "rms",drms
+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)
+
+      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
+