Merge branch 'bartek' of mmka.chem.univ.gda.pl:unres into bartek
[unres.git] / source / unres / src_MD / 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