Merge branch 'homology' of mmka.chem.univ.gda.pl:unres into homology
[unres.git] / source / unres / src_CSA / 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
141 c---------------------------------------------------------------------------
142       subroutine calc_tmscore(tmscore_dp,lprn)
143       implicit real*8 (a-h,o-z)
144       include 'DIMENSIONS'
145 #ifdef MPI
146       include 'mpif.h'
147 #endif
148       include 'COMMON.CHAIN'
149       include 'COMMON.IOUNITS'  
150       include 'COMMON.INTERACT'
151       real x1(maxres),y1(maxres),z1(maxres)
152       integer n_1(maxres),L1
153       real x2(maxres),y2(maxres),z2(maxres)
154       integer n_2(maxres),L2
155       real TM,Rcomm
156       integer Lcomm
157       logical lprn
158
159       L1=0
160 c      print *,"nz_start",nz_start," nz_end",nz_end
161       do i=nz_start,nz_end
162          L1=L1+1
163          n_1(L1)=L1
164          x1(L1)=c(1,i+nstart_seq-nstart_sup)
165          y1(L1)=c(2,i+nstart_seq-nstart_sup)
166          z1(L1)=c(3,i+nstart_seq-nstart_sup)
167
168          n_2(L1)=L1
169          x2(L1)=cref(1,i)
170          y2(L1)=cref(2,i)
171          z2(L1)=cref(3,i)
172       enddo
173       L2=L1
174
175       call TMscore(L1,x1,y1,z1,n_1,L2,x2,y2,z2,n_2,TM,Rcomm,Lcomm)
176
177       tmscore_dp=TM
178       if (lprn) then
179        write (iout,'(a40,f8.2)')
180      &      'TM-score with the reference structure: ',TM
181       endif
182       return
183       end
184