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