--- /dev/null
+ subroutine compare_s1(n_thr,num_thread_save,energyx,x,
+ & icomp,enetbss,coordss,rms_d,modif,iprint)
+C This subroutine compares the new conformation, whose variables are in X
+C with the previously accumulated conformations whose energies and variables
+C are stored in ENETBSS and COORDSS, respectively. The meaning of other
+C variables is as follows:
+C
+C N_THR - on input the previous # of accumulated confs, on output the current
+C # of accumulated confs.
+C N_REPEAT - an array that indicates how many times the structure has already
+C been used to start the reversed-reversing procedure. Addition of
+C a new structure replacement of a structure with a similar, but
+C lower-energy structure resets the respective entry in N_REPEAT to zero
+C I9 - output unit
+C ENERGYX,X - the energy and variables of the new conformations.
+C ICOMP - comparison result:
+C 0 - the new structure is similar to one of the previous ones and does
+C not have a remarkably lower energy and is therefore rejected;
+C 1 - the new structure is different and is added to the set, because
+C there is still room in the COORDSS and ENETBSS arrays;
+C 2 - the new structure is different, but higher in energy than any
+C previous one and is therefore rejected
+C 3 - there is no more room in the COORDSS and ENETBSS arrays, but
+C the new structure is lower in energy than at least the highest-
+C energy previous structure and therefore replaces it.
+C 9 - the new structure is similar to a number of previous structures,
+C but has a remarkably lower energy than any of them; therefore
+C replaces all these structures;
+C MODIF - a logical variable that shows whether to include the new structure
+C in the set of accumulated structures
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.GEO'
+ include 'COMMON.VAR'
+crc include 'COMMON.DEFORM'
+ include 'COMMON.IOUNITS'
+#ifdef UNRES
+ include 'COMMON.CHAIN'
+#endif
+
+ dimension x(maxvar)
+ dimension x1(maxvar)
+ double precision przes(3),obrot(3,3)
+ integer list(max_thread)
+ logical non_conv,modif
+ double precision enetbss(max_threadss)
+ double precision coordss(maxvar,max_threadss)
+
+ nlist=0
+#ifdef UNRES
+ call var_to_geom(nvar,x)
+ call chainbuild
+ do k=1,2*nres
+ do kk=1,3
+ cref(kk,k)=c(kk,k)
+ enddo
+ enddo
+#endif
+c write(iout,*)'*ene=',energyx
+ j=0
+ enex_jp=-1.0d+99
+ do i=1,n_thr
+ do k=1,nvar
+ x1(k)=coordss(k,i)
+ enddo
+ if (iprint.gt.3) then
+ write (iout,*) 'Compare_ss, i=',i
+ write (iout,*) 'New structure Energy:',energyx
+ write (iout,'(10f8.3)') (rad2deg*x(k),k=1,nvar)
+ write (iout,*) 'Template structure Energy:',enetbss(i)
+ write (iout,'(10f8.3)') (rad2deg*x1(k),k=1,nvar)
+ endif
+
+#ifdef UNRES
+ call var_to_geom(nvar,x1)
+ call chainbuild
+cd write(iout,*)'C and CREF'
+cd write(iout,'(i5,3f10.5,5x,3f10.5)')(k,(c(j,k),j=1,3),
+cd & (cref(j,k),j=1,3),k=1,nres)
+ call fitsq(roznica,c(1,1),cref(1,1),nres,przes,obrot,non_conv)
+ if (non_conv) then
+ print *,'Problems in FITSQ!!!'
+ print *,'X'
+ print '(10f8.3)',(x(k),k=1,nvar)
+ print *,'X1'
+ print '(10f8.3)',(x1(k),k=1,nvar)
+ print *,'C and CREF'
+ print '(i5,3f10.5,5x,3f10.5)',(k,(c(j,k),j=1,3),
+ & (cref(j,k),j=1,3),k=1,nres)
+ endif
+ roznica=dsqrt(dabs(roznica))
+ iresult = 1
+ if (roznica.lt.rms_d) iresult = 0
+#else
+ energyy=enetbss(i)
+ call cmprs(x,x1,roznica,energyx,energyy,iresult)
+#endif
+ if (iprint.gt.1) write(iout,'(i5,f10.6,$)') i,roznica
+c print '(i5,f8.3)',i,roznica
+ if(iresult.eq.0) then
+ nlist = nlist + 1
+ list(nlist)=i
+ if (iprint.gt.1) write(iout,*)
+ if(energyx.ge.enetbss(i)) then
+ if (iprint.gt.1)
+ & write(iout,*)'s*>> structure rejected - same as nr ',i,
+ & ' RMS',roznica
+ minimize_s_flag=0
+ icomp=0
+ go to 1106
+ endif
+ endif
+ if(energyx.lt.enetbss(i).and.enex_jp.lt.enetbss(i))then
+ j=i
+ enex_jp=enetbss(i)
+ endif
+ enddo
+ if (iprint.gt.1) write(iout,*)
+ if(nlist.gt.0) then
+ if (modif) then
+ if (iprint.gt.1)
+ & write(iout,'(a,i3,$)')'s*>> structure accepted1 - repl nr ',
+ & list(1)
+ else
+ if (iprint.gt.1)
+ & write(iout,'(a,i3)')
+ & 's*>> structure accepted1 - would repl nr ',list(1)
+ endif
+ icomp=9
+ if (.not. modif) goto 1106
+ j=list(1)
+ enetbss(j)=energyx
+ do i=1,nvar
+ coordss(i,j)=x(i)
+ enddo
+ do j=2,nlist
+ if (iprint.gt.1) write(iout,'(i3,$)')list(j)
+ do kk=list(j)+1,nlist
+ enetbss(kk-1)=enetbss(kk)
+ do i=1,nvar
+ coordss(i,kk-1)=coordss(i,kk)
+ enddo
+ enddo
+ enddo
+ if (iprint.gt.1) write(iout,*)
+ go to 1106
+ endif
+ if(n_thr.lt.num_thread_save) then
+ icomp=1
+ if (modif) then
+ if (iprint.gt.1)
+ & write(iout,*)'s*>> structure accepted - add with nr ',n_thr+1
+ else
+ if (iprint.gt.1)
+ & write(iout,*)'s*>> structure accepted - would add with nr ',
+ & n_thr+1
+ goto 1106
+ endif
+ n_thr=n_thr+1
+ enetbss(n_thr)=energyx
+ do i=1,nvar
+ coordss(i,n_thr)=x(i)
+ enddo
+ else
+ if(j.eq.0) then
+ if (iprint.gt.1)
+ & write(iout,*)'s*>> structure rejected - too high energy'
+ icomp=2
+ go to 1106
+ end if
+ icomp=3
+ if (modif) then
+ if (iprint.gt.1)
+ & write(iout,*)'s*>> structure accepted - repl nr ',j
+ else
+ if (iprint.gt.1)
+ & write(iout,*)'s*>> structure accepted - would repl nr ',j
+ goto 1106
+ endif
+ enetbss(j)=energyx
+ do i=1,nvar
+ coordss(i,j)=x(i)
+ enddo
+ end if
+
+1106 continue
+ return
+ end
projects / unres.git / blobdiff