Algol 68 Genie

box-behnken.f

     1  ! @section Synopsis
     2  !
     3  ! Box-Behnken desing 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  10      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 20
   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 10
   123  
   124  20      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.