source/unres/src_MD-M/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       include 'COMMON.CONTROL'
  35       logical non_conv
  36       double precision przes(3),obrot(3,3)
  37       double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2)
  38       nperm=1
  39       do i=1,symetr
  40       nperm=nperm*i
  41       enddo
  42       iatom=0
  43       rminroz=100d2
  44 c      print *,"nz_start",nz_start," nz_end",nz_end
  45 c      if (symetr.le.1) then
  46       do kkk=1,nperm
  47 c      do i=nz_start,nz_end
  48 c        iatom=iatom+1
  49 c        iti=itype(i)
  50 c        do k=1,3
  51 c         ccopy(k,iatom)=c(k,i+nstart_seq-nstart_sup)
  52 c         crefcopy(k,iatom,kkk)=cref(k,i,kkk)
  53 c        enddo
  54 c        if (iz_sc.eq.1.and.iti.ne.10) then
  55 c          iatom=iatom+1
  56 c          do k=1,3
  57 c           ccopy(k,iatom)=c(k,nres+i+nstart_seq-nstart_sup)
  58 c           crefcopy(k,iatom,kkk)=cref(k,nres+i,kkk)
  59 c          enddo
  60 c        endif
  61 c      enddo
  62 c      else
  63 c      do kkk=1,nperm
  64       iatom=0
  65       do i=nz_start,nz_end
  66         iatom=iatom+1
  67         iti=itype(i)
  68         do k=1,3
  69          ccopy(k,iatom)=c(k,i+nstart_seq-nstart_sup)
  70          crefcopy(k,iatom)=cref(k,i,kkk)
  71         enddo
  72         if (iz_sc.eq.1.and.iti.ne.10) then
  73           iatom=iatom+1
  74           do k=1,3
  75            ccopy(k,iatom)=c(k,nres+i+nstart_seq-nstart_sup)
  76            crefcopy(k,iatom)=cref(k,nres+i,kkk)
  77           enddo
  78         endif
  79       enddo
  80 c      enddo
  81 c      endif
  82
  83 c ----- diagnostics
  84 c         do kkk=1,nperm
  85 c          write (iout,*) 'Ccopy and CREFcopy'
  86 c          print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3),
  87 c     &           (crefcopy(j,k),j=1,3),k=1,iatom)
  88 c          write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3),
  89 c     &           (crefcopy(j,k),j=1,3),k=1,iatom)
  90 c         enddo
  91 c ----- end diagnostics
  92 c      do kkk=1,nperm
  93       call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom,
  94      &                                      przes,obrot,non_conv)
  95       if (non_conv) then
  96           print *,'Problems in FITSQ!!! rmsd'
  97           write (iout,*) 'Problems in FITSQ!!! rmsd'
  98           print *,'Ccopy and CREFcopy'
  99           write (iout,*) 'Ccopy and CREFcopy'
 100           print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3),
 101      &           (crefcopy(j,k),j=1,3),k=1,iatom)
 102           write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3),
 103      &           (crefcopy(j,k),j=1,3),k=1,iatom)
 104 #ifdef MPI
 105 c          call mpi_abort(mpi_comm_world,ierror,ierrcode)
 106            roznica=100.0d10
 107 #else
 108           stop
 109 #endif
 110        endif
 111 c       write (iout,*) "roznica", roznica,kkk
 112        if (roznica.le.rminroz) rminroz=roznica
 113        enddo
 114        drms=dsqrt(dabs(rminroz))
 115 c ---- diagnostics
 116 c        write (iout,*) "nperm,symetr", nperm,symetr
 117 c ---- end diagnostics
 118        return
 119        end
 120
 121 c--------------------------------------------
 122       subroutine rmsd_csa(drms)
 123       implicit real*8 (a-h,o-z)
 124       include 'DIMENSIONS'
 125 #ifdef MPI
 126       include 'mpif.h'
 127 #endif
 128       include 'COMMON.CHAIN'
 129       include 'COMMON.IOUNITS'
 130       include 'COMMON.INTERACT'
 131       logical non_conv
 132       double precision przes(3),obrot(3,3)
 133       double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2)
 134       kkk=1
 135       iatom=0
 136       do i=nz_start,nz_end
 137         iatom=iatom+1
 138         iti=itype(i)
 139         do k=1,3
 140          ccopy(k,iatom)=c(k,i)
 141          crefcopy(k,iatom)=crefjlee(k,i)
 142         enddo
 143         if (iz_sc.eq.1.and.iti.ne.10) then
 144           iatom=iatom+1
 145           do k=1,3
 146            ccopy(k,iatom)=c(k,nres+i)
 147            crefcopy(k,iatom)=crefjlee(k,nres+i)
 148           enddo
 149         endif
 150       enddo
 151
 152       call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom,
 153      &                                      przes,obrot,non_conv)
 154       if (non_conv) then
 155           print *,'Problems in FITSQ!!! rmsd_csa'
 156           write (iout,*) 'Problems in FITSQ!!! rmsd_csa'
 157           print *,'Ccopy and CREFcopy'
 158           write (iout,*) 'Ccopy and CREFcopy'
 159           print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3),
 160      &           (crefcopy(j,k),j=1,3),k=1,iatom)
 161           write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3),
 162      &           (crefcopy(j,k),j=1,3),k=1,iatom)
 163 #ifdef MPI
 164           call mpi_abort(mpi_comm_world,ierror,ierrcode)
 165 #else
 166           stop
 167 #endif
 168        endif
 169        drms=dsqrt(dabs(roznica))
 170        return
 171        end
 172