Loading...
Select Version
The TAN function returns the tangent of the angle or arc that is specified in radians by argument-1.
The type of this function is numeric.
Format
FUNCTION
TAN
(argument-1)
Argument
argument-1 must be class "numeric".
Returned values
The returned value is the approximation of the tangent of argument-1.
The error default value is
-
9’999’999’999’999’999’999’999’999’999’999.
See also: ATAN, SIN, ASIN, COS, ACOS
Example 9-45
... DATA DIVISION. WORKING-STORAGE SECTION. 01 R PIC S9V9(10). 01 RES PIC -9.9(10). PROCEDURE DIVISION. P1 SECTION. MAIN. COMPUTE R = FUNCTION TAN (3.1425). MOVE R TO RES. DISPLAY RES UPON T. STOP RUN.
Result: 0.0009073466