C
C $Id: bsrch.F,v 1.6 1998/07/16 16:39:29 jjv5 Exp arjan $
C
C------------------------------------------------------------------------
      SUBROUTINE BSRCH(DIRECT1,STEP,EHEAT1,ALPHA,IERROR)
C
C     DOES A BINARY SEARCH TO FIND A LOWER ENERGY IN THE DIRECTION DIRECT.
C     PARAMETERS ARE MODIFIED ACCORDING TO STEP*DIRECT, (STEP/2)*DIRECT,
C     (STEP/4)*DIRECT, ETC., UNTIL A LOWER TOTAL ENERGY IS FOUND.
C     THE STEP SIZE THAT LOWERS THE TOTAL ENERGY IS RETURNED IN ALPHA.
C     THE CORRESPONDING TOTAL ENERGY IS RETURNED IN EHEAT1.
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
#include "divcon.dim"
#include "divcon.h"
      DIMENSION DIRECT1(*)
C
C     LOCAL:
C
      DIMENSION COORD0(MAXPAR)
      LOGICAL newsub
C
      IERROR = 0
      ALPHA = 0.0D0
C
C     STORE ORIGINAL GEOMETRY.
C
      IF(XYZSPC)THEN
        IJ = 0
        DO 20 I=1,NATOMS
          DO 10 J=1,3
            IJ = IJ + 1
            COORD0(IJ) = XYZ(J,I)
 10       CONTINUE
 20     CONTINUE
      ELSE
        DO 40 I=1,NPAR
          ITYP = IPAR(1,I)
          IATM = IPAR(2,I)
          COORD0(I) = ZMAT(ITYP,IATM)
 40     CONTINUE
      ENDIF
      DSTEP = 2.0D0*STEP
      EHEAT0 = EHEAT1
C
C     BEGIN BINARY SEARCH.
C
 100  DSTEP = 0.5D0*DSTEP
C
C     RETURN IF THE STEP SIZE HAS BECOME VERY SMALL.
C
      IF(ABS(DSTEP).LT.0.05D0*ABS(STEP)) RETURN
      ALPHA = DSTEP
      CALL GETCRD(COORD0,DIRECT1,ALPHA,IERROR)
      IF(IERROR.NE.0) RETURN
C
C     GET THE ENERGY OF THIS NEW GEOMETRY.
C
C	
      newsub = .true.
C     do setup for pbc's if they have been requested
      if(PBC)then
         call setbox(ierror)
         if(ierror.ne.0) return
      endif
      if (newsub) then
         CALL GENSUB(IERROR)
         IF(IERROR.NE.0) RETURN
      endif
      CALL ENERGY(newsub,EHEAT1,IERROR)
      IF(IERROR.NE.0) RETURN
C
C     IF THE ENERGY HAS NOT DROPPED FROM THE ORIGINAL VALUE, THEN CUT
C     THE STEP SIZE IN HALF AND REPEAT.
C
      IF(EHEAT1.GE.EHEAT0) GO TO 100
      RETURN
      END