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