| 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 |