wham and cluster_wham Adam's new constr_dist multichain
[unres.git] / 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