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