source/unres/src_MD/src/rmsd.F

   1       subroutine rms_nac_nnc(rms,frac,frac_nn,co,lprn)
   2         implicit real*8 (a-h,o-z)
   3         include 'DIMENSIONS'
   4         include 'COMMON.CHAIN'
   5         include 'COMMON.CONTACTS'
   6         include 'COMMON.IOUNITS'
   7         double precision przes(3),obr(3,3)
   8         logical non_conv,lprn
   9 c        call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes,
  10 c     &             obr,non_conv)
  11 c        rms=dsqrt(rms)
  12         call rmsd(rms)
  13         call contact(.false.,ncont,icont,co)
  14         frac=contact_fract(ncont,ncont_ref,icont,icont_ref)
  15         frac_nn=contact_fract_nn(ncont,ncont_ref,icont,icont_ref)
  16         if (lprn) write (iout,'(a,f8.3/a,f8.3/a,f8.3/a,f8.3)')
  17      &    'RMS deviation from the reference structure:',rms,
  18      &    ' % of native contacts:',frac*100,
  19      &    ' % of nonnative contacts:',frac_nn*100,
  20      &    ' contact order:',co
  21
  22       return
  23       end
  24 c---------------------------------------------------------------------------
  25       subroutine rmsd(drms)
  26       implicit real*8 (a-h,o-z)
  27       include 'DIMENSIONS'
  28 #ifdef MPI
  29       include 'mpif.h'
  30 #endif
  31       include 'COMMON.CHAIN'
  32       include 'COMMON.IOUNITS'
  33       include 'COMMON.INTERACT'
  34       logical non_conv
  35       double precision przes(3),obrot(3,3)
  36       double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2)
  37
  38       iatom=0
  39 c      print *,"nz_start",nz_start," nz_end",nz_end
  40       do i=nz_start,nz_end
  41         iatom=iatom+1
  42         iti=itype(i)
  43         do k=1,3
  44          ccopy(k,iatom)=c(k,i+nstart_seq-nstart_sup)
  45          crefcopy(k,iatom)=cref(k,i)
  46         enddo
  47         if (iz_sc.eq.1.and.iti.ne.10) then
  48           iatom=iatom+1
  49           do k=1,3
  50            ccopy(k,iatom)=c(k,nres+i+nstart_seq-nstart_sup)
  51            crefcopy(k,iatom)=cref(k,nres+i)
  52           enddo
  53         endif
  54       enddo
  55
  56 c ----- diagnostics
  57 c          write (iout,*) 'Ccopy and CREFcopy'
  58 c          print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3),
  59 c     &           (crefcopy(j,k),j=1,3),k=1,iatom)
  60 c          write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3),
  61 c     &           (crefcopy(j,k),j=1,3),k=1,iatom)
  62 c ----- end diagnostics
  63
  64       call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom,
  65      &                                      przes,obrot,non_conv)
  66       if (non_conv) then
  67           print *,'Problems in FITSQ!!! rmsd'
  68           write (iout,*) 'Problems in FITSQ!!! rmsd'
  69           print *,'Ccopy and CREFcopy'
  70           write (iout,*) 'Ccopy and CREFcopy'
  71           print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3),
  72      &           (crefcopy(j,k),j=1,3),k=1,iatom)
  73           write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3),
  74      &           (crefcopy(j,k),j=1,3),k=1,iatom)
  75 #ifdef MPI
  76 c          call mpi_abort(mpi_comm_world,ierror,ierrcode)
  77            roznica=100.0
  78 #else
  79           stop
  80 #endif
  81        endif
  82        drms=dsqrt(dabs(roznica))
  83 c ---- diagnostics
  84 c       write (iout,*) "rms",drms
  85 c ---- end diagnostics
  86        return
  87        end
  88
  89 c--------------------------------------------
  90       subroutine rmsd_csa(drms)
  91       implicit real*8 (a-h,o-z)
  92       include 'DIMENSIONS'
  93 #ifdef MPI
  94       include 'mpif.h'
  95 #endif
  96       include 'COMMON.CHAIN'
  97       include 'COMMON.IOUNITS'
  98       include 'COMMON.INTERACT'
  99       logical non_conv
 100       double precision przes(3),obrot(3,3)
 101       double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2)
 102
 103       iatom=0
 104       do i=nz_start,nz_end
 105         iatom=iatom+1
 106         iti=itype(i)
 107         do k=1,3
 108          ccopy(k,iatom)=c(k,i)
 109          crefcopy(k,iatom)=crefjlee(k,i)
 110         enddo
 111         if (iz_sc.eq.1.and.iti.ne.10) then
 112           iatom=iatom+1
 113           do k=1,3
 114            ccopy(k,iatom)=c(k,nres+i)
 115            crefcopy(k,iatom)=crefjlee(k,nres+i)
 116           enddo
 117         endif
 118       enddo
 119
 120       call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom,
 121      &                                      przes,obrot,non_conv)
 122       if (non_conv) then
 123           print *,'Problems in FITSQ!!! rmsd_csa'
 124           write (iout,*) 'Problems in FITSQ!!! rmsd_csa'
 125           print *,'Ccopy and CREFcopy'
 126           write (iout,*) 'Ccopy and CREFcopy'
 127           print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3),
 128      &           (crefcopy(j,k),j=1,3),k=1,iatom)
 129           write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3),
 130      &           (crefcopy(j,k),j=1,3),k=1,iatom)
 131 #ifdef MPI
 132           call mpi_abort(mpi_comm_world,ierror,ierrcode)
 133 #else
 134           stop
 135 #endif
 136        endif
 137        drms=dsqrt(dabs(roznica))
 138        return
 139        end
 140