| PROGRAM FM099 |
| |
| C COMMENT SECTION 00010099 |
| C 00020099 |
| C FM099 00030099 |
| C 00040099 |
| C THIS ROUTINE TESTS VARIOUS MATHEMATICAL FUNCTIONS WHERE BOTH THE 00050099 |
| C FUNCTION TYPE AND ARGUMENTS ARE REAL. THE REAL VARIABLES AND 00060099 |
| C CONSTANTS CONTAIN BOTH POSITIVE AND NEGATIVE VALUES. THE 00070099 |
| C FUNCTIONS TESTED IN FM099 INCLUDE 00080099 |
| C 00090099 |
| C TYPE OF 00100099 |
| C FUNCTION NAME ARGUMENT FUNCTION 00110099 |
| C ---------------- ---- -------- -------- 00120099 |
| C EXPONENTIAL EXP REAL REAL 00130099 |
| C NATURAL LOGARITHM ALOG REAL REAL 00140099 |
| C COMMON LOGARITHM ALOG10 REAL REAL 00150099 |
| C SQUARE ROOT SQRT REAL REAL 00160099 |
| C TRIGONOMETRIC SINE SIN REAL REAL 00170099 |
| C TRIGONOMETRIC COSINE COS REAL REAL 00180099 |
| C HYPERBOLIC TANGENT TANH REAL REAL 00190099 |
| C ARCTANGENT ATAN REAL REAL 00200099 |
| C ATAN2 REAL REAL 00210099 |
| C 00220099 |
| C REFERENCES 00230099 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00240099 |
| C X3.9-1978 00250099 |
| C 00260099 |
| C SECTION 8.7, EXTERNAL STATEMENT 00270099 |
| C SECTION 15.5.2, FUNCTION REFERENCE 00280099 |
| C 00290099 |
| C 00300099 |
| C ********************************************************** 00310099 |
| C 00320099 |
| C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00330099 |
| C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00340099 |
| C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00350099 |
| C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00360099 |
| C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00370099 |
| C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00380099 |
| C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00390099 |
| C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00400099 |
| C OF EXECUTING THESE TESTS. 00410099 |
| C 00420099 |
| C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00430099 |
| C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00440099 |
| C 00450099 |
| C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00460099 |
| C 00470099 |
| C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00480099 |
| C SOFTWARE STANDARDS VALIDATION GROUP 00490099 |
| C BUILDING 225 RM A266 00500099 |
| C GAITHERSBURG, MD 20899 00510099 |
| C ********************************************************** 00520099 |
| C 00530099 |
| C 00540099 |
| C 00550099 |
| C INITIALIZATION SECTION 00560099 |
| C 00570099 |
| C INITIALIZE CONSTANTS 00580099 |
| C ************** 00590099 |
| C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00600099 |
| I01 = 5 00610099 |
| C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00620099 |
| I02 = 6 00630099 |
| C SYSTEM ENVIRONMENT SECTION 00640099 |
| C 00650099 |
| CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00660099 |
| C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00670099 |
| C (UNIT NUMBER FOR CARD READER). 00680099 |
| CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00690099 |
| C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00700099 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00710099 |
| C 00720099 |
| CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00730099 |
| C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00740099 |
| C (UNIT NUMBER FOR PRINTER). 00750099 |
| CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00760099 |
| C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00770099 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00780099 |
| C 00790099 |
| IVPASS=0 00800099 |
| IVFAIL=0 00810099 |
| IVDELE=0 00820099 |
| ICZERO=0 00830099 |
| C 00840099 |
| C WRITE PAGE HEADERS 00850099 |
| WRITE (I02,90000) 00860099 |
| WRITE (I02,90001) 00870099 |
| WRITE (I02,90002) 00880099 |
| WRITE (I02, 90002) 00890099 |
| WRITE (I02,90003) 00900099 |
| WRITE (I02,90002) 00910099 |
| WRITE (I02,90004) 00920099 |
| WRITE (I02,90002) 00930099 |
| WRITE (I02,90011) 00940099 |
| WRITE (I02,90002) 00950099 |
| WRITE (I02,90002) 00960099 |
| WRITE (I02,90005) 00970099 |
| WRITE (I02,90006) 00980099 |
| WRITE (I02,90002) 00990099 |
| C 01000099 |
| C TEST SECTION 01010099 |
| C 01020099 |
| C TEST 939 THROUGH TEST 942 CONTAIN FUNCTION TESTS FOR EXPONENTIAL 01030099 |
| C FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 01040099 |
| C 01050099 |
| IVTNUM = 939 01060099 |
| C 01070099 |
| C **** TEST 939 **** 01080099 |
| C 01090099 |
| IF (ICZERO) 39390, 9390, 39390 01100099 |
| 9390 CONTINUE 01110099 |
| RVON01 = 0.0 01120099 |
| RVCOMP = EXP (RVON01) 01130099 |
| GO TO 49390 01140099 |
| 39390 IVDELE = IVDELE + 1 01150099 |
| WRITE (I02,80003) IVTNUM 01160099 |
| IF (ICZERO) 49390, 9401, 49390 01170099 |
| 49390 IF (RVCOMP - 0.95) 29390,19390,49391 01180099 |
| 49391 IF (RVCOMP - 1.05) 19390,19390,29390 01190099 |
| 19390 IVPASS = IVPASS + 1 01200099 |
| WRITE (I02,80001) IVTNUM 01210099 |
| GO TO 9401 01220099 |
| 29390 IVFAIL = IVFAIL + 1 01230099 |
| RVCORR = 1.00 01240099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01250099 |
| 9401 CONTINUE 01260099 |
| IVTNUM = 940 01270099 |
| C 01280099 |
| C **** TEST 940 **** 01290099 |
| C 01300099 |
| IF (ICZERO) 39400, 9400, 39400 01310099 |
| 9400 CONTINUE 01320099 |
| RVCOMP = EXP (0.5) 01330099 |
| GO TO 49400 01340099 |
| 39400 IVDELE = IVDELE + 1 01350099 |
| WRITE (I02,80003) IVTNUM 01360099 |
| IF (ICZERO) 49400, 9411, 49400 01370099 |
| 49400 IF (RVCOMP - 1.60) 29400,19400,49401 01380099 |
| 49401 IF (RVCOMP - 1.70) 19400,19400,29400 01390099 |
| 19400 IVPASS = IVPASS + 1 01400099 |
| WRITE (I02,80001) IVTNUM 01410099 |
| GO TO 9411 01420099 |
| 29400 IVFAIL = IVFAIL + 1 01430099 |
| RVCORR = 1.65 01440099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01450099 |
| 9411 CONTINUE 01460099 |
| IVTNUM = 941 01470099 |
| C 01480099 |
| C **** TEST 941 **** 01490099 |
| C 01500099 |
| IF (ICZERO) 39410, 9410, 39410 01510099 |
| 9410 CONTINUE 01520099 |
| RVON01 = .1E1 01530099 |
| RVCOMP = EXP (RVON01) 01540099 |
| GO TO 49410 01550099 |
| 39410 IVDELE = IVDELE + 1 01560099 |
| WRITE (I02,80003) IVTNUM 01570099 |
| IF (ICZERO) 49410, 9421, 49410 01580099 |
| 49410 IF (RVCOMP - 2.67) 29410,19410,49411 01590099 |
| 49411 IF (RVCOMP - 2.77) 19410,19410,29410 01600099 |
| 19410 IVPASS = IVPASS + 1 01610099 |
| WRITE (I02,80001) IVTNUM 01620099 |
| GO TO 9421 01630099 |
| 29410 IVFAIL = IVFAIL + 1 01640099 |
| RVCORR = 2.72 01650099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01660099 |
| 9421 CONTINUE 01670099 |
| IVTNUM = 942 01680099 |
| C 01690099 |
| C **** TEST 942 **** 01700099 |
| C 01710099 |
| IF (ICZERO) 39420, 9420, 39420 01720099 |
| 9420 CONTINUE 01730099 |
| RVON01 = -1.0 01740099 |
| RVCOMP = EXP (RVON01) 01750099 |
| GO TO 49420 01760099 |
| 39420 IVDELE = IVDELE + 1 01770099 |
| WRITE (I02,80003) IVTNUM 01780099 |
| IF (ICZERO) 49420, 9431, 49420 01790099 |
| 49420 IF (RVCOMP - 0.363) 29420,19420,49421 01800099 |
| 49421 IF (RVCOMP - 0.373) 19420,19420,29420 01810099 |
| 19420 IVPASS = IVPASS + 1 01820099 |
| WRITE (I02,80001) IVTNUM 01830099 |
| GO TO 9431 01840099 |
| 29420 IVFAIL = IVFAIL + 1 01850099 |
| RVCORR = 0.368 01860099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01870099 |
| 9431 CONTINUE 01880099 |
| C 01890099 |
| C TEST 943 THROUGH TEST 945 CONTAIN FUNCTION TESTS FOR NATURAL 01900099 |
| C LOGARITHM FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 01910099 |
| C 01920099 |
| IVTNUM = 943 01930099 |
| C 01940099 |
| C **** TEST 943 **** 01950099 |
| C 01960099 |
| IF (ICZERO) 39430, 9430, 39430 01970099 |
| 9430 CONTINUE 01980099 |
| RVON01 = 5E1 01990099 |
| RVCOMP = ALOG (RVON01) 02000099 |
| GO TO 49430 02010099 |
| 39430 IVDELE = IVDELE + 1 02020099 |
| WRITE (I02,80003) IVTNUM 02030099 |
| IF (ICZERO) 49430, 9441, 49430 02040099 |
| 49430 IF (RVCOMP - 3.9115) 29430,19430,49431 02050099 |
| 49431 IF (RVCOMP - 3.9125) 19430,19430,29430 02060099 |
| 19430 IVPASS = IVPASS + 1 02070099 |
| WRITE (I02,80001) IVTNUM 02080099 |
| GO TO 9441 02090099 |
| 29430 IVFAIL = IVFAIL + 1 02100099 |
| RVCORR = 3.9120 02110099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02120099 |
| 9441 CONTINUE 02130099 |
| IVTNUM = 944 02140099 |
| C 02150099 |
| C **** TEST 944 **** 02160099 |
| C 02170099 |
| IF (ICZERO) 39440, 9440, 39440 02180099 |
| 9440 CONTINUE 02190099 |
| RVON01 = 1.0 02200099 |
| RVCOMP = ALOG (RVON01) 02210099 |
| GO TO 49440 02220099 |
| 39440 IVDELE = IVDELE + 1 02230099 |
| WRITE (I02,80003) IVTNUM 02240099 |
| IF (ICZERO) 49440, 9451, 49440 02250099 |
| 49440 IF (RVCOMP + .00005) 29440,19440,49441 02260099 |
| 49441 IF (RVCOMP - .00005) 19440,19440,29440 02270099 |
| 19440 IVPASS = IVPASS + 1 02280099 |
| WRITE (I02,80001) IVTNUM 02290099 |
| GO TO 9451 02300099 |
| 29440 IVFAIL = IVFAIL + 1 02310099 |
| RVCORR = 0.00000 02320099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02330099 |
| 9451 CONTINUE 02340099 |
| IVTNUM = 945 02350099 |
| C 02360099 |
| C **** TEST 945 **** 02370099 |
| C 02380099 |
| IF (ICZERO) 39450, 9450, 39450 02390099 |
| 9450 CONTINUE 02400099 |
| RVCOMP = ALOG (2.0) 02410099 |
| GO TO 49450 02420099 |
| 39450 IVDELE = IVDELE + 1 02430099 |
| WRITE (I02,80003) IVTNUM 02440099 |
| IF (ICZERO) 49450, 9461, 49450 02450099 |
| 49450 IF (RVCOMP - 0.688) 29450,19450,49451 02460099 |
| 49451 IF (RVCOMP - 0.698) 19450,19450,29450 02470099 |
| 19450 IVPASS = IVPASS + 1 02480099 |
| WRITE (I02,80001) IVTNUM 02490099 |
| GO TO 9461 02500099 |
| 29450 IVFAIL = IVFAIL + 1 02510099 |
| RVCORR = 0.693 02520099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02530099 |
| 9461 CONTINUE 02540099 |
| C 02550099 |
| C TEST 946 THROUGH TEST 948 CONTAIN FUNCTION TESTS FOR COMMON 02560099 |
| C LOGARITHM FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 02570099 |
| C 02580099 |
| IVTNUM = 946 02590099 |
| C 02600099 |
| C **** TEST 946 **** 02610099 |
| C 02620099 |
| IF (ICZERO) 39460, 9460, 39460 02630099 |
| 9460 CONTINUE 02640099 |
| RVON01 = 2E2 02650099 |
| RVCOMP = ALOG10 (RVON01) 02660099 |
| GO TO 49460 02670099 |
| 39460 IVDELE = IVDELE + 1 02680099 |
| WRITE (I02,80003) IVTNUM 02690099 |
| IF (ICZERO) 49460, 9471, 49460 02700099 |
| 49460 IF (RVCOMP - 2.296) 29460,19460,49461 02710099 |
| 49461 IF (RVCOMP - 2.306) 19460,19460,29460 02720099 |
| 19460 IVPASS = IVPASS + 1 02730099 |
| WRITE (I02,80001) IVTNUM 02740099 |
| GO TO 9471 02750099 |
| 29460 IVFAIL = IVFAIL + 1 02760099 |
| RVCORR = 2.301 02770099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02780099 |
| 9471 CONTINUE 02790099 |
| IVTNUM = 947 02800099 |
| C 02810099 |
| C **** TEST 947 **** 02820099 |
| C 02830099 |
| IF (ICZERO) 39470, 9470, 39470 02840099 |
| 9470 CONTINUE 02850099 |
| RVON01 = .3E+3 02860099 |
| RVCOMP = ALOG10 (RVON01) 02870099 |
| GO TO 49470 02880099 |
| 39470 IVDELE = IVDELE + 1 02890099 |
| WRITE (I02,80003) IVTNUM 02900099 |
| IF (ICZERO) 49470, 9481, 49470 02910099 |
| 49470 IF (RVCOMP - 2.472) 29470,19470,49471 02920099 |
| 49471 IF (RVCOMP - 2.482) 19470,19470,29470 02930099 |
| 19470 IVPASS = IVPASS + 1 02940099 |
| WRITE (I02,80001) IVTNUM 02950099 |
| GO TO 9481 02960099 |
| 29470 IVFAIL = IVFAIL + 1 02970099 |
| RVCORR = 2.477 02980099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02990099 |
| 9481 CONTINUE 03000099 |
| IVTNUM = 948 03010099 |
| C 03020099 |
| C **** TEST 948 **** 03030099 |
| C 03040099 |
| IF (ICZERO) 39480, 9480, 39480 03050099 |
| 9480 CONTINUE 03060099 |
| RVON01 = 1350.0 03070099 |
| RVCOMP = ALOG10 (RVON01) 03080099 |
| GO TO 49480 03090099 |
| 39480 IVDELE = IVDELE + 1 03100099 |
| WRITE (I02,80003) IVTNUM 03110099 |
| IF (ICZERO) 49480, 9491, 49480 03120099 |
| 49480 IF (RVCOMP - 3.125) 29480,19480,49481 03130099 |
| 49481 IF (RVCOMP - 3.135) 19480,19480,29480 03140099 |
| 19480 IVPASS = IVPASS + 1 03150099 |
| WRITE (I02,80001) IVTNUM 03160099 |
| GO TO 9491 03170099 |
| 29480 IVFAIL = IVFAIL + 1 03180099 |
| RVCORR = 3.130 03190099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03200099 |
| 9491 CONTINUE 03210099 |
| C 03220099 |
| C TEST 949 THROUGH TEST 951 CONTAIN FUNCTION TESTS FOR SQUARE ROOT 03230099 |
| C FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 03240099 |
| C 03250099 |
| IVTNUM = 949 03260099 |
| C 03270099 |
| C **** TEST 949 **** 03280099 |
| C 03290099 |
| IF (ICZERO) 39490, 9490, 39490 03300099 |
| 9490 CONTINUE 03310099 |
| RVON01 = 1.0 03320099 |
| RVCOMP = SQRT (RVON01) 03330099 |
| GO TO 49490 03340099 |
| 39490 IVDELE = IVDELE + 1 03350099 |
| WRITE (I02,80003) IVTNUM 03360099 |
| IF (ICZERO) 49490, 9501, 49490 03370099 |
| 49490 IF (RVCOMP - 0.95) 29490,19490,49491 03380099 |
| 49491 IF (RVCOMP - 1.05) 19490,19490,29490 03390099 |
| 19490 IVPASS = IVPASS + 1 03400099 |
| WRITE (I02,80001) IVTNUM 03410099 |
| GO TO 9501 03420099 |
| 29490 IVFAIL = IVFAIL + 1 03430099 |
| RVCORR = 1.00 03440099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03450099 |
| 9501 CONTINUE 03460099 |
| IVTNUM = 950 03470099 |
| C 03480099 |
| C **** TEST 950 **** 03490099 |
| C 03500099 |
| IF (ICZERO) 39500, 9500, 39500 03510099 |
| 9500 CONTINUE 03520099 |
| RVCOMP = SQRT (2.0) 03530099 |
| GO TO 49500 03540099 |
| 39500 IVDELE = IVDELE + 1 03550099 |
| WRITE (I02,80003) IVTNUM 03560099 |
| IF (ICZERO) 49500, 9511, 49500 03570099 |
| 49500 IF (RVCOMP - 1.36) 29500,19500,49501 03580099 |
| 49501 IF (RVCOMP - 1.46) 19500,19500,29500 03590099 |
| 19500 IVPASS = IVPASS + 1 03600099 |
| WRITE (I02,80001) IVTNUM 03610099 |
| GO TO 9511 03620099 |
| 29500 IVFAIL = IVFAIL + 1 03630099 |
| RVCORR = 1.41 03640099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03650099 |
| 9511 CONTINUE 03660099 |
| IVTNUM = 951 03670099 |
| C 03680099 |
| C **** TEST 951 **** 03690099 |
| C 03700099 |
| IF (ICZERO) 39510, 9510, 39510 03710099 |
| 9510 CONTINUE 03720099 |
| RVON01 = .229E1 03730099 |
| RVCOMP = SQRT (RVON01) 03740099 |
| GO TO 49510 03750099 |
| 39510 IVDELE = IVDELE + 1 03760099 |
| WRITE (I02,80003) IVTNUM 03770099 |
| IF (ICZERO) 49510, 9521, 49510 03780099 |
| 49510 IF (RVCOMP - 1.46) 29510,19510,49511 03790099 |
| 49511 IF (RVCOMP - 1.56) 19510,19510,29510 03800099 |
| 19510 IVPASS = IVPASS + 1 03810099 |
| WRITE (I02,80001) IVTNUM 03820099 |
| GO TO 9521 03830099 |
| 29510 IVFAIL = IVFAIL + 1 03840099 |
| RVCORR = 1.51 03850099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03860099 |
| 9521 CONTINUE 03870099 |
| C 03880099 |
| C TEST 952 THROUGH TEST 953 CONTAIN FUNCTION TESTS FOR TRIGONOMETRIC03890099 |
| C SINE FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 03900099 |
| C 03910099 |
| IVTNUM = 952 03920099 |
| C 03930099 |
| C **** TEST 952 **** 03940099 |
| C 03950099 |
| IF (ICZERO) 39520, 9520, 39520 03960099 |
| 9520 CONTINUE 03970099 |
| RVON01 = 0.00000 03980099 |
| RVCOMP = SIN (RVON01) 03990099 |
| GO TO 49520 04000099 |
| 39520 IVDELE = IVDELE + 1 04010099 |
| WRITE (I02,80003) IVTNUM 04020099 |
| IF (ICZERO) 49520, 9531, 49520 04030099 |
| 49520 IF (RVCOMP + .00005) 29520,19520,49521 04040099 |
| 49521 IF (RVCOMP - .00005) 19520,19520,29520 04050099 |
| 19520 IVPASS = IVPASS + 1 04060099 |
| WRITE (I02,80001) IVTNUM 04070099 |
| GO TO 9531 04080099 |
| 29520 IVFAIL = IVFAIL + 1 04090099 |
| RVCORR = 0.00000 04100099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04110099 |
| 9531 CONTINUE 04120099 |
| IVTNUM = 953 04130099 |
| C 04140099 |
| C **** TEST 953 **** 04150099 |
| C 04160099 |
| IF (ICZERO) 39530, 9530, 39530 04170099 |
| 9530 CONTINUE 04180099 |
| RVON01 = 0.5 04190099 |
| RVCOMP = SIN (RVON01) 04200099 |
| GO TO 49530 04210099 |
| 39530 IVDELE = IVDELE + 1 04220099 |
| WRITE (I02,80003) IVTNUM 04230099 |
| IF (ICZERO) 49530, 9541, 49530 04240099 |
| 49530 IF (RVCOMP - .474) 29530,19530,49531 04250099 |
| 49531 IF (RVCOMP - .484) 19530,19530,29530 04260099 |
| 19530 IVPASS = IVPASS + 1 04270099 |
| WRITE (I02,80001) IVTNUM 04280099 |
| GO TO 9541 04290099 |
| 29530 IVFAIL = IVFAIL + 1 04300099 |
| RVCORR = .479 04310099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04320099 |
| 9541 CONTINUE 04330099 |
| IVTNUM = 954 04340099 |
| C 04350099 |
| C **** TEST 954 **** 04360099 |
| C 04370099 |
| IF (ICZERO) 39540, 9540, 39540 04380099 |
| 9540 CONTINUE 04390099 |
| RVON01 = 4E0 04400099 |
| RVCOMP = SIN (RVON01) 04410099 |
| GO TO 49540 04420099 |
| 39540 IVDELE = IVDELE + 1 04430099 |
| WRITE (I02,80003) IVTNUM 04440099 |
| IF (ICZERO) 49540, 9551, 49540 04450099 |
| 49540 IF (RVCOMP + .762) 29540,19540,49541 04460099 |
| 49541 IF (RVCOMP + .752) 19540,19540,29540 04470099 |
| 19540 IVPASS = IVPASS + 1 04480099 |
| WRITE (I02,80001) IVTNUM 04490099 |
| GO TO 9551 04500099 |
| 29540 IVFAIL = IVFAIL + 1 04510099 |
| RVCORR = -.757 04520099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04530099 |
| 9551 CONTINUE 04540099 |
| C 04550099 |
| C TEST 955 THROUGH TEST 957 CONTAIN FUNCTION TESTS FOR TRIGONOMETRIC04560099 |
| C COSINE FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 04570099 |
| C 04580099 |
| IVTNUM = 955 04590099 |
| C 04600099 |
| C **** TEST 955 **** 04610099 |
| C 04620099 |
| IF (ICZERO) 39550, 9550, 39550 04630099 |
| 9550 CONTINUE 04640099 |
| RVON01 = 0.00000 04650099 |
| RVCOMP = COS (RVON01) 04660099 |
| GO TO 49550 04670099 |
| 39550 IVDELE = IVDELE + 1 04680099 |
| WRITE (I02,80003) IVTNUM 04690099 |
| IF (ICZERO) 49550, 9561, 49550 04700099 |
| 49550 IF (RVCOMP - .995) 29550,19550,49551 04710099 |
| 49551 IF (RVCOMP - 1.005) 19550,19550,29550 04720099 |
| 19550 IVPASS = IVPASS + 1 04730099 |
| WRITE (I02,80001) IVTNUM 04740099 |
| GO TO 9561 04750099 |
| 29550 IVFAIL = IVFAIL + 1 04760099 |
| RVCORR = 1.000 04770099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04780099 |
| 9561 CONTINUE 04790099 |
| IVTNUM = 956 04800099 |
| C 04810099 |
| C **** TEST 956 **** 04820099 |
| C 04830099 |
| IF (ICZERO) 39560, 9560, 39560 04840099 |
| 9560 CONTINUE 04850099 |
| RVON01 = 1.0E0 04860099 |
| RVCOMP = COS (RVON01) 04870099 |
| GO TO 49560 04880099 |
| 39560 IVDELE = IVDELE + 1 04890099 |
| WRITE (I02,80003) IVTNUM 04900099 |
| IF (ICZERO) 49560, 9571, 49560 04910099 |
| 49560 IF (RVCOMP - .535) 29560,19560,49561 04920099 |
| 49561 IF (RVCOMP - .545) 19560,19560,29560 04930099 |
| 19560 IVPASS = IVPASS + 1 04940099 |
| WRITE (I02,80001) IVTNUM 04950099 |
| GO TO 9571 04960099 |
| 29560 IVFAIL = IVFAIL + 1 04970099 |
| RVCORR = 0.540 04980099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04990099 |
| 9571 CONTINUE 05000099 |
| IVTNUM = 957 05010099 |
| C 05020099 |
| C **** TEST 957 **** 05030099 |
| C 05040099 |
| IF (ICZERO) 39570, 9570, 39570 05050099 |
| 9570 CONTINUE 05060099 |
| RVCOMP = COS (4.0) 05070099 |
| GO TO 49570 05080099 |
| 39570 IVDELE = IVDELE + 1 05090099 |
| WRITE (I02,80003) IVTNUM 05100099 |
| IF (ICZERO) 49570, 9581, 49570 05110099 |
| 49570 IF (RVCOMP + .659) 29570,19570,49571 05120099 |
| 49571 IF (RVCOMP + .649) 19570,19570,29570 05130099 |
| 19570 IVPASS = IVPASS + 1 05140099 |
| WRITE (I02,80001) IVTNUM 05150099 |
| GO TO 9581 05160099 |
| 29570 IVFAIL = IVFAIL + 1 05170099 |
| RVCORR = -0.654 05180099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05190099 |
| 9581 CONTINUE 05200099 |
| C 05210099 |
| C TEST 958 THROUGH TEST 960 CONTAIN FUNCTION TESTS FOR HYPERBOLIC 05220099 |
| C TANGENT FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 05230099 |
| C 05240099 |
| IVTNUM = 958 05250099 |
| C 05260099 |
| C **** TEST 958 **** 05270099 |
| C 05280099 |
| IF (ICZERO) 39580, 9580, 39580 05290099 |
| 9580 CONTINUE 05300099 |
| RVCOMP = TANH (0.0) 05310099 |
| GO TO 49580 05320099 |
| 39580 IVDELE = IVDELE + 1 05330099 |
| WRITE (I02,80003) IVTNUM 05340099 |
| IF (ICZERO) 49580, 9591, 49580 05350099 |
| 49580 IF (RVCOMP + .00005) 29580,19580,49581 05360099 |
| 49581 IF (RVCOMP - .00005) 19580,19580,29580 05370099 |
| 19580 IVPASS = IVPASS + 1 05380099 |
| WRITE (I02,80001) IVTNUM 05390099 |
| GO TO 9591 05400099 |
| 29580 IVFAIL = IVFAIL + 1 05410099 |
| RVCORR = 0.00000 05420099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05430099 |
| 9591 CONTINUE 05440099 |
| IVTNUM = 959 05450099 |
| C 05460099 |
| C **** TEST 959 **** 05470099 |
| C 05480099 |
| IF (ICZERO) 39590, 9590, 39590 05490099 |
| 9590 CONTINUE 05500099 |
| RVON01 = .5E0 05510099 |
| RVCOMP = TANH (RVON01) 05520099 |
| GO TO 49590 05530099 |
| 39590 IVDELE = IVDELE + 1 05540099 |
| WRITE (I02,80003) IVTNUM 05550099 |
| IF (ICZERO) 49590, 9601, 49590 05560099 |
| 49590 IF (RVCOMP - .457) 29590,19590,49591 05570099 |
| 49591 IF (RVCOMP - .467) 19590,19590,29590 05580099 |
| 19590 IVPASS = IVPASS + 1 05590099 |
| WRITE (I02,80001) IVTNUM 05600099 |
| GO TO 9601 05610099 |
| 29590 IVFAIL = IVFAIL + 1 05620099 |
| RVCORR = 0.462 05630099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05640099 |
| 9601 CONTINUE 05650099 |
| IVTNUM = 960 05660099 |
| C 05670099 |
| C **** TEST 960 **** 05680099 |
| C 05690099 |
| IF (ICZERO) 39600, 9600, 39600 05700099 |
| 9600 CONTINUE 05710099 |
| RVON01 = .25 05720099 |
| RVCOMP = TANH (RVON01) 05730099 |
| GO TO 49600 05740099 |
| 39600 IVDELE = IVDELE + 1 05750099 |
| WRITE (I02,80003) IVTNUM 05760099 |
| IF (ICZERO) 49600, 9611, 49600 05770099 |
| 49600 IF (RVCOMP - .240) 29600,19600,49601 05780099 |
| 49601 IF (RVCOMP - .250) 19600,19600,29600 05790099 |
| 19600 IVPASS = IVPASS + 1 05800099 |
| WRITE (I02,80001) IVTNUM 05810099 |
| GO TO 9611 05820099 |
| 29600 IVFAIL = IVFAIL + 1 05830099 |
| RVCORR = 0.245 05840099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05850099 |
| 9611 CONTINUE 05860099 |
| C 05870099 |
| C TESTS 961 AND 962 CONTAIN TESTS FOR ARCTANGENT OF THE FORM 05880099 |
| C ATAN (A) WHERE THE ARGUMENT AND FUNCTION ARE REAL 05890099 |
| C 05900099 |
| IVTNUM = 961 05910099 |
| C 05920099 |
| C **** TEST 961 **** 05930099 |
| C 05940099 |
| IF (ICZERO) 39610, 9610, 39610 05950099 |
| 9610 CONTINUE 05960099 |
| RVCOMP = ATAN (0.0) 05970099 |
| GO TO 49610 05980099 |
| 39610 IVDELE = IVDELE + 1 05990099 |
| WRITE (I02,80003) IVTNUM 06000099 |
| IF (ICZERO) 49610, 9621, 49610 06010099 |
| 49610 IF (RVCOMP + .00005) 29610,19610,49611 06020099 |
| 49611 IF (RVCOMP - .00005) 19610,19610,29610 06030099 |
| 19610 IVPASS = IVPASS + 1 06040099 |
| WRITE (I02,80001) IVTNUM 06050099 |
| GO TO 9621 06060099 |
| 29610 IVFAIL = IVFAIL + 1 06070099 |
| RVCORR = 0.00000 06080099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06090099 |
| 9621 CONTINUE 06100099 |
| IVTNUM = 962 06110099 |
| C 06120099 |
| C **** TEST 962 **** 06130099 |
| C 06140099 |
| IF (ICZERO) 39620, 9620, 39620 06150099 |
| 9620 CONTINUE 06160099 |
| RVON01 = 5E-1 06170099 |
| RVCOMP = ATAN (RVON01) 06180099 |
| GO TO 49620 06190099 |
| 39620 IVDELE = IVDELE + 1 06200099 |
| WRITE (I02,80003) IVTNUM 06210099 |
| IF (ICZERO) 49620, 9631, 49620 06220099 |
| 49620 IF (RVCOMP - .459) 29620,19620,49621 06230099 |
| 49621 IF (RVCOMP - .469) 19620,19620,29620 06240099 |
| 19620 IVPASS = IVPASS + 1 06250099 |
| WRITE (I02,80001) IVTNUM 06260099 |
| GO TO 9631 06270099 |
| 29620 IVFAIL = IVFAIL + 1 06280099 |
| RVCORR = 0.464 06290099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06300099 |
| 9631 CONTINUE 06310099 |
| C 06320099 |
| C TESTS 963 AND 964 CONTAIN TESTS FOR ARCTANGENT OF THE FORM 06330099 |
| C ATAN2 (A1,A2) WHERE THE ARGUMENTS AND FUNCTION ARE REAL 06340099 |
| C 06350099 |
| IVTNUM = 963 06360099 |
| C 06370099 |
| C **** TEST 963 **** 06380099 |
| C 06390099 |
| IF (ICZERO) 39630, 9630, 39630 06400099 |
| 9630 CONTINUE 06410099 |
| RVON01 = 0.0 06420099 |
| RVON02 = 1E0 06430099 |
| RVCOMP = ATAN2 (RVON01,RVON02) 06440099 |
| GO TO 49630 06450099 |
| 39630 IVDELE = IVDELE + 1 06460099 |
| WRITE (I02,80003) IVTNUM 06470099 |
| IF (ICZERO) 49630, 9641, 49630 06480099 |
| 49630 IF (RVCOMP + .00005) 29630,19630,49631 06490099 |
| 49631 IF (RVCOMP - .00005) 19630,19630,29630 06500099 |
| 19630 IVPASS = IVPASS + 1 06510099 |
| WRITE (I02,80001) IVTNUM 06520099 |
| GO TO 9641 06530099 |
| 29630 IVFAIL = IVFAIL + 1 06540099 |
| RVCORR = 0.00000 06550099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06560099 |
| 9641 CONTINUE 06570099 |
| IVTNUM = 964 06580099 |
| C 06590099 |
| C **** TEST 964 **** 06600099 |
| C 06610099 |
| IF (ICZERO) 39640, 9640, 39640 06620099 |
| 9640 CONTINUE 06630099 |
| RVON01 = 2E1 06640099 |
| RVCOMP = ATAN2 (-1.0,RVON01) 06650099 |
| GO TO 49640 06660099 |
| 39640 IVDELE = IVDELE + 1 06670099 |
| WRITE (I02,80003) IVTNUM 06680099 |
| IF (ICZERO) 49640, 9651, 49640 06690099 |
| 49640 IF (RVCOMP + .05001) 29640,19640,49641 06700099 |
| 49641 IF (RVCOMP + .04991) 19640,19640,29640 06710099 |
| 19640 IVPASS = IVPASS + 1 06720099 |
| WRITE (I02,80001) IVTNUM 06730099 |
| GO TO 9651 06740099 |
| 29640 IVFAIL = IVFAIL + 1 06750099 |
| RVCORR = -.04996 06760099 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06770099 |
| 9651 CONTINUE 06780099 |
| C 06790099 |
| C WRITE PAGE FOOTINGS AND RUN SUMMARIES 06800099 |
| 99999 CONTINUE 06810099 |
| WRITE (I02,90002) 06820099 |
| WRITE (I02,90006) 06830099 |
| WRITE (I02,90002) 06840099 |
| WRITE (I02,90002) 06850099 |
| WRITE (I02,90007) 06860099 |
| WRITE (I02,90002) 06870099 |
| WRITE (I02,90008) IVFAIL 06880099 |
| WRITE (I02,90009) IVPASS 06890099 |
| WRITE (I02,90010) IVDELE 06900099 |
| C 06910099 |
| C 06920099 |
| C TERMINATE ROUTINE EXECUTION 06930099 |
| STOP 06940099 |
| C 06950099 |
| C FORMAT STATEMENTS FOR PAGE HEADERS 06960099 |
| 90000 FORMAT ("1") 06970099 |
| 90002 FORMAT (" ") 06980099 |
| 90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06990099 |
| 90003 FORMAT (" ",21X,"VERSION 2.1" ) 07000099 |
| 90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07010099 |
| 90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07020099 |
| 90006 FORMAT (" ",5X,"----------------------------------------------" ) 07030099 |
| 90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07040099 |
| C 07050099 |
| C FORMAT STATEMENTS FOR RUN SUMMARIES 07060099 |
| 90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07070099 |
| 90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07080099 |
| 90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 07090099 |
| C 07100099 |
| C FORMAT STATEMENTS FOR TEST RESULTS 07110099 |
| 80001 FORMAT (" ",4X,I5,7X,"PASS") 07120099 |
| 80002 FORMAT (" ",4X,I5,7X,"FAIL") 07130099 |
| 80003 FORMAT (" ",4X,I5,7X,"DELETED") 07140099 |
| 80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07150099 |
| 80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07160099 |
| C 07170099 |
| 90007 FORMAT (" ",20X,"END OF PROGRAM FM099" ) 07180099 |
| END 07190099 |
