Algol 68 Genie

box-behnken.f

     1  ! @section Synopsis
     2  !
     3  ! Box-Behnken design related subprograms.
     4  !
     5  ! @author J. Marcel van der Veer
     6  !
     7  ! @section copyright
     8  !
     9  ! This file is part of VIF - vintage fortran compiler.
    10  ! Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
    11  !
    12  ! @section license
    13  !
    14  ! This program is free software; you can redistribute it and/or modify it 
    15  ! under the terms of the gnu general public license as published by the 
    16  ! free software foundation; either version 3 of the license, or 
    17  ! (at your option) any later version.
    18  !
    19  ! This program is distributed in the hope that it will be useful, but 
    20  ! without any warranty; without even the implied warranty of merchantability 
    21  ! or fitness for a particular purpose. See the GNU general public license for 
    22  ! more details. You should have received a copy of the GNU general public 
    23  ! license along with this program. If not, see <http://www.gnu.org/licenses/>.
    24  !
    25        SUBROUTINE box_behnken (dim_num, x_num, range, x)
    26  
    27  c  box_behnken() returns a Box-Behnken design for the given number of factors.
    28  c
    29  c  Licensing:
    30  c
    31  c    This code is distributed under the MIT license.
    32  c
    33  c  Modified:
    34  c
    35  c    26 October 2008
    36  c
    37  c  Author:
    38  c
    39  c    John Burkardt
    40  c
    41  c  Reference:
    42  c
    43  c    George Box, Donald Behnken, 
    44  c    Some new three level designs for the study of quantitative variables, 
    45  c    Technometrics, 
    46  c    Volume 2, pages 455-475, 1960.
    47  c
    48  c  Parameters:
    49  c
    50  c    Input, integer DIM_NUM, the spatial dimension.
    51  c
    52  c    Input, integer X_NUM, the number of elements of the design.
    53  c    X_NUM should be equal to DIM_NUM * 2**(DIM_NUM-1) + 1.
    54  c
    55  c    Input, double precision RANGE(DIM_NUM, 2), the minimum and maximum
    56  c    value for each component.
    57  c
    58  c    Output, double precision X(DIM_NUM, X_NUM), the elements of the design.
    59  c
    60        IMPLICIT none
    61  
    62        INTEGER dim_num, x_num, i, i2, j, last_low
    63        DOUBLE PRECISION range(dim_num, 2), x(dim_num, x_num)
    64  c
    65  c  Ensure that the range is legal.
    66  c
    67        DO i = 1, dim_num
    68          IF (range(i, 2) .le. range(i, 1)) THEN
    69            CALL xerabt ('BOX_BEHNKEN range error', 1)
    70          END IF
    71        END DO
    72  c
    73  c  The first point is the center.
    74  c
    75        j = 1
    76  
    77        DO i = 1, dim_num
    78          x(i, j) = (range(i, 1) + range(i, 2)) / 2.0d+00
    79        END DO
    80  c
    81  c  For subsequent elements, one entry is fixed at the middle of the range.
    82  c  The others are set to either extreme.
    83  c
    84        DO i = 1, dim_num
    85  
    86          j = j + 1
    87  
    88          DO i2 = 1, dim_num
    89            x(i2, j) = range(i2, 1)
    90          END DO
    91          x(i, j) = (range(i, 1) + range(i, 2)) / 2.0d+00
    92  c
    93  c  The next element is made by finding the last low value, making it
    94  c  high, and all subsequent high values low.
    95  c
    96      1 CONTINUE
    97  
    98        last_low = -1
    99  
   100        DO i2 = 1, dim_num
   101          IF (x(i2, j) .eq. range(i2, 1)) THEN
   102            last_low = i2
   103          END IF
   104        END DO
   105  
   106        IF (last_low .eq. -1) THEN
   107          GO TO 2
   108        END IF
   109  
   110        j = j + 1
   111        DO i2 = 1, dim_num
   112          x(i2, j) = x(i2, j-1)
   113        END DO
   114        x(last_low, j) = range(last_low, 2)
   115  
   116        DO i2 = last_low + 1, dim_num
   117          IF (x(i2, j) .eq. range(i2, 2)) THEN
   118            x(i2, j) = range(i2, 1)
   119          END IF
   120        END DO 
   121  
   122        GO TO 1
   123  
   124      2 CONTINUE
   125  
   126        END DO
   127  
   128        RETURN
   129        END
   130  
   131        SUBROUTINE box_behnken_size (dim_num, x_num)
   132  
   133  c  box_behnken_size returns the size of a Box-Behnken design.
   134  c
   135  c  Licensing:
   136  c
   137  c    This code is distributed under the MIT license.
   138  c
   139  c  Modified:
   140  c
   141  c    26 October 2008
   142  c
   143  c  Author:
   144  c
   145  c    John Burkardt
   146  c
   147  c  Reference:
   148  c
   149  c    George Box, Donald Behnken, 
   150  c    Some new three level designs for the study of quantitative variables, 
   151  c    Technometrics, 
   152  c    Volume 2, pages 455-475, 1960.
   153  c
   154  c  Parameters:
   155  c
   156  c    Input, integer DIM_NUM, the spatial dimension.
   157  c
   158  c    Output, integer X_NUM, the number of elements of the design.
   159  c    X_NUM will be equal to DIM_NUM * 2**(DIM_NUM-1) + 1.
   160  c
   161        IMPLICIT none
   162  
   163        INTEGER dim_num, x_num
   164  
   165        IF (1 .le. dim_num) THEN
   166          x_num = 1 + dim_num * 2 ** (dim_num - 1)
   167        ELSE
   168          x_num = -1
   169        END IF
   170  
   171        RETURN
   172        END
Deze website is gearchiveerd door de KB, nationale bibliotheek.

This website is archived by the National Library of the Netherlands.