PROGRAM FM307 C C C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION C TYPE IS REAL AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE C FUNCTION NINT IS AN EXCEPTION AND HAS AN INTEGER FUNCTION TYPE. C THE REAL OR INTEGER ARGUMENTS CONSIST OF POSITIVE, NEGATIVE AND C UNSIGNED CONSTANTS, VARIABLES AND ARRAY ELEMENT VALUES. EACH C INTRINSIC FUNCTION IS TESTED WITH THREE OR FOUR DIFFERENT C COMBINATIONS OF ACTUAL ARGUMENTS DESIGNED TO TEST NOT ONLY THE C VARIOUS COMBINATIONS OF DATA USAGES BUT ALSO TO TEST THE RANGE OF C ARGUMENT AND FUNCTION VALUES, WHERE THAT IS APPROPRIATE. THE C INTRINSIC FUNCTIONS TESTED IN THIS ROUTINE INCLUDE. C C SPECIFIC TYPE OF C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION C ------------------ ------ -------- -------- C CONVERSION TO REAL REAL INTEGER REAL C NEAREST WHOLE NUMBER ANINT REAL REAL C NEAREST INTEGER NINT REAL INTEGER C TANGENT TAN REAL REAL C ARCSINE ASIN REAL REAL C ARCCOSINE ACOS REAL REAL C HYPERBOLIC SINE SINH REAL REAL C HYPERBOLIC COSINE COSH REAL REAL C C SUBSET LEVEL ROUTINES FM097 THROUGH FM099 AND FM308 ALSO C TEST THE USE OF INTEGER AND REAL INTRINSIC FUNCTIONS. C C REFERENCES. C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 15.3, INTRINSIC FUNCTIONS 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, RESTRICTION 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 DIMENSION IAON11(4) DIMENSION RAON11(4) DATA PI/3.141592654/ 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 001 THROUGH TEST 004 CONTAIN INTRINSIC FUNCTION TESTS FOR C TYPE CONVERSION TO REAL (REAL) WHERE THE FUNCTION IS REAL AND THE C ARGUMENT IS INTEGER. C C C **** FCVS PROGRAM 307 - TEST 001 **** C C CONSTANT ARGUMENT C IVTNUM = 1 IF (ICZERO) 30010, 0010, 30010 0010 CONTINUE RVCOMP = 10.0 RVCOMP = REAL (6) RVCORR = 6.0 40010 IF (RVCOMP - 5.9995) 20010,10010,40011 40011 IF (RVCOMP - 6.0005) 10010,10010,20010 30010 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10010, 0021, 20010 10010 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0021 20010 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0021 CONTINUE C C **** FCVS PROGRAM 307 - TEST 002 **** C C VARIABLE ARGUMENT C IVTNUM = 2 IF (ICZERO) 30020, 0020, 30020 0020 CONTINUE RVCOMP = 10.0 IVON01 = 6 RVCOMP = REAL (IVON01) RVCORR = 6.0 40020 IF (RVCOMP - 5.9995) 20020,10020,40021 40021 IF (RVCOMP - 6.0005) 10020, 10020, 20020 30020 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10020, 0031, 20020 10020 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0031 20020 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0031 CONTINUE C C **** FCVS PROGRAM 307 - TEST 003 **** C C ARRAY ELEMENT NAME ARGUMENT C IVTNUM = 3 IF (ICZERO) 30030, 0030, 30030 0030 CONTINUE RVCOMP = 10.0 IAON11(3) = 6 RVCOMP = REAL (IAON11(3)) RVCORR = 6.0 40030 IF (RVCOMP - 5.9995) 20030, 10030, 40031 40031 IF (RVCOMP - 6.0005) 10030, 10030, 20030 30030 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10030, 0041, 20030 10030 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0041 20030 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0041 CONTINUE C C **** FCVS PROGRAM 307 - TEST 004 **** C C EXPRESSION AS ARGUMENT C IVTNUM = 4 IF (ICZERO) 30040, 0040, 30040 0040 CONTINUE RVCOMP = 10.0 IVON01 = 6 RVCOMP = REAL (IVON01 - 6) RVCORR = 0.0 40040 IF(RVCOMP + .00005) 20040, 10040, 40041 40041 IF(RVCOMP - .00005) 10040, 10040, 20040 30040 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10040, 0051, 20040 10040 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0051 20040 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0051 CONTINUE C C TEST 005 THROUGH TEST 008 CONTAIN INTRINSIC FUNCTION TESTS FOR C FINDING THE NEAREST WHOLE NUMBER (ANINT) WHERE THE FUNCTION AND C ARGUMENT TYPES ARE BOTH REAL. C C C **** FCVS PROGRAM 307 - TEST 005 **** C C CONSTANT ARGUMENT C IVTNUM = 5 IF (ICZERO) 30050, 0050, 30050 0050 CONTINUE RVCOMP = 10.0 RVCOMP = ANINT (3.4994) RVCORR = 3.0 40050 IF (RVCOMP - 2.9995) 20050, 10050, 40051 40051 IF (RVCOMP - 3.0005) 10050, 10050, 20050 30050 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10050, 0061, 20050 10050 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0061 20050 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0061 CONTINUE C C **** FCVS PROGRAM 307 - TEST 006 **** C C VARIABLE ARGUMENT C IVTNUM = 6 IF (ICZERO) 30060, 0060, 30060 0060 CONTINUE RVCOMP = 10.0 RVON01 = -3.4994 RVCOMP = ANINT (RVON01) RVCORR = -3.0 40060 IF (RVCOMP + 3.0005) 20060, 10060, 40061 40061 IF (RVCOMP + 2.9995) 10060, 10060, 20060 30060 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10060, 0071, 20060 10060 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0071 20060 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0071 CONTINUE C C **** FCVS PROGRAM 307 - TEST 007 **** C C ARRAY ELEMENT NAME ARGUMENT C IVTNUM = 7 IF (ICZERO) 30070, 0070, 30070 0070 CONTINUE RVCOMP = 10.0 RAON11(3) = 3.0000 RVCOMP = ANINT (RAON11(3)) RVCORR = 3.0 40070 IF (RVCOMP - 2.9995) 20070, 10070, 40071 40071 IF (RVCOMP - 3.0005) 10070, 10070, 20070 30070 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10070, 0081, 20070 10070 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0081 20070 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0081 CONTINUE C C **** FCVS PROGRAM 307 - TEST 008 **** C C ZERO ARGUMENT C IVTNUM = 8 IF (ICZERO) 30080, 0080, 30080 0080 CONTINUE RVCOMP = 10.0 RVCOMP = ANINT (0.0) RVCORR = 0.0 40080 IF (RVCOMP) 20080, 10080, 20080 30080 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10080, 0091, 20080 10080 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0091 20080 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0091 CONTINUE C C TEST 009 THROUGH TEST 012 CONTAIN INTRINSIC FUNCTION TESTS FOR C FINDING THE NEAREST INTEGER (NINT) WHERE THE ARGUMENT IS REAL C AND THE FUNCTION TYPE IS INTEGER. C C C **** FCVS PROGRAM 307 - TEST 009 **** C C CONSTANT ARGUMENT C IVTNUM = 9 IF (ICZERO) 30090, 0090, 30090 0090 CONTINUE IVCOMP = 10 IVCOMP = NINT (3.4994) IVCORR = 3 40090 IF (IVCOMP - 3) 20090, 10090, 20090 30090 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10090, 0101, 20090 10090 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0101 20090 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0101 CONTINUE C C **** FCVS PROGRAM 307 - TEST 010 **** C C VARIABLE ARGUMENT C IVTNUM = 10 IF (ICZERO) 30100, 0100, 30100 0100 CONTINUE IVCOMP = 10 RVON01 = -3.4994 IVCOMP = NINT (RVON01) IVCORR = -3 40100 IF (IVCOMP +3) 20100, 10100, 20100 30100 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10100, 0111, 20100 10100 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0111 20100 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0111 CONTINUE C C **** FCVS PROGRAM 307 - TEST 011 **** C C ARRAY ELEMENT NAME ARGUMENT C IVTNUM = 11 IF (ICZERO) 30110, 0110, 30110 0110 CONTINUE IVCOMP = 10 RAON11(1) = 3.0000 IVCOMP = NINT (RAON11(1)) IVCORR = 3 40110 IF (IVCOMP -3) 20110, 10110, 20110 30110 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10110, 0121, 20110 10110 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0121 20110 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0121 CONTINUE C C **** FCVS PROGRAM 307 - TEST 012 **** C C ZERO ARGUMENT C IVTNUM = 12 IF (ICZERO) 30120, 0120, 30120 0120 CONTINUE IVCOMP = 10 IVCOMP = NINT (0.0) IVCORR = 0 40120 IF (IVCOMP) 20120, 10120, 20120 30120 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10120, 0131, 20120 10120 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0131 20120 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0131 CONTINUE C C TEST 013 THROUGH TEST 017 CONTAIN INTRINSIC FUNCTION TESTS FOR C FINDING THE TRIGONOMETRIC TANGENT (TAN) WHERE THE FUNCTION AND C ARGUMENT TYPES ARE BOTH REAL. ALL ARGUMENTS ARE GIVEN IN RADIANS C WHERE ONE RADIAN EQUALS 57.296 DEGREES. C C C **** FCVS PROGRAM 307 - TEST 013 **** C C FIND THE TANGENT OF 0 DEGREES (0.0 RADIANS) C IVTNUM = 13 IF (ICZERO) 30130, 0130, 30130 0130 CONTINUE RVCOMP = 10.0 RVCOMP = TAN (0.0) RVCORR = 0.0 40130 IF (RVCOMP) 20130, 10130, 20130 30130 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10130, 0141, 20130 10130 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0141 20130 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0141 CONTINUE C C **** FCVS PROGRAM 307 - TEST 014 **** C C FIND THE TANGENT OF 135 DEGREES (2.3562 RADIANS) C IVTNUM = 14 IF (ICZERO) 30140, 0140, 30140 0140 CONTINUE RVCOMP = 10.0 RVON01 = 3 * PI / 4 RVCOMP = TAN (RVON01) RVCORR = -1.0 40140 IF (RVCOMP + 1.0005) 20140, 10140, 40141 40141 IF (RVCOMP + .9995) 10140, 10140, 20140 30140 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10140, 0151, 20140 10140 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0151 20140 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0151 CONTINUE C C **** FCVS PROGRAM 307 - TEST 015 **** C C FIND THE TANGENT OF 540 DEGREES (9.4248 RADIANS) C IVTNUM = 15 IF (ICZERO) 30150, 0150, 30150 0150 CONTINUE RVCOMP = 10.0 RAON11(2) = 3 * PI RVCOMP = TAN (RAON11(2)) RVCORR = 0.0 40150 IF (RVCOMP + .00005) 20150, 10150, 40151 40151 IF (RVCOMP - .00005) 10150, 10150, 20150 30150 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10150, 0161, 20150 10150 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0161 20150 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0161 CONTINUE C C **** FCVS PROGRAM 307 - TEST 016 **** C C FIND THE TANGENT OF 30 DEGREES (.52360 RADIANS) C IVTNUM = 16 IF (ICZERO) 30160, 0160, 30160 0160 CONTINUE RVCOMP = 10.0 RVON01 = PI/6 RVCOMP = TAN (RVON01) RVCORR = .57735 40160 IF (RVCOMP - .57730) 20160, 10160, 40161 40161 IF (RVCOMP - .57740) 10160, 10160, 20160 30160 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10160, 0171, 20160 10160 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0171 20160 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0171 CONTINUE C C **** FCVS PROGRAM 307 - TEST 017 **** C C FIND THE TANGENT OF 30 DEGREES BY DIVIDING THE SINE OF 30 DEGREES C BY THE COSINE OF 30 DEGREES. C IVTNUM = 17 IF (ICZERO) 30170, 0170, 30170 0170 CONTINUE RVCOMP = 10.0 RVON01 = PI/6 RVCOMP = SIN(RVON01)/COS(RVON01) RVCORR = .57735 40170 IF (RVCOMP - .57730) 20170, 10170, 40171 40171 IF (RVCOMP - .57740) 10170, 10170, 20170 30170 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10170, 0181, 20170 10170 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0181 20170 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0181 CONTINUE C C TEST 018 THROUGH TEST 021 CONTAIN INTRINSIC FUNCTION TESTS FOR C FINDING THE TRIGONOMETRIC ARCSINE (ASIN) WHERE THE FUNCTION AND C ARGUMENT TYPES ARE BOTH REAL. THE ABSOLUTE VALUES OF ALL C ARGUMENTS ARE LESS THAN OR EQUAL TO ONE. THE FUNCTION VALUES C ARE EXPRESSED IN RADIANS WHERE ONE RADIAN EQUALS 57.296 DEGREES. C C C **** FCVS PROGRAM 307 - TEST 018 **** C C THE ARCSINE OF +1. IS 90 DEGREES (1.5708 RADIANS) C IVTNUM = 18 IF (ICZERO) 30180, 0180, 30180 0180 CONTINUE RVCOMP = 10.0 RVCOMP = ASIN (+1.0) RVCORR = 1.5708 40180 IF (RVCOMP - 1.5703) 20180, 10180, 40181 40181 IF (RVCOMP - 1.5713) 10180, 10180, 20180 30180 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10180, 0191, 20180 10180 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0191 20180 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0191 CONTINUE C C **** FCVS PROGRAM 307 - TEST 019 **** C C THE ARCSINE OF -1. IS -90 DEGREES (-1.5708 RADIANS) C IVTNUM = 19 IF (ICZERO) 30190, 0190, 30190 0190 CONTINUE RVCOMP = 10.0 RVON01 = -1.0 RVCOMP = ASIN(RVON01) RVCORR = -1.5708 40190 IF (RVCOMP + 1.5713) 20190, 10190, 40191 40191 IF (RVCOMP + 1.5703) 10190, 10190, 20190 30190 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10190, 0201, 20190 10190 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0201 20190 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0201 CONTINUE C C **** FCVS PROGRAM 307 - TEST 020 **** C C THE ARCSINE OF -.5 TS -30 DEGREES (-.52360 RADIANS) C IVTNUM = 20 IF (ICZERO) 30200, 0200, 30200 0200 CONTINUE RVCOMP = 10.0 RAON11(1) = -.5 RVCOMP = ASIN (RAON11(1)) RVCORR = -.52360 40200 IF (RVCOMP + .52365) 20200, 10200, 40201 40201 IF (RVCOMP + .52355) 10200, 10200, 20200 30200 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10200, 0211, 20200 10200 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0211 20200 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0211 CONTINUE C C **** FCVS PROGRAM 307 - TEST 021 **** C C THE ARCSINE OF 0.0 IS 0 DEGREES (0.0 RADIANS) C IVTNUM = 21 IF (ICZERO) 30210, 0210, 30210 0210 CONTINUE RVCOMP = 10.0 RVON01 = 0.0 RVCOMP = ASIN (RVON01) RVCORR = 0.0 40210 IF (RVCOMP) 20210, 10210, 20210 30210 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10210, 0221, 20210 10210 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0221 20210 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0221 CONTINUE C C TEST 022 THROUGH TEST 025 CONTAIN INTRINSIC FUNCTION TESTS FOR C FINDING THE TRIGONOMETRIC ARCCOSINE (ACOS) WHERE THE FUNCTION C AND ARGUMENT TYPES ARE BOTH REAL. THE ABSOLUTE VALUES ALL C ARGUMENTS ARE LESS THAN OR EQUAL TO ONE. THE FUNCTION VALUES C ARE EXPRESSED IN RADIANS WHERE ONE RADIAN EQUALS 57.296 DEGREES. C C C **** FCVS PROGRAM 307 - TEST 022 **** C C THE ARCCOSINE OF +1. IS 0 DEGREES ( 0.0 RADIANS) C IVTNUM = 22 IF (ICZERO) 30220, 0220, 30220 0220 CONTINUE RVCOMP = 10.0 RVCOMP = ACOS(+1.) RVCORR = 0.0 40220 IF (RVCOMP + .00005) 20220, 10220, 40221 40221 IF (RVCOMP - .00005) 10220, 10220, 20220 30220 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10220, 0231, 20220 10220 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0231 20220 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0231 CONTINUE C C **** FCVS PROGRAM 307 - TEST 023 **** C C THE ARCCOSINE OF -1. IS 180 DEGREES (3.1416 RADIANS) C IVTNUM = 23 IF (ICZERO) 30230, 0230, 30230 0230 CONTINUE RVCOMP = 10.0 RVON01 = -1.0 RVCOMP = ACOS (RVON01) RVCORR = 3.1416 40230 IF (RVCOMP - 3.1411) 20230, 10230, 40231 40231 IF (RVCOMP - 3.1421) 10230, 10230, 20230 30230 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10230, 0241, 20230 10230 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0241 20230 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0241 CONTINUE C C **** FCVS PROGRAM 307 - TEST 024 **** C C THE ARCCOSINE OF -.5 IS 120 DEGREES (2.0944 RADIANS) C IVTNUM = 24 IF (ICZERO) 30240, 0240, 30240 0240 CONTINUE RVCOMP = 10.0 RAON11(1) = -.5 RVCOMP = ACOS (RAON11(1)) RVCORR = 2.0944 40240 IF (RVCOMP - 2.0939) 20240, 10240, 40241 40241 IF (RVCOMP - 2.0949) 10240, 10240, 20240 30240 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10240, 0251, 20240 10240 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0251 20240 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0251 CONTINUE C C **** FCVS PROGRAM 307 - TEST 025 **** C C THE ARCCOSINE OF 0.0 IS 90 DEGREES (1.5708 RADIANS) C IVTNUM = 25 IF (ICZERO) 30250, 0250, 30250 0250 CONTINUE RVCOMP = 10.0 RVCOMP = ACOS (0.) RVCORR = 1.5708 40250 IF (RVCOMP - 1.5703) 20250, 10250, 40251 40251 IF (RVCOMP - 1.5713) 10250, 10250, 20250 30250 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10250, 0261, 20250 10250 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0261 20250 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0261 CONTINUE C C TEST 026 THROUGH TEST 028 CONTAIN INTRINSIC FUNCTION TESTS FOR C FINDING THE HYPERBOLIC SINE (SINH) WHERE THE FUNCTION AND C ARGUMENT TYPES ARE BOTH REAL. ONLY POSITIVE ARGUMENTS ARE C TESTED. C C C **** FCVS PROGRAM 307 - TEST 026 **** C C CONSTANT ARGUMENT C IVTNUM = 26 IF (ICZERO) 30260, 0260, 30260 0260 CONTINUE RVCOMP = 10.0 RVCOMP = SINH (0.0) RVCORR = 0.0 40260 IF (RVCOMP + .00005) 20260, 10260, 40261 40261 IF (RVCOMP - .00005) 10260, 10260, 20260 30260 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10260, 0271, 20260 10260 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0271 20260 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0271 CONTINUE C C **** FCVS PROGRAM 307 - TEST 027 **** C C VARIABLE ARGUMENT C IVTNUM = 27 IF (ICZERO) 30270, 0270, 30270 0270 CONTINUE RVCOMP =10.0 RVON01 = 2.0 RVCOMP = SINH (RVON01) RVCORR = 3.6269 40270 IF (RVCOMP - 3.6264) 20270, 10270, 40271 40271 IF (RVCOMP - 3.6274) 10270, 10270, 20270 30270 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10270, 0281, 20270 10270 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0281 20270 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0281 CONTINUE C C **** FCVS PROGRAM 307 - TEST 028 **** C C ARRAY ELEMENT NAME ARGUMENT C IVTNUM = 28 IF (ICZERO) 30280, 0280, 30280 0280 CONTINUE RVCOMP = 10.0 RAON11(1) = 6.0 RVCOMP = SINH (RAON11(1)) RVCORR = 201.71 40280 IF (RVCOMP - 201.66) 20280, 10280, 40281 40281 IF (RVCOMP - 201.76) 10280, 10280, 20280 30280 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10280, 0291, 20280 10280 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0291 20280 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0291 CONTINUE C C TEST 029 THROUGH TEST 031 CONTAIN INTRINSIC FUNCTION TESTS FOR C FINDING THE HYPERBOLIC COSINE (COSH) WHERE THE FUNCTION AND C ARGUMENT TYPES ARE BOTH REAL. ONLY POSITIVE ARGUMENTS ARE TESTED. C C C **** FCVS PROGRAM 307 - TEST 029 **** C C CONSTANT ARGUMENT C IVTNUM = 29 IF (ICZERO) 30290, 0290, 30290 0290 CONTINUE RVCOMP = 10.0 RVCOMP = COSH (0.0) RVCORR = 1.0 40290 IF (RVCOMP - .9995) 20290, 10290, 40291 40291 IF (RVCOMP - 1.0005) 10290, 10290, 20290 30290 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10290, 0301, 20290 10290 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0301 20290 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0301 CONTINUE C C **** FCVS PROGRAM 307 - TEST 030 **** C C VARIABLE ARGUMENT C IVTNUM = 30 IF (ICZERO) 30300, 0300, 30300 0300 CONTINUE RVCOMP = 10.0 RVON01 = 2.0 RVCOMP = COSH (RVON01) RVCORR = 3.7622 40300 IF (RVCOMP - 3.7617) 20300, 10300, 40301 40301 IF (RVCOMP - 3.7627) 10300, 10300, 20300 30300 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10300, 0311, 20300 10300 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0311 20300 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0311 CONTINUE C C **** FCVS PROGRAM 307 - TEST 031 **** C C ARRAY ELEMENT NAME ARGUMENT C IVTNUM = 31 IF (ICZERO) 30310, 0310, 30310 0310 CONTINUE RVCOMP = 10.0 RAON11(2) = 6.0 RVCOMP = COSH (RAON11(2)) RVCORR = 201.72 40310 IF (RVCOMP - 201.67) 20310, 10310, 40311 40311 IF (RVCOMP - 201.77) 10310, 10310, 20310 30310 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10310, 0321, 20310 10310 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0321 20310 IVFAIL = IVFAIL + 1 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 0321 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,5HFM307) 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM307) 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