blob: 2968725ea3e268fde145835cb61c49b1e71c6610 [file] [log] [blame]
PROGRAM FM830
C***********************************************************************00010830
C***** FORTRAN 77 00020830
C***** FM830 00030830
C***** YGEN2 - (207) 00040830
C***** 00050830
C***********************************************************************00060830
C***** GENERAL PURPOSE ANS REF 00070830
C***** TEST GENERIC FUNCTIONS 15.3 00080830
C***** AINT, ANINT, NINT, SQRT, EXP, LOG, LOG10 TABLE 5 00090830
C***** 00100830
CBB** ********************** BBCCOMNT **********************************00110830
C**** 00120830
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130830
C**** VERSION 2.1 00140830
C**** 00150830
C**** 00160830
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170830
C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180830
C**** SOFTWARE STANDARDS VALIDATION GROUP 00190830
C**** BUILDING 225 RM A266 00200830
C**** GAITHERSBURG, MD 20899 00210830
C**** 00220830
C**** 00230830
C**** 00240830
CBE** ********************** BBCCOMNT **********************************00250830
C***** 00260830
C***** S P E C I F I C A T I O N S SEGMENT 207 00270830
DOUBLE PRECISION AVD, DVCORR 00280830
COMPLEX AVC, ZVCORR 00290830
REAL R2E(2) 00300830
EQUIVALENCE (AVC, R2E) 00310830
C***** 00320830
CBB** ********************** BBCINITA **********************************00330830
C**** SPECIFICATION STATEMENTS 00340830
C**** 00350830
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00360830
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00370830
CBE** ********************** BBCINITA **********************************00380830
CBB** ********************** BBCINITB **********************************00390830
C**** INITIALIZE SECTION 00400830
DATA ZVERS, ZVERSD, ZDATE 00410830
1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00420830
DATA ZCOMPL, ZNAME, ZTAPE 00430830
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00440830
DATA ZPROJ, ZTAPED, ZPROG 00450830
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00460830
DATA REMRKS /' '/ 00470830
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00480830
C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00490830
C**** 00500830
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00510830
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00520830
CZ03 ZPROG = 'PROGRAM NAME' 00530830
CZ04 ZDATE = 'DATE OF TEST' 00540830
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00550830
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00560830
CZ07 ZNAME = 'NAME OF USER' 00570830
CZ08 ZTAPE = 'TAPE OWNER/ID' 00580830
CZ09 ZTAPED = 'DATE TAPE COPIED' 00590830
C 00600830
IVPASS = 0 00610830
IVFAIL = 0 00620830
IVDELE = 0 00630830
IVINSP = 0 00640830
IVTOTL = 0 00650830
IVTOTN = 0 00660830
ICZERO = 0 00670830
C 00680830
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00690830
I01 = 05 00700830
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00710830
I02 = 06 00720830
C 00730830
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00740830
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750830
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00760830
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00770830
C 00780830
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00790830
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00800830
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00810830
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00820830
C 00830830
CBE** ********************** BBCINITB **********************************00840830
NUVI = I02 00850830
IVTOTL = 9 00860830
ZPROG = 'FM830' 00870830
CBB** ********************** BBCHED0A **********************************00880830
C**** 00890830
C**** WRITE REPORT TITLE 00900830
C**** 00910830
WRITE (I02, 90002) 00920830
WRITE (I02, 90006) 00930830
WRITE (I02, 90007) 00940830
WRITE (I02, 90008) ZVERS, ZVERSD 00950830
WRITE (I02, 90009) ZPROG, ZPROG 00960830
WRITE (I02, 90010) ZDATE, ZCOMPL 00970830
CBE** ********************** BBCHED0A **********************************00980830
C***** 00990830
C***** HEADER FOR SEGMENT 207 01000830
WRITE(NUVI,20700) 01010830
20700 FORMAT( " ", / " YGEN2 - (207) GENERIC FUNCTIONS --" // 01020830
1 " AINT, ANINT, NINT, SQRT, EXP, LOG, LOG10" // 01030830
2 " ANS REF. - 15.3" ) 01040830
CBB** ********************** BBCHED0B **********************************01050830
C**** WRITE DETAIL REPORT HEADERS 01060830
C**** 01070830
WRITE (I02,90004) 01080830
WRITE (I02,90004) 01090830
WRITE (I02,90013) 01100830
WRITE (I02,90014) 01110830
WRITE (I02,90015) IVTOTL 01120830
CBE** ********************** BBCHED0B **********************************01130830
C***** 01140830
CT001* TEST 1 TEST OF NINT WITH DOUBLE PREC 01150830
IVTNUM = 1 01160830
LVI = NINT(27.96875D0) 01170830
IF (LVI - 28) 20010, 10010, 20010 01180830
10010 IVPASS = IVPASS + 1 01190830
WRITE (NUVI, 80002) IVTNUM 01200830
GO TO 0011 01210830
20010 IVFAIL = IVFAIL + 1 01220830
IVCORR = 28 01230830
WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01240830
0011 CONTINUE 01250830
CT002* TEST 2 TEST OF AINT AND ANINT WITH DOUBLE PREC 01260830
IVTNUM = 2 01270830
AVD = AINT(-1.375D0) + ANINT(-27.96875D0) 01280830
IF (AVD + 0.2900000002D+02) 20020, 10020, 40020 01290830
40020 IF (AVD + 0.2899999998D+02) 10020, 10020, 20020 01300830
10020 IVPASS = IVPASS + 1 01310830
WRITE (NUVI, 80002) IVTNUM 01320830
GO TO 0021 01330830
20020 IVFAIL = IVFAIL + 1 01340830
DVCORR = -29.0D0 01350830
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01360830
0021 CONTINUE 01370830
CT003* TEST 3 TEST OF SQRT AND EXP WITH DOUBLE PREC 01380830
IVTNUM = 3 01390830
AVD = SQRT(16.0D0) - EXP(5.125D0) 01400830
IF (AVD + 0.1641741418D+03) 20030, 10030, 40030 01410830
40030 IF (AVD + 0.1641741415D+03) 10030, 10030, 20030 01420830
10030 IVPASS = IVPASS + 1 01430830
WRITE (NUVI, 80002) IVTNUM 01440830
GO TO 0031 01450830
20030 IVFAIL = IVFAIL + 1 01460830
DVCORR = -0.16417414165D+03 01470830
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01480830
0031 CONTINUE 01490830
CT004* TEST 4 TEST OF LOG AND LOG10 WITH DOUBLE PREC 01500830
IVTNUM = 4 01510830
AVD = LOG(9.5D0) * LOG10(25.25D0) 01520830
IF (AVD - 0.3156899548D+01) 20040, 10040, 40040 01530830
40040 IF (AVD - 0.3156899552D+01) 10040, 10040, 20040 01540830
10040 IVPASS = IVPASS + 1 01550830
WRITE (NUVI, 80002) IVTNUM 01560830
GO TO 0041 01570830
20040 IVFAIL = IVFAIL + 1 01580830
DVCORR = 0.31568995498D+01 01590830
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01600830
0041 CONTINUE 01610830
CT005* TEST 5 TEST OF AINT, SQRT AND LOG10 01620830
IVTNUM = 5 01630830
AVD = (AINT(2.75D0) + SQRT(17.125D0)) * LOG10(10.0D0) 01640830
IF (AVD - 0.6138236337D+01) 20050, 10050, 40050 01650830
40050 IF (AVD - 0.6138236343D+01) 10050, 10050, 20050 01660830
10050 IVPASS = IVPASS + 1 01670830
WRITE (NUVI, 80002) IVTNUM 01680830
GO TO 0051 01690830
20050 IVFAIL = IVFAIL + 1 01700830
DVCORR = 0.613823634D+01 01710830
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01720830
0051 CONTINUE 01730830
CT006* TEST 6 TEST OF AINT AND NINT WITH DOUBLE PREC 01740830
IVTNUM = 6 01750830
AVD = AINT(72.375D0) * NINT(-4.25D0) 01760830
IF (AVD + 0.2880000002D+03) 20060, 10060, 40060 01770830
40060 IF (AVD + 0.2879999998D+03) 10060, 10060, 20060 01780830
10060 IVPASS = IVPASS + 1 01790830
WRITE (NUVI, 80002) IVTNUM 01800830
GO TO 0061 01810830
20060 IVFAIL = IVFAIL + 1 01820830
DVCORR = -288.0D0 01830830
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01840830
0061 CONTINUE 01850830
CT007* TEST 7 TEST OF SQRT, EXP AND LOG WITH COMPLEX 01860830
IVTNUM = 7 01870830
AVC = SQRT((-4.0,2.0)) + EXP((2.125,6.75)) * LOG((17.375,2.5)) 01880830
IF (R2E(1) - 0.21370E+02) 20070, 40072, 40071 01890830
40071 IF (R2E(1) - 0.21373E+02) 40072, 40072, 20070 01900830
40072 IF (R2E(2) - 0.13922E+02) 20070, 10070, 40070 01910830
40070 IF (R2E(2) - 0.13925E+02) 10070, 10070, 20070 01920830
10070 IVPASS = IVPASS + 1 01930830
WRITE (NUVI, 80002) IVTNUM 01940830
GO TO 0071 01950830
20070 IVFAIL = IVFAIL + 1 01960830
ZVCORR = (21.3712104, 13.9235362) 01970830
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01980830
0071 CONTINUE 01990830
CT008* TEST 8 TEST OF SQRT WITH REAL AND COMPLEX 02000830
IVTNUM = 8 02010830
AVC = SQRT(77.76953) - SQRT((-22.125, 7.0)) 02020830
IF (R2E(1) - 0.80831E+01) 20080, 40082, 40081 02030830
40081 IF (R2E(1) - 0.80840E+01) 40082, 40082, 20080 02040830
40082 IF (R2E(2) + 0.47611E+01) 20080, 10080, 40080 02050830
40080 IF (R2E(2) + 0.47605E+01) 10080, 10080, 20080 02060830
10080 IVPASS = IVPASS + 1 02070830
WRITE (NUVI, 80002) IVTNUM 02080830
GO TO 0081 02090830
20080 IVFAIL = IVFAIL + 1 02100830
ZVCORR = (8.0835370, -4.7608266) 02110830
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02120830
0081 CONTINUE 02130830
CT009* TEST 9 TEST OF AINT, NINT, EXP AND LOG 02140830
C***** WITH REAL AND COMPLEX 02150830
IVTNUM = 9 02160830
AVC = AINT(2.25) * NINT(1.50) + EXP((1.0, 2.0)) - LOG(5.125) 02170830
IF (R2E(1) - 0.12346E+01) 20090, 40092, 40091 02180830
40091 IF (R2E(1) - 0.12348E+01) 40092, 40092, 20090 02190830
40092 IF (R2E(2) - 0.24716E+01) 20090, 10090, 40090 02200830
40090 IF (R2E(2) - 0.24719E+01) 10090, 10090, 20090 02210830
10090 IVPASS = IVPASS + 1 02220830
WRITE (NUVI, 80002) IVTNUM 02230830
GO TO 0091 02240830
20090 IVFAIL = IVFAIL + 1 02250830
ZVCORR = (1.234665192, 2.471726672) 02260830
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02270830
0091 CONTINUE 02280830
C***** 02290830
CBB** ********************** BBCSUM0 **********************************02300830
C**** WRITE OUT TEST SUMMARY 02310830
C**** 02320830
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02330830
WRITE (I02, 90004) 02340830
WRITE (I02, 90014) 02350830
WRITE (I02, 90004) 02360830
WRITE (I02, 90020) IVPASS 02370830
WRITE (I02, 90022) IVFAIL 02380830
WRITE (I02, 90024) IVDELE 02390830
WRITE (I02, 90026) IVINSP 02400830
WRITE (I02, 90028) IVTOTN, IVTOTL 02410830
CBE** ********************** BBCSUM0 **********************************02420830
CBB** ********************** BBCFOOT0 **********************************02430830
C**** WRITE OUT REPORT FOOTINGS 02440830
C**** 02450830
WRITE (I02,90016) ZPROG, ZPROG 02460830
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02470830
WRITE (I02,90019) 02480830
CBE** ********************** BBCFOOT0 **********************************02490830
CBB** ********************** BBCFMT0A **********************************02500830
C**** FORMATS FOR TEST DETAIL LINES 02510830
C**** 02520830
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02530830
80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02540830
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02550830
80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02560830
80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02570830
1I6,/," ",15X,"CORRECT= " ,I6) 02580830
80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02590830
1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02600830
80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02610830
1A21,/," ",16X,"CORRECT= " ,A21) 02620830
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02630830
80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02640830
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02650830
80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02660830
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02670830
80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02680830
80050 FORMAT (" ",48X,A31) 02690830
CBE** ********************** BBCFMT0A **********************************02700830
CBB** ********************** BBCFMAT1 **********************************02710830
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02720830
C**** 02730830
80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02740830
1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02750830
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02760830
80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02770830
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02780830
80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02790830
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02800830
80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02810830
80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02820830
1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02830830
2"(",F12.5,", ",F12.5,")") 02840830
CBE** ********************** BBCFMAT1 **********************************02850830
CBB** ********************** BBCFMT0B **********************************02860830
C**** FORMAT STATEMENTS FOR PAGE HEADERS 02870830
C**** 02880830
90002 FORMAT ("1") 02890830
90004 FORMAT (" ") 02900830
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02910830
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02920830
90008 FORMAT (" ",21X,A13,A17) 02930830
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02940830
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02950830
90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02960830
1 7X,"REMARKS",24X) 02970830
90014 FORMAT (" ","----------------------------------------------" , 02980830
1 "---------------------------------" ) 02990830
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03000830
C**** 03010830
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03020830
C**** 03030830
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03040830
90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03050830
1 A13) 03060830
90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03070830
C**** 03080830
C**** FORMAT STATEMENTS FOR RUN SUMMARY 03090830
C**** 03100830
90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03110830
90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03120830
90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03130830
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03140830
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03150830
CBE** ********************** BBCFMT0B **********************************03160830
C***** 03170830
C***** END OF TEST SEGMENT 207 03180830
STOP 03190830
END 03200830