ctest wham & cluster src-M
[unres.git] / source / unres / src_MD / compare_s1.F
1       subroutine compare_s1(n_thr,num_thread_save,energyx,x,
2      &                      icomp,enetbss,coordss,rms_d,modif,iprint)
3 C This subroutine compares the new conformation, whose variables are in X
4 C with the previously accumulated conformations whose energies and variables
5 C are stored in ENETBSS and COORDSS, respectively. The meaning of other 
6 C variables is as follows:
7
8 C N_THR - on input the previous # of accumulated confs, on output the current
9 C         # of accumulated confs.
10 C N_REPEAT - an array that indicates how many times the structure has already
11 C         been used to start the reversed-reversing procedure. Addition of 
12 C         a new structure replacement of a structure with a similar, but 
13 C         lower-energy structure resets the respective entry in N_REPEAT to zero
14 C I9   -  output unit
15 C ENERGYX,X - the energy and variables of the new conformations.
16 C ICOMP - comparison result: 
17 C         0 - the new structure is similar to one of the previous ones and does
18 C             not have a remarkably lower energy and is therefore rejected;
19 C         1 - the new structure is different and is added to the set, because
20 C             there is still room in the COORDSS and ENETBSS arrays; 
21 C         2 - the new structure is different, but higher in energy than any 
22 C             previous one and is therefore rejected
23 C         3 - there is no more room in the COORDSS and ENETBSS arrays, but 
24 C             the new structure is lower in energy than at least the highest-
25 C             energy previous structure and therefore replaces it.
26 C         9 - the new structure is similar to a number of previous structures,
27 C             but has a remarkably lower energy than any of them; therefore
28 C             replaces all these structures;
29 C MODIF - a logical variable that shows whether to include the new structure
30 C         in the set of accumulated structures
31       implicit real*8 (a-h,o-z)
32       include 'DIMENSIONS'
33       include 'COMMON.GEO'
34       include 'COMMON.VAR'
35 crc      include 'COMMON.DEFORM'
36       include 'COMMON.IOUNITS'
37 #ifdef UNRES
38       include 'COMMON.CHAIN'
39 #endif
40
41       dimension x(maxvar)
42       dimension x1(maxvar)
43       double precision przes(3),obrot(3,3)
44       integer list(max_thread)
45       logical non_conv,modif
46       double precision enetbss(max_threadss)
47       double precision coordss(maxvar,max_threadss)
48
49       nlist=0
50 #ifdef UNRES
51       call var_to_geom(nvar,x)
52       call chainbuild
53       do k=1,2*nres
54        do kk=1,3
55          cref(kk,k)=c(kk,k)
56        enddo
57       enddo 
58 #endif
59 c      write(iout,*)'*ene=',energyx
60       j=0
61       enex_jp=-1.0d+99
62       do i=1,n_thr
63        do k=1,nvar
64         x1(k)=coordss(k,i)
65        enddo
66        if (iprint.gt.3) then
67        write (iout,*) 'Compare_ss, i=',i
68        write (iout,*) 'New structure Energy:',energyx
69        write (iout,'(10f8.3)') (rad2deg*x(k),k=1,nvar)
70        write (iout,*) 'Template structure Energy:',enetbss(i)
71        write (iout,'(10f8.3)') (rad2deg*x1(k),k=1,nvar)
72        endif
73
74 #ifdef UNRES
75        call var_to_geom(nvar,x1)
76        call chainbuild
77 cd     write(iout,*)'C and CREF'
78 cd     write(iout,'(i5,3f10.5,5x,3f10.5)')(k,(c(j,k),j=1,3),
79 cd   &           (cref(j,k),j=1,3),k=1,nres)
80        call fitsq(roznica,c(1,1),cref(1,1),nres,przes,obrot,non_conv)
81        if (non_conv) then
82          print *,'Problems in FITSQ!!!'
83          print *,'X'
84          print '(10f8.3)',(x(k),k=1,nvar)
85          print *,'X1'
86          print '(10f8.3)',(x1(k),k=1,nvar)
87          print *,'C and CREF'
88          print '(i5,3f10.5,5x,3f10.5)',(k,(c(j,k),j=1,3),
89      &           (cref(j,k),j=1,3),k=1,nres)
90        endif
91        roznica=dsqrt(dabs(roznica))
92        iresult = 1
93        if (roznica.lt.rms_d) iresult = 0 
94 #else
95        energyy=enetbss(i)
96        call cmprs(x,x1,roznica,energyx,energyy,iresult)
97 #endif
98        if (iprint.gt.1) write(iout,'(i5,f10.6,$)') i,roznica
99 c       print '(i5,f8.3)',i,roznica
100        if(iresult.eq.0) then
101         nlist = nlist + 1
102         list(nlist)=i
103         if (iprint.gt.1) write(iout,*)
104         if(energyx.ge.enetbss(i)) then
105          if (iprint.gt.1) 
106      &      write(iout,*)'s*>> structure rejected - same as nr ',i,
107      &  ' RMS',roznica
108          minimize_s_flag=0
109          icomp=0
110          go to 1106
111         endif
112        endif
113        if(energyx.lt.enetbss(i).and.enex_jp.lt.enetbss(i))then
114         j=i
115         enex_jp=enetbss(i)
116        endif
117       enddo
118       if (iprint.gt.1) write(iout,*)
119       if(nlist.gt.0) then
120        if (modif) then
121          if (iprint.gt.1) 
122      &    write(iout,'(a,i3,$)')'s*>> structure accepted1 - repl nr ',
123      &   list(1) 
124        else
125          if (iprint.gt.1) 
126      &    write(iout,'(a,i3)')
127      &    's*>> structure accepted1 - would repl nr ',list(1) 
128        endif
129        icomp=9
130        if (.not. modif) goto 1106
131        j=list(1)
132        enetbss(j)=energyx
133        do i=1,nvar
134         coordss(i,j)=x(i)
135        enddo
136        do j=2,nlist
137         if (iprint.gt.1) write(iout,'(i3,$)')list(j)
138         do kk=list(j)+1,nlist
139          enetbss(kk-1)=enetbss(kk) 
140          do i=1,nvar
141           coordss(i,kk-1)=coordss(i,kk)
142          enddo
143        enddo
144        enddo
145        if (iprint.gt.1) write(iout,*)
146        go to 1106 
147       endif
148       if(n_thr.lt.num_thread_save) then
149        icomp=1
150        if (modif) then
151          if (iprint.gt.1) 
152      &    write(iout,*)'s*>> structure accepted - add with nr ',n_thr+1
153        else 
154          if (iprint.gt.1) 
155      &    write(iout,*)'s*>> structure accepted - would add with nr ',
156      &      n_thr+1
157          goto 1106
158        endif
159        n_thr=n_thr+1
160        enetbss(n_thr)=energyx
161        do i=1,nvar
162         coordss(i,n_thr)=x(i)
163        enddo
164       else
165        if(j.eq.0) then
166         if (iprint.gt.1) 
167      &   write(iout,*)'s*>> structure rejected - too high energy'
168         icomp=2
169         go to 1106
170        end if
171        icomp=3
172        if (modif) then
173          if (iprint.gt.1) 
174      &     write(iout,*)'s*>> structure accepted - repl nr ',j
175        else
176          if (iprint.gt.1) 
177      &     write(iout,*)'s*>> structure accepted - would repl nr ',j
178          goto 1106
179        endif
180        enetbss(j)=energyx
181        do i=1,nvar
182         coordss(i,j)=x(i)
183        enddo
184       end if
185     
186 1106  continue
187       return
188       end