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,1)=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,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,1),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