C COMMENT SECTION C C FM099 C C THIS ROUTINE TESTS VARIOUS MATHEMATICAL FUNCTIONS WHERE BOTH THE C FUNCTION TYPE AND ARGUMENTS ARE REAL. THE REAL VARIABLES AND C CONSTANTS CONTAIN BOTH POSITIVE AND NEGATIVE VALUES. THE C FUNCTIONS TESTED IN FM099 INCLUDE C C TYPE OF C FUNCTION NAME ARGUMENT FUNCTION C ---------------- ---- -------- -------- C EXPONENTIAL EXP REAL REAL C NATURAL LOGARITHM ALOG REAL REAL C COMMON LOGARITHM ALOG10 REAL REAL C SQUARE ROOT SQRT REAL REAL C TRIGONOMETRIC SINE SIN REAL REAL C TRIGONOMETRIC COSINE COS REAL REAL C HYPERBOLIC TANGENT TANH REAL REAL C ARCTANGENT ATAN REAL REAL C ATAN2 REAL REAL C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 8.7, EXTERNAL STATEMENT C SECTION 15.5.2, FUNCTION REFERENCE C C C ********************************************************** C C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT C OF EXECUTING THESE TESTS. C C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. C C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - C C DEPARTMENT OF THE NAVY C FEDERAL COBOL COMPILER TESTING SERVICE C WASHINGTON, D.C. 20376 C C ********************************************************** C C C C INITIALIZATION SECTION C C INITIALIZE CONSTANTS C ************** C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. I01 = 5 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. I02 = 6 C SYSTEM ENVIRONMENT SECTION C CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 C (UNIT NUMBER FOR CARD READER). CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. C CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 C (UNIT NUMBER FOR PRINTER). CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. C IVPASS=0 IVFAIL=0 IVDELE=0 ICZERO=0 C C WRITE PAGE HEADERS WRITE (I02,90000) WRITE (I02,90001) WRITE (I02,90002) WRITE (I02, 90002) WRITE (I02,90003) WRITE (I02,90002) WRITE (I02,90004) WRITE (I02,90002) WRITE (I02,90011) WRITE (I02,90002) WRITE (I02,90002) WRITE (I02,90005) WRITE (I02,90006) WRITE (I02,90002) C C TEST SECTION C C TEST 939 THROUGH TEST 942 CONTAIN FUNCTION TESTS FOR EXPONENTIAL C FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL C IVTNUM = 939 C C **** TEST 939 **** C IF (ICZERO) 39390, 9390, 39390 9390 CONTINUE RVON01 = 0.0 RVCOMP = EXP (RVON01) GO TO 49390 39390 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49390, 9401, 49390 49390 IF (RVCOMP - 0.95) 29390,19390,49391 49391 IF (RVCOMP - 1.05) 19390,19390,29390 19390 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9401 29390 IVFAIL = IVFAIL + 1 RVCORR = 1.00 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9401 CONTINUE IVTNUM = 940 C C **** TEST 940 **** C IF (ICZERO) 39400, 9400, 39400 9400 CONTINUE RVCOMP = EXP (0.5) GO TO 49400 39400 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49400, 9411, 49400 49400 IF (RVCOMP - 1.60) 29400,19400,49401 49401 IF (RVCOMP - 1.70) 19400,19400,29400 19400 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9411 29400 IVFAIL = IVFAIL + 1 RVCORR = 1.65 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9411 CONTINUE IVTNUM = 941 C C **** TEST 941 **** C IF (ICZERO) 39410, 9410, 39410 9410 CONTINUE RVON01 = .1E1 RVCOMP = EXP (RVON01) GO TO 49410 39410 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49410, 9421, 49410 49410 IF (RVCOMP - 2.67) 29410,19410,49411 49411 IF (RVCOMP - 2.77) 19410,19410,29410 19410 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9421 29410 IVFAIL = IVFAIL + 1 RVCORR = 2.72 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9421 CONTINUE IVTNUM = 942 C C **** TEST 942 **** C IF (ICZERO) 39420, 9420, 39420 9420 CONTINUE RVON01 = -1.0 RVCOMP = EXP (RVON01) GO TO 49420 39420 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49420, 9431, 49420 49420 IF (RVCOMP - 0.363) 29420,19420,49421 49421 IF (RVCOMP - 0.373) 19420,19420,29420 19420 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9431 29420 IVFAIL = IVFAIL + 1 RVCORR = 0.368 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9431 CONTINUE C C TEST 943 THROUGH TEST 945 CONTAIN FUNCTION TESTS FOR NATURAL C LOGARITHM FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL C IVTNUM = 943 C C **** TEST 943 **** C IF (ICZERO) 39430, 9430, 39430 9430 CONTINUE RVON01 = 5E1 RVCOMP = ALOG (RVON01) GO TO 49430 39430 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49430, 9441, 49430 49430 IF (RVCOMP - 3.9115) 29430,19430,49431 49431 IF (RVCOMP - 3.9125) 19430,19430,29430 19430 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9441 29430 IVFAIL = IVFAIL + 1 RVCORR = 3.9120 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9441 CONTINUE IVTNUM = 944 C C **** TEST 944 **** C IF (ICZERO) 39440, 9440, 39440 9440 CONTINUE RVON01 = 1.0 RVCOMP = ALOG (RVON01) GO TO 49440 39440 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49440, 9451, 49440 49440 IF (RVCOMP + .00005) 29440,19440,49441 49441 IF (RVCOMP - .00005) 19440,19440,29440 19440 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9451 29440 IVFAIL = IVFAIL + 1 RVCORR = 0.00000 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9451 CONTINUE IVTNUM = 945 C C **** TEST 945 **** C IF (ICZERO) 39450, 9450, 39450 9450 CONTINUE RVCOMP = ALOG (2.0) GO TO 49450 39450 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49450, 9461, 49450 49450 IF (RVCOMP - 0.688) 29450,19450,49451 49451 IF (RVCOMP - 0.698) 19450,19450,29450 19450 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9461 29450 IVFAIL = IVFAIL + 1 RVCORR = 0.693 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9461 CONTINUE C C TEST 946 THROUGH TEST 948 CONTAIN FUNCTION TESTS FOR COMMON C LOGARITHM FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL C IVTNUM = 946 C C **** TEST 946 **** C IF (ICZERO) 39460, 9460, 39460 9460 CONTINUE RVON01 = 2E2 RVCOMP = ALOG10 (RVON01) GO TO 49460 39460 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49460, 9471, 49460 49460 IF (RVCOMP - 2.296) 29460,19460,49461 49461 IF (RVCOMP - 2.306) 19460,19460,29460 19460 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9471 29460 IVFAIL = IVFAIL + 1 RVCORR = 2.301 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9471 CONTINUE IVTNUM = 947 C C **** TEST 947 **** C IF (ICZERO) 39470, 9470, 39470 9470 CONTINUE RVON01 = .3E+3 RVCOMP = ALOG10 (RVON01) GO TO 49470 39470 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49470, 9481, 49470 49470 IF (RVCOMP - 2.472) 29470,19470,49471 49471 IF (RVCOMP - 2.482) 19470,19470,29470 19470 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9481 29470 IVFAIL = IVFAIL + 1 RVCORR = 2.477 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9481 CONTINUE IVTNUM = 948 C C **** TEST 948 **** C IF (ICZERO) 39480, 9480, 39480 9480 CONTINUE RVON01 = 1350.0 RVCOMP = ALOG10 (RVON01) GO TO 49480 39480 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49480, 9491, 49480 49480 IF (RVCOMP - 3.125) 29480,19480,49481 49481 IF (RVCOMP - 3.135) 19480,19480,29480 19480 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9491 29480 IVFAIL = IVFAIL + 1 RVCORR = 3.130 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9491 CONTINUE C C TEST 949 THROUGH TEST 951 CONTAIN FUNCTION TESTS FOR SQUARE ROOT C FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL C IVTNUM = 949 C C **** TEST 949 **** C IF (ICZERO) 39490, 9490, 39490 9490 CONTINUE RVON01 = 1.0 RVCOMP = SQRT (RVON01) GO TO 49490 39490 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49490, 9501, 49490 49490 IF (RVCOMP - 0.95) 29490,19490,49491 49491 IF (RVCOMP - 1.05) 19490,19490,29490 19490 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9501 29490 IVFAIL = IVFAIL + 1 RVCORR = 1.00 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9501 CONTINUE IVTNUM = 950 C C **** TEST 950 **** C IF (ICZERO) 39500, 9500, 39500 9500 CONTINUE RVCOMP = SQRT (2.0) GO TO 49500 39500 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49500, 9511, 49500 49500 IF (RVCOMP - 1.36) 29500,19500,49501 49501 IF (RVCOMP - 1.46) 19500,19500,29500 19500 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9511 29500 IVFAIL = IVFAIL + 1 RVCORR = 1.41 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9511 CONTINUE IVTNUM = 951 C C **** TEST 951 **** C IF (ICZERO) 39510, 9510, 39510 9510 CONTINUE RVON01 = .229E1 RVCOMP = SQRT (RVON01) GO TO 49510 39510 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49510, 9521, 49510 49510 IF (RVCOMP - 1.46) 29510,19510,49511 49511 IF (RVCOMP - 1.56) 19510,19510,29510 19510 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9521 29510 IVFAIL = IVFAIL + 1 RVCORR = 1.51 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9521 CONTINUE C C TEST 952 THROUGH TEST 953 CONTAIN FUNCTION TESTS FOR TRIGONOMETRIC C SINE FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL C IVTNUM = 952 C C **** TEST 952 **** C IF (ICZERO) 39520, 9520, 39520 9520 CONTINUE RVON01 = 0.00000 RVCOMP = SIN (RVON01) GO TO 49520 39520 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49520, 9531, 49520 49520 IF (RVCOMP + .00005) 29520,19520,49521 49521 IF (RVCOMP - .00005) 19520,19520,29520 19520 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9531 29520 IVFAIL = IVFAIL + 1 RVCORR = 0.00000 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9531 CONTINUE IVTNUM = 953 C C **** TEST 953 **** C IF (ICZERO) 39530, 9530, 39530 9530 CONTINUE RVON01 = 0.5 RVCOMP = SIN (RVON01) GO TO 49530 39530 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49530, 9541, 49530 49530 IF (RVCOMP - .474) 29530,19530,49531 49531 IF (RVCOMP - .484) 19530,19530,29530 19530 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9541 29530 IVFAIL = IVFAIL + 1 RVCORR = .479 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9541 CONTINUE IVTNUM = 954 C C **** TEST 954 **** C IF (ICZERO) 39540, 9540, 39540 9540 CONTINUE RVON01 = 4E0 RVCOMP = SIN (RVON01) GO TO 49540 39540 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49540, 9551, 49540 49540 IF (RVCOMP + .762) 29540,19540,49541 49541 IF (RVCOMP + .752) 19540,19540,29540 19540 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9551 29540 IVFAIL = IVFAIL + 1 RVCORR = -.757 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9551 CONTINUE C C TEST 955 THROUGH TEST 957 CONTAIN FUNCTION TESTS FOR TRIGONOMETRIC C COSINE FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL C IVTNUM = 955 C C **** TEST 955 **** C IF (ICZERO) 39550, 9550, 39550 9550 CONTINUE RVON01 = 0.00000 RVCOMP = COS (RVON01) GO TO 49550 39550 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49550, 9561, 49550 49550 IF (RVCOMP - .995) 29550,19550,49551 49551 IF (RVCOMP - 1.005) 19550,19550,29550 19550 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9561 29550 IVFAIL = IVFAIL + 1 RVCORR = 1.000 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9561 CONTINUE IVTNUM = 956 C C **** TEST 956 **** C IF (ICZERO) 39560, 9560, 39560 9560 CONTINUE RVON01 = 1.0E0 RVCOMP = COS (RVON01) GO TO 49560 39560 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49560, 9571, 49560 49560 IF (RVCOMP - .535) 29560,19560,49561 49561 IF (RVCOMP - .545) 19560,19560,29560 19560 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9571 29560 IVFAIL = IVFAIL + 1 RVCORR = 0.540 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9571 CONTINUE IVTNUM = 957 C C **** TEST 957 **** C IF (ICZERO) 39570, 9570, 39570 9570 CONTINUE RVCOMP = COS (4.0) GO TO 49570 39570 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49570, 9581, 49570 49570 IF (RVCOMP + .659) 29570,19570,49571 49571 IF (RVCOMP + .649) 19570,19570,29570 19570 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9581 29570 IVFAIL = IVFAIL + 1 RVCORR = -0.654 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9581 CONTINUE C C TEST 958 THROUGH TEST 960 CONTAIN FUNCTION TESTS FOR HYPERBOLIC C TANGENT FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL C IVTNUM = 958 C C **** TEST 958 **** C IF (ICZERO) 39580, 9580, 39580 9580 CONTINUE RVCOMP = TANH (0.0) GO TO 49580 39580 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49580, 9591, 49580 49580 IF (RVCOMP + .00005) 29580,19580,49581 49581 IF (RVCOMP - .00005) 19580,19580,29580 19580 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9591 29580 IVFAIL = IVFAIL + 1 RVCORR = 0.00000 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9591 CONTINUE IVTNUM = 959 C C **** TEST 959 **** C IF (ICZERO) 39590, 9590, 39590 9590 CONTINUE RVON01 = .5E0 RVCOMP = TANH (RVON01) GO TO 49590 39590 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49590, 9601, 49590 49590 IF (RVCOMP - .457) 29590,19590,49591 49591 IF (RVCOMP - .467) 19590,19590,29590 19590 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9601 29590 IVFAIL = IVFAIL + 1 RVCORR = 0.462 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9601 CONTINUE IVTNUM = 960 C C **** TEST 960 **** C IF (ICZERO) 39600, 9600, 39600 9600 CONTINUE RVON01 = .25 RVCOMP = TANH (RVON01) GO TO 49600 39600 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49600, 9611, 49600 49600 IF (RVCOMP - .240) 29600,19600,49601 49601 IF (RVCOMP - .250) 19600,19600,29600 19600 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9611 29600 IVFAIL = IVFAIL + 1 RVCORR = 0.245 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9611 CONTINUE C C TESTS 961 AND 962 CONTAIN TESTS FOR ARCTANGENT OF THE FORM C ATAN (A) WHERE THE ARGUMENT AND FUNCTION ARE REAL C IVTNUM = 961 C C **** TEST 961 **** C IF (ICZERO) 39610, 9610, 39610 9610 CONTINUE RVCOMP = ATAN (0.0) GO TO 49610 39610 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49610, 9621, 49610 49610 IF (RVCOMP + .00005) 29610,19610,49611 49611 IF (RVCOMP - .00005) 19610,19610,29610 19610 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9621 29610 IVFAIL = IVFAIL + 1 RVCORR = 0.00000 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9621 CONTINUE IVTNUM = 962 C C **** TEST 962 **** C IF (ICZERO) 39620, 9620, 39620 9620 CONTINUE RVON01 = 5E-1 RVCOMP = ATAN (RVON01) GO TO 49620 39620 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49620, 9631, 49620 49620 IF (RVCOMP - .459) 29620,19620,49621 49621 IF (RVCOMP - .469) 19620,19620,29620 19620 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9631 29620 IVFAIL = IVFAIL + 1 RVCORR = 0.464 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9631 CONTINUE C C TESTS 963 AND 964 CONTAIN TESTS FOR ARCTANGENT OF THE FORM C ATAN2 (A1,A2) WHERE THE ARGUMENTS AND FUNCTION ARE REAL C IVTNUM = 963 C C **** TEST 963 **** C IF (ICZERO) 39630, 9630, 39630 9630 CONTINUE RVON01 = 0.0 RVON02 = 1E0 RVCOMP = ATAN2 (RVON01,RVON02) GO TO 49630 39630 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49630, 9641, 49630 49630 IF (RVCOMP + .00005) 29630,19630,49631 49631 IF (RVCOMP - .00005) 19630,19630,29630 19630 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9641 29630 IVFAIL = IVFAIL + 1 RVCORR = 0.00000 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9641 CONTINUE IVTNUM = 964 C C **** TEST 964 **** C IF (ICZERO) 39640, 9640, 39640 9640 CONTINUE RVON01 = 2E1 RVCOMP = ATAN2 (-1.0,RVON01) GO TO 49640 39640 IVDELE = IVDELE + 1 WRITE (I02,80003) IVTNUM IF (ICZERO) 49640, 9651, 49640 49640 IF (RVCOMP + .05001) 29640,19640,49641 49641 IF (RVCOMP + .04991) 19640,19640,29640 19640 IVPASS = IVPASS + 1 WRITE (I02,80001) IVTNUM GO TO 9651 29640 IVFAIL = IVFAIL + 1 RVCORR = -.04996 WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 9651 CONTINUE C C WRITE PAGE FOOTINGS AND RUN SUMMARIES 99999 CONTINUE WRITE (I02,90002) WRITE (I02,90006) WRITE (I02,90002) WRITE (I02,90002) WRITE (I02,90007) WRITE (I02,90002) WRITE (I02,90008) IVFAIL WRITE (I02,90009) IVPASS WRITE (I02,90010) IVDELE C C C TERMINATE ROUTINE EXECUTION STOP C C FORMAT STATEMENTS FOR PAGE HEADERS 90000 FORMAT (1H1) 90002 FORMAT (1H ) 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 90003 FORMAT (1H ,21X,11HVERSION 1.0) 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 90006 FORMAT (1H ,5X,46H----------------------------------------------) 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) C C FORMAT STATEMENTS FOR RUN SUMMARIES 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED) 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED) 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED) C C FORMAT STATEMENTS FOR TEST RESULTS 80001 FORMAT (1H ,4X,I5,7X,4HPASS) 80002 FORMAT (1H ,4X,I5,7X,4HFAIL) 80003 FORMAT (1H ,4X,I5,7X,7HDELETED) 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) C 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM099) END