blob: a882782b34a5865eaf4efae3ef93cb008aaae86e [file] [log] [blame]
PROGRAM FM831
C***********************************************************************00010831
C***** FORTRAN 77 00020831
C***** FM831 00030831
C***** YGEN3 - (208) 00040831
C***** 00050831
C***********************************************************************00060831
C***** GENERAL PURPOSE ANS REF 00070831
C***** TEST GENERIC FUNCTIONS 15.3 00080831
C***** ABS, MOD, SIGN, SIN, COS, TAN, SINH, COSH, TANH TABLE 5 00090831
C***** 00100831
CBB** ********************** BBCCOMNT **********************************00110831
C**** 00120831
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130831
C**** VERSION 2.1 00140831
C**** 00150831
C**** 00160831
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170831
C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180831
C**** SOFTWARE STANDARDS VALIDATION GROUP 00190831
C**** BUILDING 225 RM A266 00200831
C**** GAITHERSBURG, MD 20899 00210831
C**** 00220831
C**** 00230831
C**** 00240831
CBE** ********************** BBCCOMNT **********************************00250831
C***** 00260831
C***** S P E C I F I C A T I O N S SEGMENT 208 00270831
DOUBLE PRECISION AVD, CVD, DVD, DVCORR 00280831
COMPLEX AVC, CVC, ZVCORR 00290831
REAL R2E(2) 00300831
EQUIVALENCE (AVC, R2E) 00310831
C***** 00320831
CBB** ********************** BBCINITA **********************************00330831
C**** SPECIFICATION STATEMENTS 00340831
C**** 00350831
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00360831
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00370831
CBE** ********************** BBCINITA **********************************00380831
CBB** ********************** BBCINITB **********************************00390831
C**** INITIALIZE SECTION 00400831
DATA ZVERS, ZVERSD, ZDATE 00410831
1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00420831
DATA ZCOMPL, ZNAME, ZTAPE 00430831
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00440831
DATA ZPROJ, ZTAPED, ZPROG 00450831
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00460831
DATA REMRKS /' '/ 00470831
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00480831
C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00490831
C**** 00500831
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00510831
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00520831
CZ03 ZPROG = 'PROGRAM NAME' 00530831
CZ04 ZDATE = 'DATE OF TEST' 00540831
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00550831
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00560831
CZ07 ZNAME = 'NAME OF USER' 00570831
CZ08 ZTAPE = 'TAPE OWNER/ID' 00580831
CZ09 ZTAPED = 'DATE TAPE COPIED' 00590831
C 00600831
IVPASS = 0 00610831
IVFAIL = 0 00620831
IVDELE = 0 00630831
IVINSP = 0 00640831
IVTOTL = 0 00650831
IVTOTN = 0 00660831
ICZERO = 0 00670831
C 00680831
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00690831
I01 = 05 00700831
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00710831
I02 = 06 00720831
C 00730831
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00740831
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750831
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00760831
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00770831
C 00780831
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00790831
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00800831
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00810831
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00820831
C 00830831
CBE** ********************** BBCINITB **********************************00840831
NUVI = I02 00850831
IVTOTL = 12 00860831
ZPROG = 'FM831' 00870831
CBB** ********************** BBCHED0A **********************************00880831
C**** 00890831
C**** WRITE REPORT TITLE 00900831
C**** 00910831
WRITE (I02, 90002) 00920831
WRITE (I02, 90006) 00930831
WRITE (I02, 90007) 00940831
WRITE (I02, 90008) ZVERS, ZVERSD 00950831
WRITE (I02, 90009) ZPROG, ZPROG 00960831
WRITE (I02, 90010) ZDATE, ZCOMPL 00970831
CBE** ********************** BBCHED0A **********************************00980831
C***** 00990831
C***** HEADER FOR SEGMENT 208 01000831
WRITE(NUVI,20800) 01010831
20800 FORMAT( " ", / " YGEN3 - (208) GENERIC FUNCTIONS --" // 01020831
1 " ABS, MOD, SIGN, SIN, COS, TAN, SINH, COSH, TANH" // 01030831
2 " ANS REF. - 15.3" ) 01040831
CBB** ********************** BBCHED0B **********************************01050831
C**** WRITE DETAIL REPORT HEADERS 01060831
C**** 01070831
WRITE (I02,90004) 01080831
WRITE (I02,90004) 01090831
WRITE (I02,90013) 01100831
WRITE (I02,90014) 01110831
WRITE (I02,90015) IVTOTL 01120831
CBE** ********************** BBCHED0B **********************************01130831
C***** 01140831
CT001* TEST 1 TEST OF ABS AND SIGN WITH INTEGERS 01150831
IVTNUM = 1 01160831
LVI = ABS(-25) - SIGN(2, -15) 01170831
IF (LVI - 27) 20010, 10010, 20010 01180831
10010 IVPASS = IVPASS + 1 01190831
WRITE (NUVI, 80002) IVTNUM 01200831
GO TO 0011 01210831
20010 IVFAIL = IVFAIL + 1 01220831
IVCORR = 27 01230831
WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01240831
0011 CONTINUE 01250831
CT002* TEST 2 TEST OF MOD, SIGN AND ABS WITH REALS 01260831
IVTNUM = 2 01270831
AVS = MOD(24.5, 2.5) + SIGN(-1.50, -5.125) - ABS(-63.5) 01280831
IF (AVS + 0.63004E+02) 20020, 10020, 40020 01290831
40020 IF (AVS + 0.62996E+02) 10020, 10020, 20020 01300831
10020 IVPASS = IVPASS + 1 01310831
WRITE (NUVI, 80002) IVTNUM 01320831
GO TO 0021 01330831
20020 IVFAIL = IVFAIL + 1 01340831
RVCORR = -63.0 01350831
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01360831
0021 CONTINUE 01370831
CT003* TEST 3 TEST OF SIN AND COS WITH DOUBLE PREC 01380831
IVTNUM = 3 01390831
CVD = 1.125D0 01400831
AVD = (SIN(CVD)) ** 2 + (COS(CVD)) ** 2 01410831
IF (AVD - 0.9999999995D+00) 20030, 10030, 40030 01420831
40030 IF (AVD - 0.1000000001D+01) 10030, 10030, 20030 01430831
10030 IVPASS = IVPASS + 1 01440831
WRITE (NUVI, 80002) IVTNUM 01450831
GO TO 0031 01460831
20030 IVFAIL = IVFAIL + 1 01470831
DVCORR = 1.0D0 01480831
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01490831
0031 CONTINUE 01500831
CT004* TEST 4 TEST OF TAN AND MOD WITH DOUBLE PREC 01510831
IVTNUM = 4 01520831
AVD = TAN(3.5D0) * MOD(32.5D0, 5.0D0) 01530831
IF (AVD - 0.9364640999D+00) 20040, 10040, 40040 01540831
40040 IF (AVD - 0.9364641009D+00) 10040, 10040, 20040 01550831
10040 IVPASS = IVPASS + 1 01560831
WRITE (NUVI, 80002) IVTNUM 01570831
GO TO 0041 01580831
20040 IVFAIL = IVFAIL + 1 01590831
DVCORR = 0.9364641003965D0 01600831
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01610831
0041 CONTINUE 01620831
CT005* TEST 5 TEST OF SINH AND COSH WITH DOUBLE PREC 01630831
IVTNUM = 5 01640831
CVD = 3.25D0 01650831
AVD = (SINH(CVD)) ** 2 - (COSH(CVD)) ** 2 01660831
IF (AVD + 0.1000000001D+01) 20050, 10050, 40050 01670831
40050 IF (AVD + 0.9999999995D+00) 10050, 10050, 20050 01680831
10050 IVPASS = IVPASS + 1 01690831
WRITE (NUVI, 80002) IVTNUM 01700831
GO TO 0051 01710831
20050 IVFAIL = IVFAIL + 1 01720831
DVCORR = -1.0D0 01730831
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01740831
0051 CONTINUE 01750831
CT006* TEST 6 TEST OF TANH WITH DOUBLE PREC 01760831
IVTNUM = 6 01770831
AVD = TANH(0.5D0) * TANH(0.75D0) 01780831
IF (AVD - 0.2935132281D+00) 20060, 10060, 40060 01790831
40060 IF (AVD - 0.2935132285D+00) 10060, 10060, 20060 01800831
10060 IVPASS = IVPASS + 1 01810831
WRITE (NUVI, 80002) IVTNUM 01820831
GO TO 0061 01830831
20060 IVFAIL = IVFAIL + 1 01840831
DVCORR = 0.29351322831389D0 01850831
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01860831
0061 CONTINUE 01870831
CT007* TEST 7 TEST OF ABS AND SIN WITH DOUBLE PREC 01880831
IVTNUM = 7 01890831
AVD = ABS(4.57812500D0) * SIN(1.125D0) 01900831
IF (AVD - 0.4130693827D+01) 20070, 10070, 40070 01910831
40070 IF (AVD - 0.4130693832D+01) 10070, 10070, 20070 01920831
10070 IVPASS = IVPASS + 1 01930831
WRITE (NUVI, 80002) IVTNUM 01940831
GO TO 0071 01950831
20070 IVFAIL = IVFAIL + 1 01960831
DVCORR = 4.130693829235D0 01970831
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01980831
0071 CONTINUE 01990831
CT008* TEST 8 TEST OF ABS, MOD AND SIGN 02000831
C***** WITH INTEGER, REAL AND DOUBLE PREC 02010831
IVTNUM = 8 02020831
LVI = -25 02030831
AVS = 32.750 02040831
BVS = 1.375 02050831
CVD = 0.75D0 02060831
DVD = 1.125D0 02070831
AVD = ABS(LVI) - (MOD(AVS, BVS) * SIGN(CVD, DVD)) 02080831
IF (AVD - 0.2415624998D+02) 20080, 10080, 40080 02090831
40080 IF (AVD - 0.2415625002D+02) 10080, 10080, 20080 02100831
10080 IVPASS = IVPASS + 1 02110831
WRITE (NUVI, 80002) IVTNUM 02120831
GO TO 0081 02130831
20080 IVFAIL = IVFAIL + 1 02140831
DVCORR = 24.15625D0 02150831
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02160831
0081 CONTINUE 02170831
CT009* TEST 9 TEST OF ABS WITH COMPLEX 02180831
IVTNUM = 9 02190831
AVS = ABS((-2.125, 5.0)) 02200831
IF (AVS - 0.54325E+01) 20090, 10090, 40090 02210831
40090 IF (AVS - 0.54331E+01) 10090, 10090, 20090 02220831
10090 IVPASS = IVPASS + 1 02230831
WRITE (NUVI, 80002) IVTNUM 02240831
GO TO 0091 02250831
20090 IVFAIL = IVFAIL + 1 02260831
RVCORR = 5.4328279 02270831
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02280831
0091 CONTINUE 02290831
CT010* TEST 10 TEST OF SIN AND COS WITH COMPLEX 02300831
IVTNUM = 10 02310831
AVC = SIN((2.5, 3.5)) * COS((-4.75, 1.25)) 02320831
IF (R2E(1) + 0.20512E+02) 20100, 40102, 40101 02330831
40101 IF (R2E(1) + 0.20510E+02) 40102, 40102, 20100 02340831
40102 IF (R2E(2) + 0.16820E+02) 20100, 10100, 40100 02350831
40100 IF (R2E(2) + 0.16817E+02) 10100, 10100, 20100 02360831
10100 IVPASS = IVPASS + 1 02370831
WRITE (NUVI, 80002) IVTNUM 02380831
GO TO 0101 02390831
20100 IVFAIL = IVFAIL + 1 02400831
ZVCORR = (-20.5109598, -16.8182771) 02410831
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02420831
0101 CONTINUE 02430831
CT011* TEST 11 TEST OF SIN, COS AND TAN 02440831
C***** WITH REAL AND COMPLEX 02450831
IVTNUM = 11 02460831
AVS = 2.0 02470831
CVC = (3.125, 1.5) 02480831
BVS = 3.5 02490831
AVC = SIN(AVS) + COS(CVC) + TAN(BVS) 02500831
IF (R2E(1) + 0.10683E+01) 20110, 40112, 40111 02510831
40111 IF (R2E(1) + 0.10681E+01) 40112, 40112, 20110 02520831
40112 IF (R2E(2) + 0.35331E-01) 20110, 10110, 40110 02530831
40110 IF (R2E(2) + 0.35327E-01) 10110, 10110, 20110 02540831
10110 IVPASS = IVPASS + 1 02550831
WRITE (NUVI, 80002) IVTNUM 02560831
GO TO 0111 02570831
20110 IVFAIL = IVFAIL + 1 02580831
ZVCORR = (-1.068203, -0.0353288) 02590831
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02600831
0111 CONTINUE 02610831
CT012* TEST 12 TEST OF ABS, MOD, SIN AND COS 02620831
C***** WITH INTEGER, REAL AND COMPLEX 02630831
IVTNUM = 12 02640831
AVC = ABS(-2) * MOD(17.250, 3.125) + SIN(3.125) - 02650831
1 COS((-0.375, 1.625)) 02660831
IF (R2E(1) - 0.81218E+00) 20120, 40122, 40121 02670831
40121 IF (R2E(1) - 0.81227E+00) 40122, 40122, 20120 02680831
40122 IF (R2E(2) + 0.89403E+00) 20120, 10120, 40120 02690831
40120 IF (R2E(2) + 0.89393E+00) 10120, 10120, 20120 02700831
10120 IVPASS = IVPASS + 1 02710831
WRITE (NUVI, 80002) IVTNUM 02720831
GO TO 0121 02730831
20120 IVFAIL = IVFAIL + 1 02740831
ZVCORR = (0.8122242, -0.893981) 02750831
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02760831
0121 CONTINUE 02770831
C***** 02780831
CBB** ********************** BBCSUM0 **********************************02790831
C**** WRITE OUT TEST SUMMARY 02800831
C**** 02810831
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02820831
WRITE (I02, 90004) 02830831
WRITE (I02, 90014) 02840831
WRITE (I02, 90004) 02850831
WRITE (I02, 90020) IVPASS 02860831
WRITE (I02, 90022) IVFAIL 02870831
WRITE (I02, 90024) IVDELE 02880831
WRITE (I02, 90026) IVINSP 02890831
WRITE (I02, 90028) IVTOTN, IVTOTL 02900831
CBE** ********************** BBCSUM0 **********************************02910831
CBB** ********************** BBCFOOT0 **********************************02920831
C**** WRITE OUT REPORT FOOTINGS 02930831
C**** 02940831
WRITE (I02,90016) ZPROG, ZPROG 02950831
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02960831
WRITE (I02,90019) 02970831
CBE** ********************** BBCFOOT0 **********************************02980831
CBB** ********************** BBCFMT0A **********************************02990831
C**** FORMATS FOR TEST DETAIL LINES 03000831
C**** 03010831
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03020831
80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03030831
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03040831
80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03050831
80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03060831
1I6,/," ",15X,"CORRECT= " ,I6) 03070831
80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03080831
1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03090831
80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03100831
1A21,/," ",16X,"CORRECT= " ,A21) 03110831
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03120831
80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03130831
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03140831
80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03150831
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03160831
80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03170831
80050 FORMAT (" ",48X,A31) 03180831
CBE** ********************** BBCFMT0A **********************************03190831
CBB** ********************** BBCFMAT1 **********************************03200831
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03210831
C**** 03220831
80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03230831
1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03240831
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03250831
80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03260831
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03270831
80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03280831
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03290831
80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03300831
80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03310831
1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03320831
2"(",F12.5,", ",F12.5,")") 03330831
CBE** ********************** BBCFMAT1 **********************************03340831
CBB** ********************** BBCFMT0B **********************************03350831
C**** FORMAT STATEMENTS FOR PAGE HEADERS 03360831
C**** 03370831
90002 FORMAT ("1") 03380831
90004 FORMAT (" ") 03390831
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03400831
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03410831
90008 FORMAT (" ",21X,A13,A17) 03420831
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03430831
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03440831
90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03450831
1 7X,"REMARKS",24X) 03460831
90014 FORMAT (" ","----------------------------------------------" , 03470831
1 "---------------------------------" ) 03480831
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03490831
C**** 03500831
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03510831
C**** 03520831
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03530831
90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03540831
1 A13) 03550831
90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03560831
C**** 03570831
C**** FORMAT STATEMENTS FOR RUN SUMMARY 03580831
C**** 03590831
90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03600831
90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03610831
90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03620831
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03630831
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03640831
CBE** ********************** BBCFMT0B **********************************03650831
C***** 03660831
C***** END OF TEST SEGMENT 208 03670831
STOP 03680831
END 03690831