! @section Synopsis
!
! Box-Behnken design related subprograms.
!
! @author J. Marcel van der Veer
!
! @section copyright
!
! This file is part of VIF - vintage fortran compiler.
! Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
!
! @section license
!
! This program is free software; you can redistribute it and/or modify it 
! under the terms of the gnu general public license as published by the 
! free software foundation; either version 3 of the license, or 
! (at your option) any later version.
!
! This program is distributed in the hope that it will be useful, but 
! without any warranty; without even the implied warranty of merchantability 
! or fitness for a particular purpose. See the GNU general public license for 
! more details. You should have received a copy of the GNU general public 
! license along with this program. If not, see <http://www.gnu.org/licenses/>.
!
      SUBROUTINE box_behnken (dim_num, x_num, range, x)

c  box_behnken() returns a Box-Behnken design for the given number of factors.
c
c  Licensing:
c
c    This code is distributed under the MIT license.
c
c  Modified:
c
c    26 October 2008
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    George Box, Donald Behnken, 
c    Some new three level designs for the study of quantitative variables, 
c    Technometrics, 
c    Volume 2, pages 455-475, 1960.
c
c  Parameters:
c
c    Input, integer DIM_NUM, the spatial dimension.
c
c    Input, integer X_NUM, the number of elements of the design.
c    X_NUM should be equal to DIM_NUM * 2**(DIM_NUM-1) + 1.
c
c    Input, double precision RANGE(DIM_NUM, 2), the minimum and maximum
c    value for each component.
c
c    Output, double precision X(DIM_NUM, X_NUM), the elements of the design.
c
      IMPLICIT none

      INTEGER dim_num, x_num, i, i2, j, last_low
      DOUBLE PRECISION range(dim_num, 2), x(dim_num, x_num)
c
c  Ensure that the range is legal.
c
      DO i = 1, dim_num
        IF (range(i, 2) .le. range(i, 1)) THEN
          CALL xerabt ('BOX_BEHNKEN range error', 1)
        END IF
      END DO
c
c  The first point is the center.
c
      j = 1

      DO i = 1, dim_num
        x(i, j) = (range(i, 1) + range(i, 2)) / 2.0d+00
      END DO
c
c  For subsequent elements, one entry is fixed at the middle of the range.
c  The others are set to either extreme.
c
      DO i = 1, dim_num

        j = j + 1

        DO i2 = 1, dim_num
          x(i2, j) = range(i2, 1)
        END DO
        x(i, j) = (range(i, 1) + range(i, 2)) / 2.0d+00
c
c  The next element is made by finding the last low value, making it
c  high, and all subsequent high values low.
c
    1 CONTINUE

      last_low = -1

      DO i2 = 1, dim_num
        IF (x(i2, j) .eq. range(i2, 1)) THEN
          last_low = i2
        END IF
      END DO

      IF (last_low .eq. -1) THEN
        GO TO 2
      END IF

      j = j + 1
      DO i2 = 1, dim_num
        x(i2, j) = x(i2, j-1)
      END DO
      x(last_low, j) = range(last_low, 2)

      DO i2 = last_low + 1, dim_num
        IF (x(i2, j) .eq. range(i2, 2)) THEN
          x(i2, j) = range(i2, 1)
        END IF
      END DO 

      GO TO 1

    2 CONTINUE

      END DO

      RETURN
      END

      SUBROUTINE box_behnken_size (dim_num, x_num)

c  box_behnken_size returns the size of a Box-Behnken design.
c
c  Licensing:
c
c    This code is distributed under the MIT license.
c
c  Modified:
c
c    26 October 2008
c
c  Author:
c
c    John Burkardt
c
c  Reference:
c
c    George Box, Donald Behnken, 
c    Some new three level designs for the study of quantitative variables, 
c    Technometrics, 
c    Volume 2, pages 455-475, 1960.
c
c  Parameters:
c
c    Input, integer DIM_NUM, the spatial dimension.
c
c    Output, integer X_NUM, the number of elements of the design.
c    X_NUM will be equal to DIM_NUM * 2**(DIM_NUM-1) + 1.
c
      IMPLICIT none

      INTEGER dim_num, x_num

      IF (1 .le. dim_num) THEN
        x_num = 1 + dim_num * 2 ** (dim_num - 1)
      ELSE
        x_num = -1
      END IF

      RETURN
      END
