blob: fe2c70d3c12b223b6499f83114e332838334bd91 [file] [log] [blame]
PROGRAM FM379
C***********************************************************************00010379
C***** FORTRAN 77 00020379
C***** FM379 00030379
C***** XRFOR - (201) 00040379
C***** 00050379
C***********************************************************************00060379
C***** GENERAL PURPOSE SUBSET REF 00070379
C***** TEST TRIGONOMETRIC FORMULAE 15.3 00080379
C***** TABLE 5 00090379
C***** 00100379
CBB** ********************** BBCCOMNT **********************************00110379
C**** 00120379
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130379
C**** VERSION 2.1 00140379
C**** 00150379
C**** 00160379
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170379
C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180379
C**** SOFTWARE STANDARDS VALIDATION GROUP 00190379
C**** BUILDING 225 RM A266 00200379
C**** GAITHERSBURG, MD 20899 00210379
C**** 00220379
C**** 00230379
C**** 00240379
CBE** ********************** BBCCOMNT **********************************00250379
CBB** ********************** BBCINITA **********************************00260379
C**** SPECIFICATION STATEMENTS 00270379
C**** 00280379
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290379
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300379
CBE** ********************** BBCINITA **********************************00310379
CBB** ********************** BBCINITB **********************************00320379
C**** INITIALIZE SECTION 00330379
DATA ZVERS, ZVERSD, ZDATE 00340379
1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350379
DATA ZCOMPL, ZNAME, ZTAPE 00360379
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370379
DATA ZPROJ, ZTAPED, ZPROG 00380379
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390379
DATA REMRKS /' '/ 00400379
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410379
C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420379
C**** 00430379
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440379
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450379
CZ03 ZPROG = 'PROGRAM NAME' 00460379
CZ04 ZDATE = 'DATE OF TEST' 00470379
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480379
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490379
CZ07 ZNAME = 'NAME OF USER' 00500379
CZ08 ZTAPE = 'TAPE OWNER/ID' 00510379
CZ09 ZTAPED = 'DATE TAPE COPIED' 00520379
C 00530379
IVPASS = 0 00540379
IVFAIL = 0 00550379
IVDELE = 0 00560379
IVINSP = 0 00570379
IVTOTL = 0 00580379
IVTOTN = 0 00590379
ICZERO = 0 00600379
C 00610379
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620379
I01 = 05 00630379
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640379
I02 = 06 00650379
C 00660379
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670379
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680379
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690379
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700379
C 00710379
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720379
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730379
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740379
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750379
C 00760379
CBE** ********************** BBCINITB **********************************00770379
NUVI = I02 00780379
IVTOTL = 10 00790379
ZPROG = 'FM379' 00800379
CBB** ********************** BBCHED0A **********************************00810379
C**** 00820379
C**** WRITE REPORT TITLE 00830379
C**** 00840379
WRITE (I02, 90002) 00850379
WRITE (I02, 90006) 00860379
WRITE (I02, 90007) 00870379
WRITE (I02, 90008) ZVERS, ZVERSD 00880379
WRITE (I02, 90009) ZPROG, ZPROG 00890379
WRITE (I02, 90010) ZDATE, ZCOMPL 00900379
CBE** ********************** BBCHED0A **********************************00910379
C***** 00920379
C***** HEADER FOR SEGMENT 201 00930379
WRITE(NUVI,20101) 00940379
20101 FORMAT(" ", / " XRFOR - (201) INTRINSIC FUNCTIONS" // 00950379
1 " TRIGONOMETRIC FORMULAE" // 00960379
2 " SUBSET REF. - 15.3" ) 00970379
CBB** ********************** BBCHED0B **********************************00980379
C**** WRITE DETAIL REPORT HEADERS 00990379
C**** 01000379
WRITE (I02,90004) 01010379
WRITE (I02,90004) 01020379
WRITE (I02,90013) 01030379
WRITE (I02,90014) 01040379
WRITE (I02,90015) IVTOTL 01050379
CBE** ********************** BBCHED0B **********************************01060379
C***** 01070379
PIVS = 3.1415926535897932384626434 01080379
C***** 01090379
CT001* TEST 1 LN(EXP(X)) = 1 01100379
IVTNUM = 1 01110379
BVS = 17.5 01120379
AVS = ALOG(EXP(1.75)) - BVS / 10.0 01130379
IF (AVS + 0.50000E-04) 20010, 10010, 40010 01140379
40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010 01150379
10010 IVPASS = IVPASS + 1 01160379
WRITE (NUVI, 80002) IVTNUM 01170379
GO TO 0011 01180379
20010 IVFAIL = IVFAIL + 1 01190379
RVCORR = 0.0000 01200379
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01210379
0011 CONTINUE 01220379
CT002* TEST 2 SIN**2 + COS**2 = 1 01230379
IVTNUM = 2 01240379
BVS = 10.0 / 4.0 01250379
CVS = SIN(BVS) ** 2 01260379
DVS = COS(BVS) ** 2 01270379
AVS = CVS + DVS - 1.0 01280379
IF (AVS + 0.50000E-04) 20020, 10020, 40020 01290379
40020 IF (AVS - 0.50000E-04) 10020, 10020, 20020 01300379
10020 IVPASS = IVPASS + 1 01310379
WRITE (NUVI, 80002) IVTNUM 01320379
GO TO 0021 01330379
20020 IVFAIL = IVFAIL + 1 01340379
RVCORR = 0.0000 01350379
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01360379
0021 CONTINUE 01370379
CT003* TEST 3 SIN(2X) = 2*SIN(X)*COS(X) 01380379
IVTNUM = 3 01390379
BVS = 8.5 01400379
CVS = BVS * (-0.5) 01410379
AVS = (SIN(-4.25) * COS(CVS)) * 2.0 - SIN(-8.5) 01420379
IF (AVS + 0.50000E-04) 20030, 10030, 40030 01430379
40030 IF (AVS - 0.50000E-04) 10030, 10030, 20030 01440379
10030 IVPASS = IVPASS + 1 01450379
WRITE (NUVI, 80002) IVTNUM 01460379
GO TO 0031 01470379
20030 IVFAIL = IVFAIL + 1 01480379
RVCORR = 0.0000 01490379
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01500379
0031 CONTINUE 01510379
CT004* TEST 4 ARCSIN(X) = ARCCOS(1-X**2) 01520379
IVTNUM = 4 01530379
AVS = ASIN(-0.875) + ACOS(SQRT(1.0 - (0.875) ** 2)) 01540379
IF (AVS + 0.50000E-04) 20040, 10040, 40040 01550379
40040 IF (AVS - 0.50000E-04) 10040, 10040, 20040 01560379
10040 IVPASS = IVPASS + 1 01570379
WRITE (NUVI, 80002) IVTNUM 01580379
GO TO 0041 01590379
20040 IVFAIL = IVFAIL + 1 01600379
RVCORR = 0.0000 01610379
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01620379
0041 CONTINUE 01630379
CT005* TEST 5 TAN(X)**2 - 1 = -COS(2X)/COS(X)**2 01640379
IVTNUM = 5 01650379
BVS = 7.0 01660379
AVS = COS(1.75) / COS(BVS / 8.0) ** 2 + TAN(0.875) ** 2 - 01670379
1 1 01680379
IF (AVS + 0.50000E-04) 20050, 10050, 40050 01690379
40050 IF (AVS - 0.50000E-04) 10050, 10050, 20050 01700379
10050 IVPASS = IVPASS + 1 01710379
WRITE (NUVI, 80002) IVTNUM 01720379
GO TO 0051 01730379
20050 IVFAIL = IVFAIL + 1 01740379
RVCORR = 0.0000 01750379
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01760379
0051 CONTINUE 01770379
CT006* TEST 6 ATAN(X/Y) = ATAN2(X,Y), Y > 0 01780379
IVTNUM = 6 01790379
BVS = 12.0 01800379
CVS = ATAN2(BVS / 4.0, BVS / 3.0) 01810379
AVS = CVS - ATAN(0.75) 01820379
IF (AVS + 0.50000E-04) 20060, 10060, 40060 01830379
40060 IF (AVS - 0.50000E-04) 10060, 10060, 20060 01840379
10060 IVPASS = IVPASS + 1 01850379
WRITE (NUVI, 80002) IVTNUM 01860379
GO TO 0061 01870379
20060 IVFAIL = IVFAIL + 1 01880379
RVCORR = 0.0000 01890379
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01900379
0061 CONTINUE 01910379
CT007* TEST 7 SQRT(X)**2 = X 01920379
IVTNUM = 7 01930379
AVS = SQRT(9.125) ** 2 - 9.125 01940379
IF (AVS + 0.50000E-04) 20070, 10070, 40070 01950379
40070 IF (AVS - 0.50000E-04) 10070, 10070, 20070 01960379
10070 IVPASS = IVPASS + 1 01970379
WRITE (NUVI, 80002) IVTNUM 01980379
GO TO 0071 01990379
20070 IVFAIL = IVFAIL + 1 02000379
RVCORR = 0.0000 02010379
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02020379
0071 CONTINUE 02030379
CT008* TEST 8 LN(X) = LN(10) * LOG10(X) 02040379
IVTNUM = 8 02050379
BVS = 62.5 / 1000.0 02060379
AVS = ALOG10(BVS) * ALOG(10.0) - ALOG(0.0625) 02070379
IF (AVS + 0.50000E-04) 20080, 10080, 40080 02080379
40080 IF (AVS - 0.50000E-04) 10080, 10080, 20080 02090379
10080 IVPASS = IVPASS + 1 02100379
WRITE (NUVI, 80002) IVTNUM 02110379
GO TO 0081 02120379
20080 IVFAIL = IVFAIL + 1 02130379
RVCORR = 0.0000 02140379
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02150379
0081 CONTINUE 02160379
CT009* TEST 9 COSH**2 - SINH**2 = 1 02170379
IVTNUM = 9 02180379
BVS = 0.125 02190379
CVS = SINH(2.125) 02200379
DVS = COSH(2.0 + BVS) 02210379
AVS = DVS ** 2 - CVS ** 2 - COSH(0.0) 02220379
IF (AVS + 0.50000E-04) 20090, 10090, 40090 02230379
40090 IF (AVS - 0.50000E-04) 10090, 10090, 20090 02240379
10090 IVPASS = IVPASS + 1 02250379
WRITE (NUVI, 80002) IVTNUM 02260379
GO TO 0091 02270379
20090 IVFAIL = IVFAIL + 1 02280379
RVCORR = 0.0000 02290379
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02300379
0091 CONTINUE 02310379
CT010* TEST 10 TANH(X) = 1 - 2/(EXP(2X)+1) 02320379
IVTNUM = 10 02330379
BVS = 5.0 02340379
CVS = 2.0 02350379
DVS = ALOG10(BVS * CVS) - SQRT(4.0) / 02360379
1 (EXP(2.0 * (BVS - CVS)) + COS(0.0)) 02370379
AVS = DVS - TANH(3.0) 02380379
IF (AVS + 0.50000E-04) 20100, 10100, 40100 02390379
40100 IF (AVS - 0.50000E-04) 10100, 10100, 20100 02400379
10100 IVPASS = IVPASS + 1 02410379
WRITE (NUVI, 80002) IVTNUM 02420379
GO TO 0101 02430379
20100 IVFAIL = IVFAIL + 1 02440379
RVCORR = 0.0000 02450379
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02460379
0101 CONTINUE 02470379
C***** 02480379
CBB** ********************** BBCSUM0 **********************************02490379
C**** WRITE OUT TEST SUMMARY 02500379
C**** 02510379
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02520379
WRITE (I02, 90004) 02530379
WRITE (I02, 90014) 02540379
WRITE (I02, 90004) 02550379
WRITE (I02, 90020) IVPASS 02560379
WRITE (I02, 90022) IVFAIL 02570379
WRITE (I02, 90024) IVDELE 02580379
WRITE (I02, 90026) IVINSP 02590379
WRITE (I02, 90028) IVTOTN, IVTOTL 02600379
CBE** ********************** BBCSUM0 **********************************02610379
CBB** ********************** BBCFOOT0 **********************************02620379
C**** WRITE OUT REPORT FOOTINGS 02630379
C**** 02640379
WRITE (I02,90016) ZPROG, ZPROG 02650379
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02660379
WRITE (I02,90019) 02670379
CBE** ********************** BBCFOOT0 **********************************02680379
CBB** ********************** BBCFMT0A **********************************02690379
C**** FORMATS FOR TEST DETAIL LINES 02700379
C**** 02710379
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02720379
80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02730379
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02740379
80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02750379
80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02760379
1I6,/," ",15X,"CORRECT= " ,I6) 02770379
80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02780379
1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02790379
80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02800379
1A21,/," ",16X,"CORRECT= " ,A21) 02810379
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02820379
80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02830379
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02840379
80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02850379
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02860379
80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02870379
80050 FORMAT (" ",48X,A31) 02880379
CBE** ********************** BBCFMT0A **********************************02890379
CBB** ********************** BBCFMT0B **********************************02900379
C**** FORMAT STATEMENTS FOR PAGE HEADERS 02910379
C**** 02920379
90002 FORMAT ("1") 02930379
90004 FORMAT (" ") 02940379
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02950379
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02960379
90008 FORMAT (" ",21X,A13,A17) 02970379
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02980379
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02990379
90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03000379
1 7X,"REMARKS",24X) 03010379
90014 FORMAT (" ","----------------------------------------------" , 03020379
1 "---------------------------------" ) 03030379
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03040379
C**** 03050379
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03060379
C**** 03070379
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03080379
90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03090379
1 A13) 03100379
90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03110379
C**** 03120379
C**** FORMAT STATEMENTS FOR RUN SUMMARY 03130379
C**** 03140379
90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03150379
90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03160379
90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03170379
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03180379
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03190379
CBE** ********************** BBCFMT0B **********************************03200379
C***** 03210379
C***** END OF TEST SEGMENT 201 03220379
STOP 03230379
END 03240379
03250379