PROGRAM FM308 C C C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE ACTUAL C ARGUMENTS CONSIST OF INTRINSIC FUNCTION REFERENCES, EXTERNAL C FUNCTION REFERENCES, STATEMENT FUNCTION REFERENCES, AND C EXPRESSIONS INVOLVING OPERATORS. THE ARGUMENT AND FUNCTION C TYPES OF ALL INTRINSIC FUNCTIONS TESTED ARE EITHER INTEGER OR C REAL. THE INTRINSIC AND EXTERNAL SPECIFICATION STATEMENTS ARE C SPECIFIED IN ORDER TO ALLOW INTRINSIC AND EXTERNAL FUNCTIONS TO C BE USED AS ACTUAL ARGUMENTS. THE IMPLICIT STATEMENT AND THE C TYPE-STATEMENT ARE TESTED TO ENSURE THAT THEY DO NOT CHANGE THE C TYPE OF AN INTRINSIC FUNCTION. THE COMMON STATEMENT IS USED TO C PASS DATA ENTITIES TO AN EXTERNAL FUNCTION. THE DATA STATEMENT C IS USED TO ENSURE THAT INITIALLY DEFINED ENTITIES CAN BE USED AS C ACTUAL ARGUMENTS. THE EQUIVALENCE STATEMENT IS USED TO EQUATE A C VARIABLE USED AS AN ACTUAL ARGUMENT. THE INTRINSIC FUNCTIONS C TESTED IN THIS ROUTINE INCLUDE. C C SPECIFIC TYPE OF C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION C ------------------ -------- -------- -------- C TYPE CONVERSION INT REAL INTEGER C TYPE CONVERSION IFIX REAL INTEGER C TYPE CONVERSION FLOAT INTEGER REAL C TYPE CONVERSION REAL INTEGER REAL C TRUNCATION AINT REAL REAL C NEAREST WHOLE NUMBER ANINT REAL REAL C NEAREST INTEGER NINT REAL INTEGER C ABSOLUTE VALUE IABS INTEGER INTEGER C ABSOLUTE VALUE ABS REAL REAL C REMAINDERING MOD INTEGER INTEGER C REMAINDERING AMOD REAL REAL C TRANSFER OF SIGN ISIGN INTEGER INTEGER C TRANSFER OF SIGN SIGN REAL REAL C POSITIVE DIFFERENCE IDIM INTEGER INTEGER C POSITIVE DIFFERENCE DIM REAL REAL C CHOOSING LARGEST VALUE MAX0 INTEGER INTEGER C CHOOSING LARGEST VALUE AMAX0 INTEGER REAL C CHOOSING LARGEST VALUE MAX1 REAL INTEGER C CHOOSING SMALLEST VALUE AMIN1 REAL REAL C CHOOSING SMALLEST VALUE MIN1 REAL INTEGER C SQUARE ROOT SQRT REAL REAL C EXPONENTIAL EXP REAL REAL C NATURAL LOGARITHM ALOG REAL REAL C SINE SIN REAL REAL C COSINE COS REAL REAL C TANGENT TAN REAL REAL C ARCSINE ASIN REAL REAL C ARCCOSINE ACOS REAL REAL C ARCTANGENT ATAN REAL REAL C HYPERBOLIC SINE SINH REAL REAL C HYPERBOLIC COSINE COSH REAL REAL C HYPERBOLIC TANGENT TANH REAL REAL C C SUBSET LEVEL ROUTINES FM097, FM098, FM099 AND FM307 TEST THE C USE OF INTEGER AND REAL INTRINSIC FUNCTIONS USING INTEGER AND REAL C CONSTANTS, VARIABLES AND ARRAY ELEMENT ENTITIES AS ACTUAL C ARGUMENTS. C C REFERENCES. C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 8.2, EQUIVALENCE STATEMENT C SECTION 8.3, COMMON STATEMENT C SECTION 8.4, TYPE-STATEMENTS C SECTION 8.5, IMPLICIT STATEMENT C SECTION 8.7, EXTERNAL STATEMENT C SECTION 8.8, INTRINSIC STATEMENT C SECTION 9, DATA STATEMENT C SECTION 15.3, INTRINSIC FUNCTION C SECTION 15.4, STATEMENT FUNCTION C SECTION 15.5, EXTERNAL FUNCTION C SECTION 15.5.2, .REFERENCING AN EXTERNAL FUNCTION C SECTION 15.9.2, ACTUAL ARGUMENTS C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS C TABLE 5, INTRINSIC FUNCTIONS (INCLUDING NOTES) C SECTION 15.10.1, RESTRICTIONS ON RANGE OF ARGUMENTS AND RESULTS C C C ****************************************************************** C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING C THE RESULT OF EXECUTING THESE TESTS. C C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES C FOUND IN THE SUBSET LEVEL OF THE STANDARD. C C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO C DEPARTMENT OF THE NAVY C FEDERAL COBOL COMPILER TESTING SERVICE C WASHINGTON, D.C. 20376 C C ****************************************************************** C C IMPLICIT LOGICAL (L) IMPLICIT CHARACTER*14 (C) C IMPLICIT INTEGER (E) IMPLICIT REAL (N) INTEGER MAX1 REAL SINH DIMENSION RADN11(5) DIMENSION IADN11(5) COMMON RVCN01 EQUIVALENCE (IVOE01,IVOE02) EXTERNAL FF309,FF310 INTRINSIC ABS, AINT, IABS, ISIGN, SQRT DATA RVON04/2.23/ RFOS01(RDON01) = RDON01 + 1.0 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 PEPLACED 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 PEPLACED 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 OUT PAGE HEADERS C WRITE (I02,90002) WRITE (I02,90006) WRITE (I02,90008) WRITE (I02,90004) WRITE (I02,90010) WRITE (I02,90004) WRITE (I02,90016) WRITE (I02,90001) WRITE (I02,90004) WRITE (I02,90012) WRITE (I02,90014) WRITE (I02,90004) C C C TEST 032 THROUGH TEST 040 TEST INTRINSIC FUNCTIONS USING C INTRINSIC FUNCTION REFERENCES AS ACTUAL ARGUMENTS. C C C **** FCVS PROGRAM 308 - TEST 032 **** C C IVTNUM = 32 IF (ICZERO) 30320, 0320, 30320 0320 CONTINUE RVCOMP = 10.0 RVCOMP = ANINT (ABS (-2.78) ) RVCORR = 3.0 40320 IF (RVCOMP - 2.9995) 20320, 10320, 40321 40321 IF (RVCOMP - 3.0005) 10320, 10320, 20320 30320 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10320, 0331, 20320 10320 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0331 20320 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0331 CONTINUE C C **** FCVS PROGRAM 308 - TEST 033 **** C C IVTNUM = 33 IF (ICZERO) 30330, 0330, 30330 0330 CONTINUE RVCOMP = 10.0 RVCOMP = ATAN (AINT (1.2) ) RVCORR = .78540 40330 IF (RVCOMP - .78535) 20330, 10330, 40331 40331 IF (RVCOMP - .78545) 10330, 10330, 20330 30330 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10330, 0341, 20330 10330 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0341 20330 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0341 CONTINUE C C **** FCVS PROGRAM 308 - TEST 034 **** C C IVTNUM = 34 IF (ICZERO) 30340, 0340, 30340 0340 CONTINUE RVCOMP = 10.0 RVCOMP = COS (ABS (-.78540) ) RVCORR = .70711 40340 IF (RVCOMP - .70706) 20340, 10340, 40341 40341 IF (RVCOMP - .70716) 10340, 10340, 20340 30340 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10340, 0351, 20340 10340 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0351 20340 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0351 CONTINUE C C **** FCVS PROGRAM 308 - TEST 035 **** C C IVTNUM = 35 IF (ICZERO) 30350, 0350, 30350 0350 CONTINUE RVCOMP = 10.0 IVON01 = 6 RVCOMP = AMAX0 (1, IVON01, IABS(-7) ) RVCORR = 7.0 40350 IF (RVCOMP - 6.9995) 20350, 10350, 40351 40351 IF (RVCOMP - 7.0005) 10350, 10350, 20350 30350 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10350, 0361, 20350 10350 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0361 20350 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0361 CONTINUE C C **** FCVS PROGRAM 308 - TEST 036 **** C C IVTNUM = 36 IF (ICZERO) 30360, 0360, 30360 0360 CONTINUE IVCOMP = 10 IVCOMP = IABS (ISIGN (7, -2)) IVCORR = 7 40360 IF (IVCOMP - 7) 20360, 10360, 20360 30360 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10360, 0371, 20360 10360 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0371 20360 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0371 CONTINUE C C **** FCVS PROGRAM 308 - TEST 037 **** C C IVTNUM = 37 IF (ICZERO) 30370, 0370, 30370 0370 CONTINUE IVCOMP = 10 IVCOMP = MOD (5, IABS (-3) ) IVCORR = 2 40370 IF (IVCOMP - 2) 20370, 10370, 20370 30370 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10370, 0381, 20370 10370 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0381 20370 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0381 CONTINUE C C **** FCVS PROGRAM 308 - TEST 038 **** C C IVTNUM = 38 IF (ICZERO) 30380, 0380, 30380 0380 CONTINUE IVCOMP = 10 IVCOMP = ISIGN (-3, IABS (-5) ) IVCORR = 3 40380 IF (IVCOMP - 3) 20380, 10380, 20380 30380 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10380, 0391, 20380 10380 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0391 20380 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0391 CONTINUE C C **** FCVS PROGRAM 308 - TEST 039 **** C C REPEAT FUNCTION REFERENCE TWICE IN ONE INTRINSIC FUNCTION C REFERENCE. C IVTNUM = 39 IF (ICZERO) 30390, 0390, 30390 0390 CONTINUE IVCOMP = 10 IVCOMP = MAX0 (IABS (-5), IABS (-6) ) IVCORR = 6 40390 IF (IVCOMP -6) 20390, 10390, 20390 30390 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10390, 0401, 20390 10390 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0401 20390 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0401 CONTINUE C C **** FCVS PROGRAM 308 - TEST 040 **** C C USE INTRINSIC FUNCTION REFERENCE AS ACTUAL ARGUMENT TO ITSELF. C IVTNUM = 40 IF (ICZERO) 30400, 0400, 30400 0400 CONTINUE RVCOMP = 10.0 RVCOMP = SQRT (SQRT (25.) ) RVCORR = 2.2361 40400 IF (RVCOMP - 2.2356) 20400, 10400, 40401 40401 IF (RVCOMP - 2.2366) 10400, 10400, 20400 30400 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10400, 0411, 20400 10400 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0411 20400 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0411 CONTINUE C C TEST 041 THROUGH TEST 045 TEST INTRINSIC FUNCTIONS USING EXTERNAL C FUNCTION REFERENCES AS ACTUAL ARGUMENTS. C C C **** FCVS PROGRAM 308 - TEST 041 **** C C IVTNUM = 41 IF (ICZERO) 30410, 0410, 30410 0410 CONTINUE RVCOMP = 10.0 RVCOMP = ALOG (FF309 (29.0) ) RVCORR = 3.4012 40410 IF (RVCOMP - 3.4007) 20410, 10410, 40411 40411 IF (RVCOMP - 3.4017) 10410, 10410, 20410 30410 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10410, 0421, 20410 10410 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0421 20410 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0421 CONTINUE C C **** FCVS PROGRAM 308 - TEST 042 **** C C IVTNUM = 42 IF (ICZERO) 30420, 0420, 30420 0420 CONTINUE RVCOMP = 10.0 RVCOMP = ASIN (FF309 (0.) ) RVCORR = 1.5708 40420 IF (RVCOMP - 1.5703) 20420, 10420, 40421 40421 IF (RVCOMP - 1.5713) 10420, 10420, 20420 30420 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10420, 0431, 20420 10420 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0431 20420 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0431 CONTINUE C C **** FCVS PROGRAM 308 - TEST 043 **** C C IVTNUM = 43 IF (ICZERO) 30430, 0430, 30430 0430 CONTINUE RVCOMP = 10.0 RVON01 = 1.5 RVCOMP = COSH (FF309 (RVON01) ) RVCORR = 6.1323 40430 IF (RVCOMP - 6.1318) 20430, 10430, 40431 40431 IF (RVCOMP - 6.1328) 10430, 10430, 20430 30430 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10430, 0441, 20430 10430 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0441 20430 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0441 CONTINUE C C **** FCVS PROGRAM 308 - TEST 044 **** C C IVTNUM = 44 IF (ICZERO) 30440, 0440, 30440 0440 CONTINUE IVCOMP = 10 IVCOMP = IFIX (FF309 (33.3) ) IVCORR = 34 40440 IF (IVCOMP - 34) 20440, 10440, 20440 30440 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10440, 0451, 20440 10440 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0451 20440 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0451 CONTINUE C C **** FCVS PROGRAM 308 - TEST 045 **** C C IVTNUM = 45 IF (ICZERO) 30450, 0450, 30450 0450 CONTINUE RVCOMP = 10.0 RADN11(2) = 2.1416 RVCOMP = TAN (FF309 (RADN11(2))) RVCORR = 0.0 40450 IF (RVCOMP + .00005) 20450, 10450, 40451 40451 IF (RVCOMP - .00005) 10450, 10450, 20450 30450 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10450, 0461, 20450 10450 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0461 20450 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0461 CONTINUE C C TEST 046 THROUGH TEST 052 TEST INTRINSIC FUNCTIONS USING C EXPRESSIONS INVOLVING OPERATORS AS ACTUAL ARGUMENTS. C C C **** FCVS PROGRAM 308 - TEST 046 **** C C IVTNUM = 46 IF (ICZERO) 30460, 0460, 30460 0460 CONTINUE RVCOMP = 10.0 RVCOMP = ABS (3.4 - 8.2) RVCORR = 4.8 40460 IF (RVCOMP - 4.7995) 20460, 10460, 40461 40461 IF (RVCOMP - 4.8005) 10460, 10460, 20460 30460 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10460, 0471, 20460 10460 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0471 20460 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0471 CONTINUE C C **** FCVS PROGRAM 308 - TEST 047 **** C C IVTNUM = 47 IF (ICZERO) 30470, 0470, 30470 0470 CONTINUE RVCOMP = 10.0 IVON01 = 2 RVON01 = 3.0 RVCOMP = ACOS (IVON01 - RVON01 * .5) RVCORR = 1.0472 40470 IF (RVCOMP - 1.0467) 20470, 10470, 40471 40471 IF (RVCOMP - 1.0477) 10470, 10470, 20470 30470 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10470, 0481, 20470 10470 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0481 20470 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0481 CONTINUE C C **** FCVS PROGRAM 308 - TEST 048 **** C C IVTNUM = 48 IF (ICZERO) 30480, 0480, 30480 0480 CONTINUE RVCOMP = 10.0 IVON01 = 2 RVON01 = -4.8 RVON02 = 4.5 RVCOMP = AMIN1 (RVON01, (IVON01 - 3.2) * RVON02) RVCORR = -5.4 40480 IF (RVCOMP + 5.4005 ) 20480, 10480, 40481 40481 IF (RVCOMP + 5.3995 ) 10480, 10480, 20480 30480 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10480, 0491, 20480 10480 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0491 20480 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0491 CONTINUE C C **** FCVS PROGRAM 308 - TEST 049 **** C C IVTNUM = 49 IF (ICZERO) 30490, 0490, 30490 0490 CONTINUE RVCOMP = 10.0 RVON01 = 12.0 IADN11(1) = 3 RADN11(2) = 2.5 RVCOMP = AMOD (RVON01 / IADN11(1), 12 / RADN11(2)) RVCORR = 4.0 40490 IF (RVCOMP - 3.9995) 20490, 10490, 40491 40491 IF (RVCOMP - 4.0005) 10490, 10490, 20490 30490 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10490, 0501, 20490 10490 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0501 20490 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0501 CONTINUE C C **** FCVS PROGRAM 308 - TEST 050 **** C C IVTNUM = 50 IF (ICZERO) 30500, 0500, 30500 0500 CONTINUE IVCOMP = 10 IVON01 = 2 IVON02 = 9 IVCOMP = IDIM (IVON01 ** 3, IVON02) IVCORR = 0 40500 IF (IVCOMP) 20500, 10500, 20500 30500 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10500, 0511, 20500 10500 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0511 20500 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0511 CONTINUE C C **** FCVS PROGRAM 308 - TEST 051 **** C C IVTNUM = 51 IF (ICZERO) 30510, 0510, 30510 0510 CONTINUE RVCOMP = 10.0 IVON01 = 6 RVCOMP = REAL (IABS (-3) + IVON01) RVCORR = 9.0 40510 IF (RVCOMP - 8.9995) 20510, 10510, 40511 40511 IF (RVCOMP - 9.0005) 10510, 10510, 20510 30510 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10510, 0521, 20510 10510 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0521 20510 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0521 CONTINUE C C **** FCVS PROGRAM 308 - TEST 052 **** C C IVTNUM = 52 IF (ICZERO) 30520, 0520, 30520 0520 CONTINUE RVCOMP = 10.0 RVON01 = 2.3 IVON01 = 150 IADN11(1) = 3 RVCOMP = SIGN(13+RVON01*IABS(-4)-IVON01/FF309(1.)**IADN11(1),-1.) RVCORR = -3.45 40520 IF (RVCOMP + 3.4505) 20520, 10520, 40521 40521 IF (RVCOMP + 3.4495) 10520, 10520, 20520 30520 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10520, 0531, 20520 10520 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0531 20520 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0531 CONTINUE C C TEST 053 THROUGH TEST 056 TEST INTRINSIC FUNCTIONS USING C STATEMENT FUNCTION REFERENCES AS ACTUAL ARGUMENTS. C C C **** FCVS PROGRAM 308 - TEST 053 **** C C IVTNUM = 53 IF (ICZERO) 30530, 0530, 30530 0530 CONTINUE RVCOMP = 10.0 RVCOMP = DIM (RFOS01(5.4), 6.0) RVCORR = .4 40530 IF (RVCOMP - .39995) 20530, 10530, 40531 40531 IF (RVCOMP - .40005) 10530, 10530, 20530 30530 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10530, 0541, 20530 10530 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0541 20530 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0541 CONTINUE C C **** FCVS PROGRAM 308 - TEST 054 **** C C IVTNUM = 54 IF (ICZERO) 30540, 0540, 30540 0540 CONTINUE IVCOMP = 10 IVCOMP = INT(RFOS01(2.01)) IVCORR = 3 40540 IF (IVCOMP - 3) 20540, 10540, 20540 30540 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10540, 0551, 20540 10540 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0551 20540 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0551 CONTINUE C C **** FCVS PROGRAM 308 - TEST 055 **** C C IVTNUM = 55 IF (ICZERO) 30550, 0550, 30550 0550 CONTINUE RVCOMP = 10.0 RVON01 = 0.5708 RVCOMP = SIN (RFOS01 (RVON01) / 2) RVCORR = .70711 40550 IF (RVCOMP - .70706) 20550, 10550, 40551 40551 IF (RVCOMP - .70716) 10550, 10550, 20550 30550 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10550, 0561, 20550 10550 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0561 20550 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0561 CONTINUE C C **** FCVS PROGRAM 308 - TEST 056 **** C C IVTNUM = 56 IF (ICZERO) 30560, 0560, 30560 0560 CONTINUE RVCOMP = 10.0 RADN11(2) = 1.5 RVCOMP = TANH(RFOS01(RADN11(2))) RVCORR = .98661 40560 IF (RVCOMP - .98656) 20560, 10560, 40561 40561 IF (RVCOMP - .98666) 10560, 10560, 20560 30560 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10560, 0571, 20560 10560 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0571 20560 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0571 CONTINUE C C **** FCVS PROGRAM 308 - TEST 057 **** C C TEST 057 TESTS THE INTRINSIC FUNCTION AINT USING AN EXTERNAL C FUNCTION REFERENCE AS AN ACTUAL ARGUMENT AND THE COMMON C STATEMENT AS A MEANS OF PASSING DATA TO THE EXTERNAL FUNCTION. C IVTNUM = 57 IF (ICZERO) 30570, 0570, 30570 0570 CONTINUE RVCOMP = 10.0 RVCN01 = 25.3 RVCOMP = AINT(FF310( )) RVCORR = 26.0 40570 IF (RVCOMP - 25.995) 20570, 10570, 40571 40571 IF (RVCOMP - 26.005) 10570, 10570, 20570 30570 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10570, 0581, 20570 10570 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0581 20570 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0581 CONTINUE C C **** FCVS PROGRAM 308 - TEST 058 **** C C TEST 058 TESTS THE INTRINSIC FUNCTION FLOAT BY USING A VARIABLE C EQUATED BY EQUIVALENCE ASSOCIATION AS AN ACTUAL ARGUMENT. C IVTNUM = 58 IF (ICZERO) 30580, 0580, 30580 0580 CONTINUE RVCOMP = 10.0 IVOE01 = 5 RVCOMP = FLOAT(IVOE01) RVCORR = 5.0 40580 IF (RVCOMP - 4.9995) 20580, 10580, 40581 40581 IF (RVCOMP - 5.0005) 10580, 10580, 20580 30580 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10580, 0591, 20580 10580 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0591 20580 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0591 CONTINUE C C **** FCVS PROGRAM 308 - TEST 059 **** C C TEST 059 TESTS THE INTRINSIC FUNCTION MIN1 BY USING A VARIABLE C INITIALIZED BY THE DATA STATEMENT AS AN ACTUAL ARGUMENT. C IVTNUM = 59 IF (ICZERO) 30590, 0590, 30590 0590 CONTINUE IVCOMP = 10 IVCOMP = MIN1(6., RVON04, 7.3) IVCORR = 2 40590 IF (IVCOMP - 2) 20590, 10590, 20590 30590 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10590, 0601, 20590 10590 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0601 20590 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0601 CONTINUE C C **** FCVS PROGRAM 308 - TEST 060 **** C C TEST 060 ATTEMPTS TO OVERRIDE THE TYPING OF REAL FOR THE C INTRINSIC FUNCTION EXP WITH IMPLICIT INTEGER TYPING. C IVTNUM = 60 IF (ICZERO) 30600, 0600, 30600 0600 CONTINUE RVCOMP = 10.0 RVON01 = 2.05 RVCOMP = EXP(RVON01) RVCORR = 7.7679 40600 IF (RVCOMP - 7.7674) 20600, 10600, 40601 40601 IF (RVCOMP - 7.7684) 10600, 10600, 20600 30600 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10600, 0611, 20600 10600 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0611 20600 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0611 CONTINUE C C **** FCVS PROGRAM 308 - TEST 061 **** C C TEST 061 ATTEMPTS TO OVERRIDE THE TYPING OF INTEGER FOR THE C INTRINSIC FUNCTION NINT WITH IMPLICIT REAL TYPING. C IVTNUM = 61 IF (ICZERO) 30610, 0610, 30610 0610 CONTINUE RVCOMP = 10.0 RVON01 = 3.78 RVCOMP = NINT(RVON01) / 5 RVCORR = 0.0 40610 IF (RVCOMP + .00005) 20610, 10610, 40611 40611 IF (RVCOMP - .00005) 10610, 10610, 20610 30610 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10610, 0621, 20610 10610 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0621 20610 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0621 CONTINUE C C **** FCVS PROGRAM 308 - TEST 062 **** C C TEST 062 ATTEMPTS TO OVERRIDE THE TYPING OF REAL FOR THE C INTRINSIC FUNCTION SINH WITH TYPE-STATEMENT TYPING OF INTEGER. C IVTNUM = 62 IF (ICZERO) 30620, 0620, 30620 0620 CONTINUE RVCOMP = 10.0 RVCOMP = SINH(2.0) RVCORR = 3.6269 40620 IF (RVCOMP - 3.6264) 20620, 10620, 40621 40621 IF (RVCOMP - 3.6274) 10620, 10620, 20620 30620 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10620, 0631, 20620 10620 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0631 20620 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0631 CONTINUE C C **** FCVS PROGRAM 308 - TEST 063 **** C C TEST 063 ATTEMPTS TO OVERRIDE THE TYPING OF INTEGER FOR THE C INTRINSIC FUNCTION MAX1 WITH TYPE-STATEMENT TYPING OF REAL. C IVTNUM = 63 IF (ICZERO) 30630, 0630, 30630 0630 CONTINUE RVCOMP = 10.0 RVCOMP = MAX1(2.3, 3.1, 4.4) / 5 RVCORR = 0.0 40630 IF (RVCOMP + .00005) 20630, 10630, 40631 40631 IF (RVCOMP - .00005) 10630, 10630, 20630 30630 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10630, 0641, 20630 10630 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0641 20630 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0641 CONTINUE C C C WRITE OUT TEST SUMMARY C WRITE (I02,90004) WRITE (I02,90014) WRITE (I02,90004) WRITE (I02,90000) WRITE (I02,90004) WRITE (I02,90020) IVFAIL WRITE (I02,90022) IVPASS WRITE (I02,90024) IVDELE STOP 90001 FORMAT (1H ,24X,5HFM308) 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM308) C C FORMATS FOR TEST DETAIL LINES C 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) C C FORMAT STATEMENTS FOR PAGE HEADERS C 90002 FORMAT (1H1) 90004 FORMAT (1H ) 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 90008 FORMAT (1H ,21X,11HVERSION 1.0) 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 90014 FORMAT (1H ,5X,46H----------------------------------------------) 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) C C FORMAT STATEMENTS FOR RUN SUMMARY C 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) END REAL FUNCTION FF309(RDON01) C THIS FUNCTION IS USED TO INCREMENT THE ARGUMENT VALUE BY C ONE AND RETURN THE RESULT AS THE FUNCTION VALUE. FF309 = RDON01 + 1.0 RETURN END REAL FUNCTION FF310 ( ) C THIS FUNCTION IS USED TO INCREMENT BY ONE A VALUE PASSED C TO THE FUNCTION THROUGH COMMON. COMMON RVCN01 FF310 = RVCN01 + 1.0 RETURN END