HP 3000 Manuals

MIN Function [ HP COBOL II/XL Reference Manual ] MPE/iX 5.0 Documentation


HP COBOL II/XL Reference Manual

MIN Function 

The MIN function returns the content of the parameter-1 that contains the
minimum value.  The function type depends on the parameter type, as
follows:

     Parameter Type                         Function Type                                                                            
     Alphabetic                             Alphanumeric
     Alphanumeric                           Alphanumeric
     All parameters integer                 Integer
     Numeric (some parameters may be        Numeric
integer)

Syntax 

     FUNCTION MIN ({parameter-1}...)

Parameters 

parameter-1           If more than one parameter-1 is specified, all
                      parameters must be of the same class.

Return Value 

The returned value is the content of the parameter-1 having the least
value.  The comparisons used to determine the least value are made
according to the rules for simple conditions.  See the section "Simple
Conditions" in Chapter 8  for additional information.

If more than one parameter-1 has the same least value, the content of the
parameter-1 returned is the leftmost parameter-1 having that value.

If the type of the function is alphanumeric, the size of the returned
value is the same as the size of the selected parameter-1.

Example 

     77  A         PIC X VALUE "A".
     77  B         PIC X VALUE "Z".
     77  C         PIC X VALUE "m".
     77  D         PIC X VALUE "9".

     77  I         PIC 9 VALUE 8.
     77  J         PIC 9 VALUE 3.
     77  K         PIC 9 VALUE 6.
     77  L         PIC 9 VALUE 1.
     77  MIN-VALUE PIC 9 VALUE ZERO.
     01  TAB.
         05  ELEMENT   PIC S999V99
                         OCCURS 4 TIMES VALUE ZERO.
           :
     DISPLAY FUNCTION MIN (A, B, C, D).
     COMPUTE MIN-VALUE = FUNCTION MIN (I, J, K, L).
     DISPLAY MIN-VALUE.
     MOVE 1.25 TO ELEMENT (1).
     MOVE 3.50 TO ELEMENT (2).
     MOVE 8.75 TO ELEMENT (3).
     MOVE 0.25 TO ELEMENT (4).
     COMPUTE MIN-VALUE = FUNCTION MIN ( ELEMENT (ALL) ).
     DISPLAY MIN-VALUE.

The above example displays the following:

     9
     1
     0



MPE/iX 5.0 Documentation