PROGRAM FM307 00010307 C 00020307 C 00030307 C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION 00040307 C TYPE IS REAL AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE 00050307 C FUNCTION NINT IS AN EXCEPTION AND HAS AN INTEGER FUNCTION TYPE. 00060307 C THE REAL OR INTEGER ARGUMENTS CONSIST OF POSITIVE, NEGATIVE AND 00070307 C UNSIGNED CONSTANTS, VARIABLES AND ARRAY ELEMENT VALUES. EACH 00080307 C INTRINSIC FUNCTION IS TESTED WITH THREE OR FOUR DIFFERENT 00090307 C COMBINATIONS OF ACTUAL ARGUMENTS DESIGNED TO TEST NOT ONLY THE 00100307 C VARIOUS COMBINATIONS OF DATA USAGES BUT ALSO TO TEST THE RANGE OF 00110307 C ARGUMENT AND FUNCTION VALUES, WHERE THAT IS APPROPRIATE. THE 00120307 C INTRINSIC FUNCTIONS TESTED IN THIS ROUTINE INCLUDE. 00130307 C 00140307 C SPECIFIC TYPE OF 00150307 C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION00160307 C ------------------ ------ -------- --------00170307 C CONVERSION TO REAL REAL INTEGER REAL 00180307 C NEAREST WHOLE NUMBER ANINT REAL REAL 00190307 C NEAREST INTEGER NINT REAL INTEGER 00200307 C TANGENT TAN REAL REAL 00210307 C ARCSINE ASIN REAL REAL 00220307 C ARCCOSINE ACOS REAL REAL 00230307 C HYPERBOLIC SINE SINH REAL REAL 00240307 C HYPERBOLIC COSINE COSH REAL REAL 00250307 C 00260307 C SUBSET LEVEL ROUTINES FM097 THROUGH FM099 AND FM308 ALSO 00270307 C TEST THE USE OF INTEGER AND REAL INTRINSIC FUNCTIONS. 00280307 C 00290307 C REFERENCES. 00300307 C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00310307 C X3.9-1978 00320307 C 00330307 C SECTION 15.3, INTRINSIC FUNCTIONS 00340307 C SECTION 15.9.2, ACTUAL ARGUMENTS 00350307 C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS 00360307 C TABLE 5, INTRINSIC FUNCTIONS (INCLUDING NOTES) 00370307 C SECTION 15.10.1, RESTRICTION ON RANGE OF ARGUMENTS AND RESULTS00380307 C 00390307 C 00400307 C ******************************************************************00410307 C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00420307 C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00430307 C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00440307 C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00450307 C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00460307 C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00470307 C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00480307 C THE RESULT OF EXECUTING THESE TESTS. 00490307 C 00500307 C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00510307 C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00520307 C 00530307 C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00540307 C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00550307 C SOFTWARE STANDARDS VALIDATION GROUP 00560307 C BUILDING 225 RM A266 00570307 C GAITHERSBURG, MD 20899 00580307 C ******************************************************************00590307 C 00600307 C 00610307 IMPLICIT LOGICAL (L) 00620307 IMPLICIT CHARACTER*14 (C) 00630307 C 00640307 DIMENSION IAON11(4) 00650307 DIMENSION RAON11(4) 00660307 DATA PI/3.141592654/ 00670307 C 00680307 C 00690307 C 00700307 C INITIALIZATION SECTION. 00710307 C 00720307 C INITIALIZE CONSTANTS 00730307 C ******************** 00740307 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00750307 I01 = 5 00760307 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00770307 I02 = 6 00780307 C SYSTEM ENVIRONMENT SECTION 00790307 C 00800307 CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00810307 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00820307 C (UNIT NUMBER FOR CARD READER). 00830307 CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00840307 C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00850307 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00860307 C 00870307 CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00880307 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00890307 C (UNIT NUMBER FOR PRINTER). 00900307 CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00910307 C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00920307 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00930307 C 00940307 IVPASS = 0 00950307 IVFAIL = 0 00960307 IVDELE = 0 00970307 ICZERO = 0 00980307 C 00990307 C WRITE OUT PAGE HEADERS 01000307 C 01010307 WRITE (I02,90002) 01020307 WRITE (I02,90006) 01030307 WRITE (I02,90008) 01040307 WRITE (I02,90004) 01050307 WRITE (I02,90010) 01060307 WRITE (I02,90004) 01070307 WRITE (I02,90016) 01080307 WRITE (I02,90001) 01090307 WRITE (I02,90004) 01100307 WRITE (I02,90012) 01110307 WRITE (I02,90014) 01120307 WRITE (I02,90004) 01130307 C 01140307 C 01150307 C TEST 001 THROUGH TEST 004 CONTAIN INTRINSIC FUNCTION TESTS FOR 01160307 C TYPE CONVERSION TO REAL (REAL) WHERE THE FUNCTION IS REAL AND THE 01170307 C ARGUMENT IS INTEGER. 01180307 C 01190307 C 01200307 C **** FCVS PROGRAM 307 - TEST 001 **** 01210307 C 01220307 C CONSTANT ARGUMENT 01230307 C 01240307 IVTNUM = 1 01250307 IF (ICZERO) 30010, 0010, 30010 01260307 0010 CONTINUE 01270307 RVCOMP = 10.0 01280307 RVCOMP = REAL (6) 01290307 RVCORR = 6.0 01300307 40010 IF (RVCOMP - 5.9995) 20010,10010,40011 01310307 40011 IF (RVCOMP - 6.0005) 10010,10010,20010 01320307 30010 IVDELE = IVDELE + 1 01330307 WRITE (I02,80000) IVTNUM 01340307 IF (ICZERO) 10010, 0021, 20010 01350307 10010 IVPASS = IVPASS + 1 01360307 WRITE (I02,80002) IVTNUM 01370307 GO TO 0021 01380307 20010 IVFAIL = IVFAIL + 1 01390307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01400307 0021 CONTINUE 01410307 C 01420307 C **** FCVS PROGRAM 307 - TEST 002 **** 01430307 C 01440307 C VARIABLE ARGUMENT 01450307 C 01460307 IVTNUM = 2 01470307 IF (ICZERO) 30020, 0020, 30020 01480307 0020 CONTINUE 01490307 RVCOMP = 10.0 01500307 IVON01 = 6 01510307 RVCOMP = REAL (IVON01) 01520307 RVCORR = 6.0 01530307 40020 IF (RVCOMP - 5.9995) 20020,10020,40021 01540307 40021 IF (RVCOMP - 6.0005) 10020, 10020, 20020 01550307 30020 IVDELE = IVDELE + 1 01560307 WRITE (I02,80000) IVTNUM 01570307 IF (ICZERO) 10020, 0031, 20020 01580307 10020 IVPASS = IVPASS + 1 01590307 WRITE (I02,80002) IVTNUM 01600307 GO TO 0031 01610307 20020 IVFAIL = IVFAIL + 1 01620307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01630307 0031 CONTINUE 01640307 C 01650307 C **** FCVS PROGRAM 307 - TEST 003 **** 01660307 C 01670307 C ARRAY ELEMENT NAME ARGUMENT 01680307 C 01690307 IVTNUM = 3 01700307 IF (ICZERO) 30030, 0030, 30030 01710307 0030 CONTINUE 01720307 RVCOMP = 10.0 01730307 IAON11(3) = 6 01740307 RVCOMP = REAL (IAON11(3)) 01750307 RVCORR = 6.0 01760307 40030 IF (RVCOMP - 5.9995) 20030, 10030, 40031 01770307 40031 IF (RVCOMP - 6.0005) 10030, 10030, 20030 01780307 30030 IVDELE = IVDELE + 1 01790307 WRITE (I02,80000) IVTNUM 01800307 IF (ICZERO) 10030, 0041, 20030 01810307 10030 IVPASS = IVPASS + 1 01820307 WRITE (I02,80002) IVTNUM 01830307 GO TO 0041 01840307 20030 IVFAIL = IVFAIL + 1 01850307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01860307 0041 CONTINUE 01870307 C 01880307 C **** FCVS PROGRAM 307 - TEST 004 **** 01890307 C 01900307 C EXPRESSION AS ARGUMENT 01910307 C 01920307 IVTNUM = 4 01930307 IF (ICZERO) 30040, 0040, 30040 01940307 0040 CONTINUE 01950307 RVCOMP = 10.0 01960307 IVON01 = 6 01970307 RVCOMP = REAL (IVON01 - 6) 01980307 RVCORR = 0.0 01990307 40040 IF(RVCOMP + .00005) 20040, 10040, 40041 02000307 40041 IF(RVCOMP - .00005) 10040, 10040, 20040 02010307 30040 IVDELE = IVDELE + 1 02020307 WRITE (I02,80000) IVTNUM 02030307 IF (ICZERO) 10040, 0051, 20040 02040307 10040 IVPASS = IVPASS + 1 02050307 WRITE (I02,80002) IVTNUM 02060307 GO TO 0051 02070307 20040 IVFAIL = IVFAIL + 1 02080307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02090307 0051 CONTINUE 02100307 C 02110307 C TEST 005 THROUGH TEST 008 CONTAIN INTRINSIC FUNCTION TESTS FOR 02120307 C FINDING THE NEAREST WHOLE NUMBER (ANINT) WHERE THE FUNCTION AND 02130307 C ARGUMENT TYPES ARE BOTH REAL. 02140307 C 02150307 C 02160307 C **** FCVS PROGRAM 307 - TEST 005 **** 02170307 C 02180307 C CONSTANT ARGUMENT 02190307 C 02200307 IVTNUM = 5 02210307 IF (ICZERO) 30050, 0050, 30050 02220307 0050 CONTINUE 02230307 RVCOMP = 10.0 02240307 RVCOMP = ANINT (3.4994) 02250307 RVCORR = 3.0 02260307 40050 IF (RVCOMP - 2.9995) 20050, 10050, 40051 02270307 40051 IF (RVCOMP - 3.0005) 10050, 10050, 20050 02280307 30050 IVDELE = IVDELE + 1 02290307 WRITE (I02,80000) IVTNUM 02300307 IF (ICZERO) 10050, 0061, 20050 02310307 10050 IVPASS = IVPASS + 1 02320307 WRITE (I02,80002) IVTNUM 02330307 GO TO 0061 02340307 20050 IVFAIL = IVFAIL + 1 02350307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02360307 0061 CONTINUE 02370307 C 02380307 C **** FCVS PROGRAM 307 - TEST 006 **** 02390307 C 02400307 C VARIABLE ARGUMENT 02410307 C 02420307 IVTNUM = 6 02430307 IF (ICZERO) 30060, 0060, 30060 02440307 0060 CONTINUE 02450307 RVCOMP = 10.0 02460307 RVON01 = -3.4994 02470307 RVCOMP = ANINT (RVON01) 02480307 RVCORR = -3.0 02490307 40060 IF (RVCOMP + 3.0005) 20060, 10060, 40061 02500307 40061 IF (RVCOMP + 2.9995) 10060, 10060, 20060 02510307 30060 IVDELE = IVDELE + 1 02520307 WRITE (I02,80000) IVTNUM 02530307 IF (ICZERO) 10060, 0071, 20060 02540307 10060 IVPASS = IVPASS + 1 02550307 WRITE (I02,80002) IVTNUM 02560307 GO TO 0071 02570307 20060 IVFAIL = IVFAIL + 1 02580307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02590307 0071 CONTINUE 02600307 C 02610307 C **** FCVS PROGRAM 307 - TEST 007 **** 02620307 C 02630307 C ARRAY ELEMENT NAME ARGUMENT 02640307 C 02650307 IVTNUM = 7 02660307 IF (ICZERO) 30070, 0070, 30070 02670307 0070 CONTINUE 02680307 RVCOMP = 10.0 02690307 RAON11(3) = 3.0000 02700307 RVCOMP = ANINT (RAON11(3)) 02710307 RVCORR = 3.0 02720307 40070 IF (RVCOMP - 2.9995) 20070, 10070, 40071 02730307 40071 IF (RVCOMP - 3.0005) 10070, 10070, 20070 02740307 30070 IVDELE = IVDELE + 1 02750307 WRITE (I02,80000) IVTNUM 02760307 IF (ICZERO) 10070, 0081, 20070 02770307 10070 IVPASS = IVPASS + 1 02780307 WRITE (I02,80002) IVTNUM 02790307 GO TO 0081 02800307 20070 IVFAIL = IVFAIL + 1 02810307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02820307 0081 CONTINUE 02830307 C 02840307 C **** FCVS PROGRAM 307 - TEST 008 **** 02850307 C 02860307 C ZERO ARGUMENT 02870307 C 02880307 IVTNUM = 8 02890307 IF (ICZERO) 30080, 0080, 30080 02900307 0080 CONTINUE 02910307 RVCOMP = 10.0 02920307 RVCOMP = ANINT (0.0) 02930307 RVCORR = 0.0 02940307 40080 IF (RVCOMP) 20080, 10080, 20080 02950307 30080 IVDELE = IVDELE + 1 02960307 WRITE (I02,80000) IVTNUM 02970307 IF (ICZERO) 10080, 0091, 20080 02980307 10080 IVPASS = IVPASS + 1 02990307 WRITE (I02,80002) IVTNUM 03000307 GO TO 0091 03010307 20080 IVFAIL = IVFAIL + 1 03020307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03030307 0091 CONTINUE 03040307 C 03050307 C TEST 009 THROUGH TEST 012 CONTAIN INTRINSIC FUNCTION TESTS FOR 03060307 C FINDING THE NEAREST INTEGER (NINT) WHERE THE ARGUMENT IS REAL 03070307 C AND THE FUNCTION TYPE IS INTEGER. 03080307 C 03090307 C 03100307 C **** FCVS PROGRAM 307 - TEST 009 **** 03110307 C 03120307 C CONSTANT ARGUMENT 03130307 C 03140307 IVTNUM = 9 03150307 IF (ICZERO) 30090, 0090, 30090 03160307 0090 CONTINUE 03170307 IVCOMP = 10 03180307 IVCOMP = NINT (3.4994) 03190307 IVCORR = 3 03200307 40090 IF (IVCOMP - 3) 20090, 10090, 20090 03210307 30090 IVDELE = IVDELE + 1 03220307 WRITE (I02,80000) IVTNUM 03230307 IF (ICZERO) 10090, 0101, 20090 03240307 10090 IVPASS = IVPASS + 1 03250307 WRITE (I02,80002) IVTNUM 03260307 GO TO 0101 03270307 20090 IVFAIL = IVFAIL + 1 03280307 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03290307 0101 CONTINUE 03300307 C 03310307 C **** FCVS PROGRAM 307 - TEST 010 **** 03320307 C 03330307 C VARIABLE ARGUMENT 03340307 C 03350307 IVTNUM = 10 03360307 IF (ICZERO) 30100, 0100, 30100 03370307 0100 CONTINUE 03380307 IVCOMP = 10 03390307 RVON01 = -3.4994 03400307 IVCOMP = NINT (RVON01) 03410307 IVCORR = -3 03420307 40100 IF (IVCOMP +3) 20100, 10100, 20100 03430307 30100 IVDELE = IVDELE + 1 03440307 WRITE (I02,80000) IVTNUM 03450307 IF (ICZERO) 10100, 0111, 20100 03460307 10100 IVPASS = IVPASS + 1 03470307 WRITE (I02,80002) IVTNUM 03480307 GO TO 0111 03490307 20100 IVFAIL = IVFAIL + 1 03500307 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03510307 0111 CONTINUE 03520307 C 03530307 C **** FCVS PROGRAM 307 - TEST 011 **** 03540307 C 03550307 C ARRAY ELEMENT NAME ARGUMENT 03560307 C 03570307 IVTNUM = 11 03580307 IF (ICZERO) 30110, 0110, 30110 03590307 0110 CONTINUE 03600307 IVCOMP = 10 03610307 RAON11(1) = 3.0000 03620307 IVCOMP = NINT (RAON11(1)) 03630307 IVCORR = 3 03640307 40110 IF (IVCOMP -3) 20110, 10110, 20110 03650307 30110 IVDELE = IVDELE + 1 03660307 WRITE (I02,80000) IVTNUM 03670307 IF (ICZERO) 10110, 0121, 20110 03680307 10110 IVPASS = IVPASS + 1 03690307 WRITE (I02,80002) IVTNUM 03700307 GO TO 0121 03710307 20110 IVFAIL = IVFAIL + 1 03720307 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03730307 0121 CONTINUE 03740307 C 03750307 C **** FCVS PROGRAM 307 - TEST 012 **** 03760307 C 03770307 C ZERO ARGUMENT 03780307 C 03790307 IVTNUM = 12 03800307 IF (ICZERO) 30120, 0120, 30120 03810307 0120 CONTINUE 03820307 IVCOMP = 10 03830307 IVCOMP = NINT (0.0) 03840307 IVCORR = 0 03850307 40120 IF (IVCOMP) 20120, 10120, 20120 03860307 30120 IVDELE = IVDELE + 1 03870307 WRITE (I02,80000) IVTNUM 03880307 IF (ICZERO) 10120, 0131, 20120 03890307 10120 IVPASS = IVPASS + 1 03900307 WRITE (I02,80002) IVTNUM 03910307 GO TO 0131 03920307 20120 IVFAIL = IVFAIL + 1 03930307 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03940307 0131 CONTINUE 03950307 C 03960307 C TEST 013 THROUGH TEST 017 CONTAIN INTRINSIC FUNCTION TESTS FOR 03970307 C FINDING THE TRIGONOMETRIC TANGENT (TAN) WHERE THE FUNCTION AND 03980307 C ARGUMENT TYPES ARE BOTH REAL. ALL ARGUMENTS ARE GIVEN IN RADIANS 03990307 C WHERE ONE RADIAN EQUALS 57.296 DEGREES. 04000307 C 04010307 C 04020307 C **** FCVS PROGRAM 307 - TEST 013 **** 04030307 C 04040307 C FIND THE TANGENT OF 0 DEGREES (0.0 RADIANS) 04050307 C 04060307 IVTNUM = 13 04070307 IF (ICZERO) 30130, 0130, 30130 04080307 0130 CONTINUE 04090307 RVCOMP = 10.0 04100307 RVCOMP = TAN (0.0) 04110307 RVCORR = 0.0 04120307 40130 IF (RVCOMP) 20130, 10130, 20130 04130307 30130 IVDELE = IVDELE + 1 04140307 WRITE (I02,80000) IVTNUM 04150307 IF (ICZERO) 10130, 0141, 20130 04160307 10130 IVPASS = IVPASS + 1 04170307 WRITE (I02,80002) IVTNUM 04180307 GO TO 0141 04190307 20130 IVFAIL = IVFAIL + 1 04200307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04210307 0141 CONTINUE 04220307 C 04230307 C **** FCVS PROGRAM 307 - TEST 014 **** 04240307 C 04250307 C FIND THE TANGENT OF 135 DEGREES (2.3562 RADIANS) 04260307 C 04270307 IVTNUM = 14 04280307 IF (ICZERO) 30140, 0140, 30140 04290307 0140 CONTINUE 04300307 RVCOMP = 10.0 04310307 RVON01 = 3 * PI / 4 04320307 RVCOMP = TAN (RVON01) 04330307 RVCORR = -1.0 04340307 40140 IF (RVCOMP + 1.0005) 20140, 10140, 40141 04350307 40141 IF (RVCOMP + .9995) 10140, 10140, 20140 04360307 30140 IVDELE = IVDELE + 1 04370307 WRITE (I02,80000) IVTNUM 04380307 IF (ICZERO) 10140, 0151, 20140 04390307 10140 IVPASS = IVPASS + 1 04400307 WRITE (I02,80002) IVTNUM 04410307 GO TO 0151 04420307 20140 IVFAIL = IVFAIL + 1 04430307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04440307 0151 CONTINUE 04450307 C 04460307 C **** FCVS PROGRAM 307 - TEST 015 **** 04470307 C 04480307 C FIND THE TANGENT OF 540 DEGREES (9.4248 RADIANS) 04490307 C 04500307 IVTNUM = 15 04510307 IF (ICZERO) 30150, 0150, 30150 04520307 0150 CONTINUE 04530307 RVCOMP = 10.0 04540307 RAON11(2) = 3 * PI 04550307 RVCOMP = TAN (RAON11(2)) 04560307 RVCORR = 0.0 04570307 40150 IF (RVCOMP + .00005) 20150, 10150, 40151 04580307 40151 IF (RVCOMP - .00005) 10150, 10150, 20150 04590307 30150 IVDELE = IVDELE + 1 04600307 WRITE (I02,80000) IVTNUM 04610307 IF (ICZERO) 10150, 0161, 20150 04620307 10150 IVPASS = IVPASS + 1 04630307 WRITE (I02,80002) IVTNUM 04640307 GO TO 0161 04650307 20150 IVFAIL = IVFAIL + 1 04660307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04670307 0161 CONTINUE 04680307 C 04690307 C **** FCVS PROGRAM 307 - TEST 016 **** 04700307 C 04710307 C FIND THE TANGENT OF 30 DEGREES (.52360 RADIANS) 04720307 C 04730307 IVTNUM = 16 04740307 IF (ICZERO) 30160, 0160, 30160 04750307 0160 CONTINUE 04760307 RVCOMP = 10.0 04770307 RVON01 = PI/6 04780307 RVCOMP = TAN (RVON01) 04790307 RVCORR = .57735 04800307 40160 IF (RVCOMP - .57730) 20160, 10160, 40161 04810307 40161 IF (RVCOMP - .57740) 10160, 10160, 20160 04820307 30160 IVDELE = IVDELE + 1 04830307 WRITE (I02,80000) IVTNUM 04840307 IF (ICZERO) 10160, 0171, 20160 04850307 10160 IVPASS = IVPASS + 1 04860307 WRITE (I02,80002) IVTNUM 04870307 GO TO 0171 04880307 20160 IVFAIL = IVFAIL + 1 04890307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04900307 0171 CONTINUE 04910307 C 04920307 C **** FCVS PROGRAM 307 - TEST 017 **** 04930307 C 04940307 C FIND THE TANGENT OF 30 DEGREES BY DIVIDING THE SINE OF 30 DEGREES 04950307 C BY THE COSINE OF 30 DEGREES. 04960307 C 04970307 IVTNUM = 17 04980307 IF (ICZERO) 30170, 0170, 30170 04990307 0170 CONTINUE 05000307 RVCOMP = 10.0 05010307 RVON01 = PI/6 05020307 RVCOMP = SIN(RVON01)/COS(RVON01) 05030307 RVCORR = .57735 05040307 40170 IF (RVCOMP - .57730) 20170, 10170, 40171 05050307 40171 IF (RVCOMP - .57740) 10170, 10170, 20170 05060307 30170 IVDELE = IVDELE + 1 05070307 WRITE (I02,80000) IVTNUM 05080307 IF (ICZERO) 10170, 0181, 20170 05090307 10170 IVPASS = IVPASS + 1 05100307 WRITE (I02,80002) IVTNUM 05110307 GO TO 0181 05120307 20170 IVFAIL = IVFAIL + 1 05130307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05140307 0181 CONTINUE 05150307 C 05160307 C TEST 018 THROUGH TEST 021 CONTAIN INTRINSIC FUNCTION TESTS FOR 05170307 C FINDING THE TRIGONOMETRIC ARCSINE (ASIN) WHERE THE FUNCTION AND 05180307 C ARGUMENT TYPES ARE BOTH REAL. THE ABSOLUTE VALUES OF ALL 05190307 C ARGUMENTS ARE LESS THAN OR EQUAL TO ONE. THE FUNCTION VALUES 05200307 C ARE EXPRESSED IN RADIANS WHERE ONE RADIAN EQUALS 57.296 DEGREES. 05210307 C 05220307 C 05230307 C **** FCVS PROGRAM 307 - TEST 018 **** 05240307 C 05250307 C THE ARCSINE OF +1. IS 90 DEGREES (1.5708 RADIANS) 05260307 C 05270307 IVTNUM = 18 05280307 IF (ICZERO) 30180, 0180, 30180 05290307 0180 CONTINUE 05300307 RVCOMP = 10.0 05310307 RVCOMP = ASIN (+1.0) 05320307 RVCORR = 1.5708 05330307 40180 IF (RVCOMP - 1.5703) 20180, 10180, 40181 05340307 40181 IF (RVCOMP - 1.5713) 10180, 10180, 20180 05350307 30180 IVDELE = IVDELE + 1 05360307 WRITE (I02,80000) IVTNUM 05370307 IF (ICZERO) 10180, 0191, 20180 05380307 10180 IVPASS = IVPASS + 1 05390307 WRITE (I02,80002) IVTNUM 05400307 GO TO 0191 05410307 20180 IVFAIL = IVFAIL + 1 05420307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05430307 0191 CONTINUE 05440307 C 05450307 C **** FCVS PROGRAM 307 - TEST 019 **** 05460307 C 05470307 C THE ARCSINE OF -1. IS -90 DEGREES (-1.5708 RADIANS) 05480307 C 05490307 IVTNUM = 19 05500307 IF (ICZERO) 30190, 0190, 30190 05510307 0190 CONTINUE 05520307 RVCOMP = 10.0 05530307 RVON01 = -1.0 05540307 RVCOMP = ASIN(RVON01) 05550307 RVCORR = -1.5708 05560307 40190 IF (RVCOMP + 1.5713) 20190, 10190, 40191 05570307 40191 IF (RVCOMP + 1.5703) 10190, 10190, 20190 05580307 30190 IVDELE = IVDELE + 1 05590307 WRITE (I02,80000) IVTNUM 05600307 IF (ICZERO) 10190, 0201, 20190 05610307 10190 IVPASS = IVPASS + 1 05620307 WRITE (I02,80002) IVTNUM 05630307 GO TO 0201 05640307 20190 IVFAIL = IVFAIL + 1 05650307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05660307 0201 CONTINUE 05670307 C 05680307 C **** FCVS PROGRAM 307 - TEST 020 **** 05690307 C 05700307 C THE ARCSINE OF -.5 TS -30 DEGREES (-.52360 RADIANS) 05710307 C 05720307 IVTNUM = 20 05730307 IF (ICZERO) 30200, 0200, 30200 05740307 0200 CONTINUE 05750307 RVCOMP = 10.0 05760307 RAON11(1) = -.5 05770307 RVCOMP = ASIN (RAON11(1)) 05780307 RVCORR = -.52360 05790307 40200 IF (RVCOMP + .52365) 20200, 10200, 40201 05800307 40201 IF (RVCOMP + .52355) 10200, 10200, 20200 05810307 30200 IVDELE = IVDELE + 1 05820307 WRITE (I02,80000) IVTNUM 05830307 IF (ICZERO) 10200, 0211, 20200 05840307 10200 IVPASS = IVPASS + 1 05850307 WRITE (I02,80002) IVTNUM 05860307 GO TO 0211 05870307 20200 IVFAIL = IVFAIL + 1 05880307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05890307 0211 CONTINUE 05900307 C 05910307 C **** FCVS PROGRAM 307 - TEST 021 **** 05920307 C 05930307 C THE ARCSINE OF 0.0 IS 0 DEGREES (0.0 RADIANS) 05940307 C 05950307 IVTNUM = 21 05960307 IF (ICZERO) 30210, 0210, 30210 05970307 0210 CONTINUE 05980307 RVCOMP = 10.0 05990307 RVON01 = 0.0 06000307 RVCOMP = ASIN (RVON01) 06010307 RVCORR = 0.0 06020307 40210 IF (RVCOMP) 20210, 10210, 20210 06030307 30210 IVDELE = IVDELE + 1 06040307 WRITE (I02,80000) IVTNUM 06050307 IF (ICZERO) 10210, 0221, 20210 06060307 10210 IVPASS = IVPASS + 1 06070307 WRITE (I02,80002) IVTNUM 06080307 GO TO 0221 06090307 20210 IVFAIL = IVFAIL + 1 06100307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06110307 0221 CONTINUE 06120307 C 06130307 C TEST 022 THROUGH TEST 025 CONTAIN INTRINSIC FUNCTION TESTS FOR 06140307 C FINDING THE TRIGONOMETRIC ARCCOSINE (ACOS) WHERE THE FUNCTION 06150307 C AND ARGUMENT TYPES ARE BOTH REAL. THE ABSOLUTE VALUES ALL 06160307 C ARGUMENTS ARE LESS THAN OR EQUAL TO ONE. THE FUNCTION VALUES 06170307 C ARE EXPRESSED IN RADIANS WHERE ONE RADIAN EQUALS 57.296 DEGREES. 06180307 C 06190307 C 06200307 C **** FCVS PROGRAM 307 - TEST 022 **** 06210307 C 06220307 C THE ARCCOSINE OF +1. IS 0 DEGREES ( 0.0 RADIANS) 06230307 C 06240307 IVTNUM = 22 06250307 IF (ICZERO) 30220, 0220, 30220 06260307 0220 CONTINUE 06270307 RVCOMP = 10.0 06280307 RVCOMP = ACOS(+1.) 06290307 RVCORR = 0.0 06300307 40220 IF (RVCOMP + .00005) 20220, 10220, 40221 06310307 40221 IF (RVCOMP - .00005) 10220, 10220, 20220 06320307 30220 IVDELE = IVDELE + 1 06330307 WRITE (I02,80000) IVTNUM 06340307 IF (ICZERO) 10220, 0231, 20220 06350307 10220 IVPASS = IVPASS + 1 06360307 WRITE (I02,80002) IVTNUM 06370307 GO TO 0231 06380307 20220 IVFAIL = IVFAIL + 1 06390307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06400307 0231 CONTINUE 06410307 C 06420307 C **** FCVS PROGRAM 307 - TEST 023 **** 06430307 C 06440307 C THE ARCCOSINE OF -1. IS 180 DEGREES (3.1416 RADIANS) 06450307 C 06460307 IVTNUM = 23 06470307 IF (ICZERO) 30230, 0230, 30230 06480307 0230 CONTINUE 06490307 RVCOMP = 10.0 06500307 RVON01 = -1.0 06510307 RVCOMP = ACOS (RVON01) 06520307 RVCORR = 3.1416 06530307 40230 IF (RVCOMP - 3.1411) 20230, 10230, 40231 06540307 40231 IF (RVCOMP - 3.1421) 10230, 10230, 20230 06550307 30230 IVDELE = IVDELE + 1 06560307 WRITE (I02,80000) IVTNUM 06570307 IF (ICZERO) 10230, 0241, 20230 06580307 10230 IVPASS = IVPASS + 1 06590307 WRITE (I02,80002) IVTNUM 06600307 GO TO 0241 06610307 20230 IVFAIL = IVFAIL + 1 06620307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06630307 0241 CONTINUE 06640307 C 06650307 C **** FCVS PROGRAM 307 - TEST 024 **** 06660307 C 06670307 C THE ARCCOSINE OF -.5 IS 120 DEGREES (2.0944 RADIANS) 06680307 C 06690307 IVTNUM = 24 06700307 IF (ICZERO) 30240, 0240, 30240 06710307 0240 CONTINUE 06720307 RVCOMP = 10.0 06730307 RAON11(1) = -.5 06740307 RVCOMP = ACOS (RAON11(1)) 06750307 RVCORR = 2.0944 06760307 40240 IF (RVCOMP - 2.0939) 20240, 10240, 40241 06770307 40241 IF (RVCOMP - 2.0949) 10240, 10240, 20240 06780307 30240 IVDELE = IVDELE + 1 06790307 WRITE (I02,80000) IVTNUM 06800307 IF (ICZERO) 10240, 0251, 20240 06810307 10240 IVPASS = IVPASS + 1 06820307 WRITE (I02,80002) IVTNUM 06830307 GO TO 0251 06840307 20240 IVFAIL = IVFAIL + 1 06850307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06860307 0251 CONTINUE 06870307 C 06880307 C **** FCVS PROGRAM 307 - TEST 025 **** 06890307 C 06900307 C THE ARCCOSINE OF 0.0 IS 90 DEGREES (1.5708 RADIANS) 06910307 C 06920307 IVTNUM = 25 06930307 IF (ICZERO) 30250, 0250, 30250 06940307 0250 CONTINUE 06950307 RVCOMP = 10.0 06960307 RVCOMP = ACOS (0.) 06970307 RVCORR = 1.5708 06980307 40250 IF (RVCOMP - 1.5703) 20250, 10250, 40251 06990307 40251 IF (RVCOMP - 1.5713) 10250, 10250, 20250 07000307 30250 IVDELE = IVDELE + 1 07010307 WRITE (I02,80000) IVTNUM 07020307 IF (ICZERO) 10250, 0261, 20250 07030307 10250 IVPASS = IVPASS + 1 07040307 WRITE (I02,80002) IVTNUM 07050307 GO TO 0261 07060307 20250 IVFAIL = IVFAIL + 1 07070307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07080307 0261 CONTINUE 07090307 C 07100307 C TEST 026 THROUGH TEST 028 CONTAIN INTRINSIC FUNCTION TESTS FOR 07110307 C FINDING THE HYPERBOLIC SINE (SINH) WHERE THE FUNCTION AND 07120307 C ARGUMENT TYPES ARE BOTH REAL. ONLY POSITIVE ARGUMENTS ARE 07130307 C TESTED. 07140307 C 07150307 C 07160307 C **** FCVS PROGRAM 307 - TEST 026 **** 07170307 C 07180307 C CONSTANT ARGUMENT 07190307 C 07200307 IVTNUM = 26 07210307 IF (ICZERO) 30260, 0260, 30260 07220307 0260 CONTINUE 07230307 RVCOMP = 10.0 07240307 RVCOMP = SINH (0.0) 07250307 RVCORR = 0.0 07260307 40260 IF (RVCOMP + .00005) 20260, 10260, 40261 07270307 40261 IF (RVCOMP - .00005) 10260, 10260, 20260 07280307 30260 IVDELE = IVDELE + 1 07290307 WRITE (I02,80000) IVTNUM 07300307 IF (ICZERO) 10260, 0271, 20260 07310307 10260 IVPASS = IVPASS + 1 07320307 WRITE (I02,80002) IVTNUM 07330307 GO TO 0271 07340307 20260 IVFAIL = IVFAIL + 1 07350307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07360307 0271 CONTINUE 07370307 C 07380307 C **** FCVS PROGRAM 307 - TEST 027 **** 07390307 C 07400307 C VARIABLE ARGUMENT 07410307 C 07420307 IVTNUM = 27 07430307 IF (ICZERO) 30270, 0270, 30270 07440307 0270 CONTINUE 07450307 RVCOMP =10.0 07460307 RVON01 = 2.0 07470307 RVCOMP = SINH (RVON01) 07480307 RVCORR = 3.6269 07490307 40270 IF (RVCOMP - 3.6264) 20270, 10270, 40271 07500307 40271 IF (RVCOMP - 3.6274) 10270, 10270, 20270 07510307 30270 IVDELE = IVDELE + 1 07520307 WRITE (I02,80000) IVTNUM 07530307 IF (ICZERO) 10270, 0281, 20270 07540307 10270 IVPASS = IVPASS + 1 07550307 WRITE (I02,80002) IVTNUM 07560307 GO TO 0281 07570307 20270 IVFAIL = IVFAIL + 1 07580307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07590307 0281 CONTINUE 07600307 C 07610307 C **** FCVS PROGRAM 307 - TEST 028 **** 07620307 C 07630307 C ARRAY ELEMENT NAME ARGUMENT 07640307 C 07650307 IVTNUM = 28 07660307 IF (ICZERO) 30280, 0280, 30280 07670307 0280 CONTINUE 07680307 RVCOMP = 10.0 07690307 RAON11(1) = 6.0 07700307 RVCOMP = SINH (RAON11(1)) 07710307 RVCORR = 201.71 07720307 40280 IF (RVCOMP - 201.66) 20280, 10280, 40281 07730307 40281 IF (RVCOMP - 201.76) 10280, 10280, 20280 07740307 30280 IVDELE = IVDELE + 1 07750307 WRITE (I02,80000) IVTNUM 07760307 IF (ICZERO) 10280, 0291, 20280 07770307 10280 IVPASS = IVPASS + 1 07780307 WRITE (I02,80002) IVTNUM 07790307 GO TO 0291 07800307 20280 IVFAIL = IVFAIL + 1 07810307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07820307 0291 CONTINUE 07830307 C 07840307 C TEST 029 THROUGH TEST 031 CONTAIN INTRINSIC FUNCTION TESTS FOR 07850307 C FINDING THE HYPERBOLIC COSINE (COSH) WHERE THE FUNCTION AND 07860307 C ARGUMENT TYPES ARE BOTH REAL. ONLY POSITIVE ARGUMENTS ARE TESTED.07870307 C 07880307 C 07890307 C **** FCVS PROGRAM 307 - TEST 029 **** 07900307 C 07910307 C CONSTANT ARGUMENT 07920307 C 07930307 IVTNUM = 29 07940307 IF (ICZERO) 30290, 0290, 30290 07950307 0290 CONTINUE 07960307 RVCOMP = 10.0 07970307 RVCOMP = COSH (0.0) 07980307 RVCORR = 1.0 07990307 40290 IF (RVCOMP - .9995) 20290, 10290, 40291 08000307 40291 IF (RVCOMP - 1.0005) 10290, 10290, 20290 08010307 30290 IVDELE = IVDELE + 1 08020307 WRITE (I02,80000) IVTNUM 08030307 IF (ICZERO) 10290, 0301, 20290 08040307 10290 IVPASS = IVPASS + 1 08050307 WRITE (I02,80002) IVTNUM 08060307 GO TO 0301 08070307 20290 IVFAIL = IVFAIL + 1 08080307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08090307 0301 CONTINUE 08100307 C 08110307 C **** FCVS PROGRAM 307 - TEST 030 **** 08120307 C 08130307 C VARIABLE ARGUMENT 08140307 C 08150307 IVTNUM = 30 08160307 IF (ICZERO) 30300, 0300, 30300 08170307 0300 CONTINUE 08180307 RVCOMP = 10.0 08190307 RVON01 = 2.0 08200307 RVCOMP = COSH (RVON01) 08210307 RVCORR = 3.7622 08220307 40300 IF (RVCOMP - 3.7617) 20300, 10300, 40301 08230307 40301 IF (RVCOMP - 3.7627) 10300, 10300, 20300 08240307 30300 IVDELE = IVDELE + 1 08250307 WRITE (I02,80000) IVTNUM 08260307 IF (ICZERO) 10300, 0311, 20300 08270307 10300 IVPASS = IVPASS + 1 08280307 WRITE (I02,80002) IVTNUM 08290307 GO TO 0311 08300307 20300 IVFAIL = IVFAIL + 1 08310307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08320307 0311 CONTINUE 08330307 C 08340307 C **** FCVS PROGRAM 307 - TEST 031 **** 08350307 C 08360307 C ARRAY ELEMENT NAME ARGUMENT 08370307 C 08380307 IVTNUM = 31 08390307 IF (ICZERO) 30310, 0310, 30310 08400307 0310 CONTINUE 08410307 RVCOMP = 10.0 08420307 RAON11(2) = 6.0 08430307 RVCOMP = COSH (RAON11(2)) 08440307 RVCORR = 201.72 08450307 40310 IF (RVCOMP - 201.67) 20310, 10310, 40311 08460307 40311 IF (RVCOMP - 201.77) 10310, 10310, 20310 08470307 30310 IVDELE = IVDELE + 1 08480307 WRITE (I02,80000) IVTNUM 08490307 IF (ICZERO) 10310, 0321, 20310 08500307 10310 IVPASS = IVPASS + 1 08510307 WRITE (I02,80002) IVTNUM 08520307 GO TO 0321 08530307 20310 IVFAIL = IVFAIL + 1 08540307 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08550307 0321 CONTINUE 08560307 C 08570307 C 08580307 C WRITE OUT TEST SUMMARY 08590307 C 08600307 WRITE (I02,90004) 08610307 WRITE (I02,90014) 08620307 WRITE (I02,90004) 08630307 WRITE (I02,90000) 08640307 WRITE (I02,90004) 08650307 WRITE (I02,90020) IVFAIL 08660307 WRITE (I02,90022) IVPASS 08670307 WRITE (I02,90024) IVDELE 08680307 STOP 08690307 90001 FORMAT (" ",24X,"FM307") 08700307 90000 FORMAT (" ",20X,"END OF PROGRAM FM307" ) 08710307 C 08720307 C FORMATS FOR TEST DETAIL LINES 08730307 C 08740307 80000 FORMAT (" ",4X,I5,6X,"DELETED") 08750307 80002 FORMAT (" ",4X,I5,7X,"PASS") 08760307 80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08770307 80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08780307 80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 08790307 C 08800307 C FORMAT STATEMENTS FOR PAGE HEADERS 08810307 C 08820307 90002 FORMAT ("1") 08830307 90004 FORMAT (" ") 08840307 90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08850307 90008 FORMAT (" ",21X,"VERSION 2.1" ) 08860307 90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08870307 90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 08880307 90014 FORMAT (" ",5X,"----------------------------------------------" ) 08890307 90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08900307 C 08910307 C FORMAT STATEMENTS FOR RUN SUMMARY 08920307 C 08930307 90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 08940307 90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 08950307 90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 08960307 END 08970307