| PROGRAM FM805 |
| |
| C***********************************************************************00010805 |
| C***** FORTRAN 77 00020805 |
| C***** FM805 YDDIM - (164) 00030805 |
| C***** 00040805 |
| C***********************************************************************00050805 |
| C***** GENERAL PURPOSE ANS REF 00060805 |
| C***** TEST INTRINSIC FUNCTION DDIM AND PROD--POSITIVE 15.3 00070805 |
| C***** DIFFERENCE AND DOUBLE PRECISION PRODUCT, RESP. (TABLE 5)00080805 |
| C***** 00090805 |
| CBB** ********************** BBCCOMNT **********************************00100805 |
| C**** 00110805 |
| C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120805 |
| C**** VERSION 2.1 00130805 |
| C**** 00140805 |
| C**** 00150805 |
| C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160805 |
| C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170805 |
| C**** SOFTWARE STANDARDS VALIDATION GROUP 00180805 |
| C**** BUILDING 225 RM A266 00190805 |
| C**** GAITHERSBURG, MD 20899 00200805 |
| C**** 00210805 |
| C**** 00220805 |
| C**** 00230805 |
| CBE** ********************** BBCCOMNT **********************************00240805 |
| C***** 00250805 |
| C***** S P E C I F I C A T I O N S SEGMENT 164 00260805 |
| DOUBLE PRECISION DSAVD, DSBVD, DSDVD, DSEVD, DVCORR 00270805 |
| C***** 00280805 |
| CBB** ********************** BBCINITA **********************************00290805 |
| C**** SPECIFICATION STATEMENTS 00300805 |
| C**** 00310805 |
| CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320805 |
| 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330805 |
| CBE** ********************** BBCINITA **********************************00340805 |
| CBB** ********************** BBCINITB **********************************00350805 |
| C**** INITIALIZE SECTION 00360805 |
| DATA ZVERS, ZVERSD, ZDATE 00370805 |
| 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380805 |
| DATA ZCOMPL, ZNAME, ZTAPE 00390805 |
| 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400805 |
| DATA ZPROJ, ZTAPED, ZPROG 00410805 |
| 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420805 |
| DATA REMRKS /' '/ 00430805 |
| C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440805 |
| C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450805 |
| C**** 00460805 |
| CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470805 |
| CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480805 |
| CZ03 ZPROG = 'PROGRAM NAME' 00490805 |
| CZ04 ZDATE = 'DATE OF TEST' 00500805 |
| CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510805 |
| CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520805 |
| CZ07 ZNAME = 'NAME OF USER' 00530805 |
| CZ08 ZTAPE = 'TAPE OWNER/ID' 00540805 |
| CZ09 ZTAPED = 'DATE TAPE COPIED' 00550805 |
| C 00560805 |
| IVPASS = 0 00570805 |
| IVFAIL = 0 00580805 |
| IVDELE = 0 00590805 |
| IVINSP = 0 00600805 |
| IVTOTL = 0 00610805 |
| IVTOTN = 0 00620805 |
| ICZERO = 0 00630805 |
| C 00640805 |
| C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650805 |
| I01 = 05 00660805 |
| C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670805 |
| I02 = 06 00680805 |
| C 00690805 |
| CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700805 |
| C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710805 |
| CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720805 |
| C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730805 |
| C 00740805 |
| CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750805 |
| C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760805 |
| CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770805 |
| C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780805 |
| C 00790805 |
| CBE** ********************** BBCINITB **********************************00800805 |
| NUVI = I02 00810805 |
| IVTOTL = 18 00820805 |
| ZPROG = 'FM805' 00830805 |
| CBB** ********************** BBCHED0A **********************************00840805 |
| C**** 00850805 |
| C**** WRITE REPORT TITLE 00860805 |
| C**** 00870805 |
| WRITE (I02, 90002) 00880805 |
| WRITE (I02, 90006) 00890805 |
| WRITE (I02, 90007) 00900805 |
| WRITE (I02, 90008) ZVERS, ZVERSD 00910805 |
| WRITE (I02, 90009) ZPROG, ZPROG 00920805 |
| WRITE (I02, 90010) ZDATE, ZCOMPL 00930805 |
| CBE** ********************** BBCHED0A **********************************00940805 |
| C***** 00950805 |
| C***** HEADER FOR SEGMENT 164 00960805 |
| WRITE (NUVI,16401) 00970805 |
| 16401 FORMAT (" ",// 1X,"YDDIM - (164) INTRINSIC FUNCTIONS-- " //16X, 00980805 |
| 1 "DDIM (POSITIVE DIFFERENCE)" /,16X, 00990805 |
| 2 "DPROD (D.P. PRODUCT)" // 01000805 |
| 3 2X,"ANS REF. - 15.3" ) 01010805 |
| CBB** ********************** BBCHED0B **********************************01020805 |
| C**** WRITE DETAIL REPORT HEADERS 01030805 |
| C**** 01040805 |
| WRITE (I02,90004) 01050805 |
| WRITE (I02,90004) 01060805 |
| WRITE (I02,90013) 01070805 |
| WRITE (I02,90014) 01080805 |
| WRITE (I02,90015) IVTOTL 01090805 |
| CBE** ********************** BBCHED0B **********************************01100805 |
| C***** 01110805 |
| C***** TEST OF DDIM 01120805 |
| C***** 01130805 |
| WRITE(NUVI, 16402) 01140805 |
| 16402 FORMAT(/ 8X, "TEST OF DDIM" ) 01150805 |
| CT001* TEST 1 BOTH VALUES EQUAL 01160805 |
| IVTNUM = 1 01170805 |
| DSBVD = 0.25D0 01180805 |
| DSDVD = 0.25D0 01190805 |
| DSAVD = DDIM(DSBVD, DSDVD) 01200805 |
| IF (DSAVD + 5.0D-10) 20010, 10010, 40010 01210805 |
| 40010 IF (DSAVD - 5.0D-10) 10010, 10010, 20010 01220805 |
| 10010 IVPASS = IVPASS + 1 01230805 |
| WRITE (NUVI, 80002) IVTNUM 01240805 |
| GO TO 0011 01250805 |
| 20010 IVFAIL = IVFAIL + 1 01260805 |
| DVCORR = 0.0D0 01270805 |
| WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01280805 |
| 0011 CONTINUE 01290805 |
| CT002* TEST 2 BOTH VALUES EQUAL, INTEGRAL VALUES 01300805 |
| IVTNUM = 2 01310805 |
| DSBVD = 2.0D0 01320805 |
| DSDVD = 2.0D0 01330805 |
| DSAVD = DDIM(DSBVD, DSDVD) 01340805 |
| IF (DSAVD + 5.0D-10) 20020, 10020, 40020 01350805 |
| 40020 IF (DSAVD - 5.0D-10) 10020, 10020, 20020 01360805 |
| 10020 IVPASS = IVPASS + 1 01370805 |
| WRITE (NUVI, 80002) IVTNUM 01380805 |
| GO TO 0021 01390805 |
| 20020 IVFAIL = IVFAIL + 1 01400805 |
| DVCORR = 0.0D0 01410805 |
| WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01420805 |
| 0021 CONTINUE 01430805 |
| CT003* TEST 3 FIRST VALUE LESS THAN SECOND 01440805 |
| IVTNUM = 3 01450805 |
| DSBVD = 0.25D1 01460805 |
| DSDVD = 0.55D1 01470805 |
| DSAVD = DDIM(DSBVD, DSDVD) 01480805 |
| IF (DSAVD + 5.0D-10) 20030, 10030, 40030 01490805 |
| 40030 IF (DSAVD - 5.0D-10) 10030, 10030, 20030 01500805 |
| 10030 IVPASS = IVPASS + 1 01510805 |
| WRITE (NUVI, 80002) IVTNUM 01520805 |
| GO TO 0031 01530805 |
| 20030 IVFAIL = IVFAIL + 1 01540805 |
| DVCORR = 0.0D0 01550805 |
| WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01560805 |
| 0031 CONTINUE 01570805 |
| CT004* TEST 4 FIRST VALUE GREATER THAN SECOND 01580805 |
| IVTNUM = 4 01590805 |
| DSBVD = 0.55D1 01600805 |
| DSDVD = 0.25D1 01610805 |
| DSAVD = DDIM(DSBVD, DSDVD) 01620805 |
| IF (DSAVD - 2.999999998D0) 20040, 10040, 40040 01630805 |
| 40040 IF (DSAVD - 3.000000002D0) 10040, 10040, 20040 01640805 |
| 10040 IVPASS = IVPASS + 1 01650805 |
| WRITE (NUVI, 80002) IVTNUM 01660805 |
| GO TO 0041 01670805 |
| 20040 IVFAIL = IVFAIL + 1 01680805 |
| DVCORR = 3.0D0 01690805 |
| WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01700805 |
| 0041 CONTINUE 01710805 |
| CT005* TEST 5 BOTH VALUES EQUAL, BOTH NEGATIVE 01720805 |
| IVTNUM = 5 01730805 |
| DSBVD = -0.25D1 01740805 |
| DSDVD = -0.25D1 01750805 |
| DSAVD = DDIM(DSBVD, DSDVD) 01760805 |
| IF (DSAVD + 5.0D-10) 20050, 10050, 40050 01770805 |
| 40050 IF (DSAVD - 5.0D-10) 10050, 10050, 20050 01780805 |
| 10050 IVPASS = IVPASS + 1 01790805 |
| WRITE (NUVI, 80002) IVTNUM 01800805 |
| GO TO 0051 01810805 |
| 20050 IVFAIL = IVFAIL + 1 01820805 |
| DVCORR = 0.0D0 01830805 |
| WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01840805 |
| 0051 CONTINUE 01850805 |
| CT006* TEST 6 FIRST VALUE GREATER THAN SECOND, BOTH NEGATIVE 01860805 |
| IVTNUM = 6 01870805 |
| DSBVD = -0.25D1 01880805 |
| DSDVD = -0.55D1 01890805 |
| DSAVD = DDIM(DSBVD, DSDVD) 01900805 |
| IF (DSAVD - 2.999999998D0) 20060, 10060, 40060 01910805 |
| 40060 IF (DSAVD - 3.000000002D0) 10060, 10060, 20060 01920805 |
| 10060 IVPASS = IVPASS + 1 01930805 |
| WRITE (NUVI, 80002) IVTNUM 01940805 |
| GO TO 0061 01950805 |
| 20060 IVFAIL = IVFAIL + 1 01960805 |
| DVCORR = 3.0D0 01970805 |
| WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01980805 |
| 0061 CONTINUE 01990805 |
| CT007* TEST 7 FIRST VALUE POSITIVE, SECOND NEGATIVE 02000805 |
| IVTNUM = 7 02010805 |
| DSBVD = 0.55D1 02020805 |
| DSDVD = -0.25D1 02030805 |
| DSAVD = DDIM(DSBVD, DSDVD) 02040805 |
| IF (DSAVD - 7.999999996D0) 20070, 10070, 40070 02050805 |
| 40070 IF (DSAVD - 8.000000004D0) 10070, 10070, 20070 02060805 |
| 10070 IVPASS = IVPASS + 1 02070805 |
| WRITE (NUVI, 80002) IVTNUM 02080805 |
| GO TO 0071 02090805 |
| 20070 IVFAIL = IVFAIL + 1 02100805 |
| DVCORR = 8.0D0 02110805 |
| WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 02120805 |
| 0071 CONTINUE 02130805 |
| CT008* TEST 8 ARITHMETIC EXPRESSION PRESENTED TO DDIM 02140805 |
| IVTNUM = 8 02150805 |
| DSDVD = 0.25D1 02160805 |
| DSEVD = 0.125D1 02170805 |
| DSAVD = DDIM(DSDVD / DSEVD, DSDVD * DSEVD) 02180805 |
| IF (DSAVD + 5.0D-10) 20080, 10080, 40080 02190805 |
| 40080 IF (DSAVD - 5.0D-10) 10080, 10080, 20080 02200805 |
| 10080 IVPASS = IVPASS + 1 02210805 |
| WRITE (NUVI, 80002) IVTNUM 02220805 |
| GO TO 0081 02230805 |
| 20080 IVFAIL = IVFAIL + 1 02240805 |
| DVCORR = 0.0D0 02250805 |
| WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 02260805 |
| 0081 CONTINUE 02270805 |
| C***** 02280805 |
| C***** TEST OF DPROD 02290805 |
| C***** 02300805 |
| WRITE(NUVI, 16404) 02310805 |
| REMRKS = '+ OR - 0.00005' 02320805 |
| 16404 FORMAT(// 8X, "TEST OF DPROD" ) 02330805 |
| CT009* TEST 9 PAIR OF VALUES, ONE OF WHICH IS ZERO 02340805 |
| IVTNUM = 9 02350805 |
| RSAVS = 0.0 02360805 |
| RSBVS = 2.0 02370805 |
| DSAVD = DPROD(RSAVS, RSBVS) 02380805 |
| IF (DSAVD + 5.0D-5) 20090, 10090, 40090 02390805 |
| 40090 IF (DSAVD - 5.0D-5) 10090, 10090, 20090 02400805 |
| 10090 IVPASS = IVPASS + 1 02410805 |
| WRITE (NUVI, 80002) IVTNUM 02420805 |
| GO TO 0091 02430805 |
| 20090 IVFAIL = IVFAIL + 1 02440805 |
| DVCORR = 0.0D0 02450805 |
| WRITE (NUVI, 80008) IVTNUM 02460805 |
| WRITE (NUVI, 80033) DSAVD 02470805 |
| WRITE (NUVI, 80035) DVCORR, REMRKS 02480805 |
| 0091 CONTINUE 02490805 |
| CT010* TEST 10 PAIR OF VALUES, ONE OF WHICH IS ONE 02500805 |
| IVTNUM = 10 02510805 |
| RSAVS = 1.0 02520805 |
| RSBVS = 2.0 02530805 |
| DSAVD = DPROD(RSAVS, RSBVS) 02540805 |
| IF (DSAVD - 1.9999D0) 20100, 10100, 40100 02550805 |
| 40100 IF (DSAVD - 2.0001D0) 10100, 10100, 20100 02560805 |
| 10100 IVPASS = IVPASS + 1 02570805 |
| WRITE (NUVI, 80002) IVTNUM 02580805 |
| GO TO 0101 02590805 |
| 20100 IVFAIL = IVFAIL + 1 02600805 |
| DVCORR = 2.0D0 02610805 |
| WRITE (NUVI, 80008) IVTNUM 02620805 |
| WRITE (NUVI, 80033) DSAVD 02630805 |
| WRITE (NUVI, 80035) DVCORR, REMRKS 02640805 |
| 0101 CONTINUE 02650805 |
| CT011* TEST 11 PAIR OF NON-ZERO VALUES 02660805 |
| IVTNUM = 11 02670805 |
| RSAVS = 3.333333 02680805 |
| RSBVS = 2.3948094 02690805 |
| DSAVD = DPROD(RSAVS, RSBVS) 02700805 |
| IF (DSAVD - 7.9823D0) 20110, 10110, 40110 02710805 |
| 40110 IF (DSAVD - 7.9831D0) 10110, 10110, 20110 02720805 |
| 10110 IVPASS = IVPASS + 1 02730805 |
| WRITE (NUVI, 80002) IVTNUM 02740805 |
| GO TO 0111 02750805 |
| 20110 IVFAIL = IVFAIL + 1 02760805 |
| DVCORR = 7.982697202D0 02770805 |
| WRITE (NUVI, 80008) IVTNUM 02780805 |
| WRITE (NUVI, 80033) DSAVD 02790805 |
| WRITE (NUVI, 80035) DVCORR, REMRKS 02800805 |
| 0111 CONTINUE 02810805 |
| CT012* TEST 12 ONE POSITIVE, ONE NEGATIVE 02820805 |
| IVTNUM = 12 02830805 |
| RSAVS = 0.123456 02840805 |
| RSBVS = -2.98765 02850805 |
| DSAVD = DPROD(RSAVS, RSBVS) 02860805 |
| IF (DSAVD + 3.6887D-1) 20120, 10120, 40120 02870805 |
| 40120 IF (DSAVD + 3.6882D-1) 10120, 10120, 20120 02880805 |
| 10120 IVPASS = IVPASS + 1 02890805 |
| WRITE (NUVI, 80002) IVTNUM 02900805 |
| GO TO 0121 02910805 |
| 20120 IVFAIL = IVFAIL + 1 02920805 |
| DVCORR = -3.688433184D-1 02930805 |
| WRITE (NUVI, 80008) IVTNUM 02940805 |
| WRITE (NUVI, 80033) DSAVD 02950805 |
| WRITE (NUVI, 80035) DVCORR, REMRKS 02960805 |
| 0121 CONTINUE 02970805 |
| CT013* TEST 13 ONE VALUE ONE(1), ONE NEGATIVE 02980805 |
| IVTNUM = 13 02990805 |
| RSAVS = 1.0834001 03000805 |
| RSBVS = -2.034985 03010805 |
| DSAVD = DPROD(RSAVS, RSBVS) 03020805 |
| IF (DSAVD + 2.2049D0) 20130, 10130, 40130 03030805 |
| 40130 IF (DSAVD + 2.2045D0) 10130, 10130, 20130 03040805 |
| 10130 IVPASS = IVPASS + 1 03050805 |
| WRITE (NUVI, 80002) IVTNUM 03060805 |
| GO TO 0131 03070805 |
| 20130 IVFAIL = IVFAIL + 1 03080805 |
| DVCORR = -2.204702953D0 03090805 |
| WRITE (NUVI, 80008) IVTNUM 03100805 |
| WRITE (NUVI, 80033) DSAVD 03110805 |
| WRITE (NUVI, 80035) DVCORR, REMRKS 03120805 |
| 0131 CONTINUE 03130805 |
| CT014* TEST 14 PAIR OF NEGATIVE VALUES 03140805 |
| IVTNUM = 14 03150805 |
| RSAVS = -3.077734 03160805 |
| RSBVS = -2.348343 03170805 |
| DSAVD = DPROD(RSAVS, RSBVS) 03180805 |
| IF (DSAVD - 7.2272D0) 20140, 10140, 40140 03190805 |
| 40140 IF (DSAVD - 7.2280D0) 10140, 10140, 20140 03200805 |
| 10140 IVPASS = IVPASS + 1 03210805 |
| WRITE (NUVI, 80002) IVTNUM 03220805 |
| GO TO 0141 03230805 |
| 20140 IVFAIL = IVFAIL + 1 03240805 |
| DVCORR = 7.227575095D0 03250805 |
| WRITE (NUVI, 80008) IVTNUM 03260805 |
| WRITE (NUVI, 80033) DSAVD 03270805 |
| WRITE (NUVI, 80035) DVCORR, REMRKS 03280805 |
| 0141 CONTINUE 03290805 |
| CT015* TEST 15 ONE POSITIVE VALUE, ONE NEGATIVE VALUE 03300805 |
| IVTNUM = 15 03310805 |
| RSAVS = 3.3333324 03320805 |
| RSBVS = -2.343953 03330805 |
| DSAVD = DPROD(RSAVS, RSBVS) 03340805 |
| IF (DSAVD + 7.8136D0) 20150, 10150, 40150 03350805 |
| 40150 IF (DSAVD + 7.8127D0) 10150, 10150, 20150 03360805 |
| 10150 IVPASS = IVPASS + 1 03370805 |
| WRITE (NUVI, 80002) IVTNUM 03380805 |
| GO TO 0151 03390805 |
| 20150 IVFAIL = IVFAIL + 1 03400805 |
| DVCORR = -7.813174479D0 03410805 |
| WRITE (NUVI, 80008) IVTNUM 03420805 |
| WRITE (NUVI, 80033) DSAVD 03430805 |
| WRITE (NUVI, 80035) DVCORR, REMRKS 03440805 |
| 0151 CONTINUE 03450805 |
| CT016* TEST 16 ARITHMETIC EXPRESSION PRESENTED TO DPROD 03460805 |
| IVTNUM = 16 03470805 |
| RSAVS = 1.555674 03480805 |
| RSBVS = 2.00012 03490805 |
| DSAVD = DPROD(RSAVS - RSBVS, RSAVS + RSBVS) 03500805 |
| IF (DSAVD + 1.5805D0) 20160, 10160, 40160 03510805 |
| 40160 IF (DSAVD + 1.5802D0) 10160, 10160, 20160 03520805 |
| 10160 IVPASS = IVPASS + 1 03530805 |
| WRITE (NUVI, 80002) IVTNUM 03540805 |
| GO TO 0161 03550805 |
| 20160 IVFAIL = IVFAIL + 1 03560805 |
| DVCORR = -1.580358420D0 03570805 |
| WRITE (NUVI, 80008) IVTNUM 03580805 |
| WRITE (NUVI, 80033) DSAVD 03590805 |
| WRITE (NUVI, 80035) DVCORR, REMRKS 03600805 |
| 0161 CONTINUE 03610805 |
| CT017* TEST 17 DPROD FORMS THE ARGUMENTS TO DDIM 03620805 |
| IVTNUM = 17 03630805 |
| DSAVD = DDIM(DPROD(0.4, 2.0), DPROD(3.0, 0.1)) 03640805 |
| IF (DSAVD - 0.49997D0) 20170, 10170, 40170 03650805 |
| 40170 IF (DSAVD - 0.50003D0) 10170, 10170, 20170 03660805 |
| 10170 IVPASS = IVPASS + 1 03670805 |
| WRITE (NUVI, 80002) IVTNUM 03680805 |
| GO TO 0171 03690805 |
| 20170 IVFAIL = IVFAIL + 1 03700805 |
| DVCORR = 0.5D0 03710805 |
| WRITE (NUVI, 80008) IVTNUM 03720805 |
| WRITE (NUVI, 80033) DSAVD 03730805 |
| WRITE (NUVI, 80035) DVCORR, REMRKS 03740805 |
| 0171 CONTINUE 03750805 |
| CT018* TEST 18 ARGUMENTS WITH HIGH AND LOW MAGNITUDES 03760805 |
| IVTNUM = 18 03770805 |
| RSAVS = 1.23456E-33 03780805 |
| RSBVS = 1.23456E+34 03790805 |
| DSAVD = DPROD(RSAVS, RSBVS) 03800805 |
| IF (DSAVD - 1.5240D1) 20180, 10180, 40180 03810805 |
| 40180 IF (DSAVD - 1.5242D1) 10180, 10180, 20180 03820805 |
| 10180 IVPASS = IVPASS + 1 03830805 |
| WRITE (NUVI, 80002) IVTNUM 03840805 |
| GO TO 0181 03850805 |
| 20180 IVFAIL = IVFAIL + 1 03860805 |
| DVCORR = 1.524138394D1 03870805 |
| WRITE (NUVI, 80008) IVTNUM 03880805 |
| WRITE (NUVI, 80033) DSAVD 03890805 |
| WRITE (NUVI, 80035) DVCORR, REMRKS 03900805 |
| 0181 CONTINUE 03910805 |
| C***** 03920805 |
| CBB** ********************** BBCSUM0 **********************************03930805 |
| C**** WRITE OUT TEST SUMMARY 03940805 |
| C**** 03950805 |
| IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03960805 |
| WRITE (I02, 90004) 03970805 |
| WRITE (I02, 90014) 03980805 |
| WRITE (I02, 90004) 03990805 |
| WRITE (I02, 90020) IVPASS 04000805 |
| WRITE (I02, 90022) IVFAIL 04010805 |
| WRITE (I02, 90024) IVDELE 04020805 |
| WRITE (I02, 90026) IVINSP 04030805 |
| WRITE (I02, 90028) IVTOTN, IVTOTL 04040805 |
| CBE** ********************** BBCSUM0 **********************************04050805 |
| CBB** ********************** BBCFOOT0 **********************************04060805 |
| C**** WRITE OUT REPORT FOOTINGS 04070805 |
| C**** 04080805 |
| WRITE (I02,90016) ZPROG, ZPROG 04090805 |
| WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04100805 |
| WRITE (I02,90019) 04110805 |
| CBE** ********************** BBCFOOT0 **********************************04120805 |
| CBB** ********************** BBCFMT0A **********************************04130805 |
| C**** FORMATS FOR TEST DETAIL LINES 04140805 |
| C**** 04150805 |
| 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 04160805 |
| 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 04170805 |
| 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 04180805 |
| 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 04190805 |
| 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 04200805 |
| 1I6,/," ",15X,"CORRECT= " ,I6) 04210805 |
| 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04220805 |
| 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 04230805 |
| 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04240805 |
| 1A21,/," ",16X,"CORRECT= " ,A21) 04250805 |
| 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 04260805 |
| 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 04270805 |
| 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 04280805 |
| 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 04290805 |
| 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 04300805 |
| 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 04310805 |
| 80050 FORMAT (" ",48X,A31) 04320805 |
| CBE** ********************** BBCFMT0A **********************************04330805 |
| CBB** ********************** BBCFMAT1 **********************************04340805 |
| C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04350805 |
| C**** 04360805 |
| 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04370805 |
| 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 04380805 |
| 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 04390805 |
| 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 04400805 |
| 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04410805 |
| 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04420805 |
| 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04430805 |
| 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04440805 |
| 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04450805 |
| 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 04460805 |
| 2"(",F12.5,", ",F12.5,")") 04470805 |
| CBE** ********************** BBCFMAT1 **********************************04480805 |
| CBB** ********************** BBCFMT0B **********************************04490805 |
| C**** FORMAT STATEMENTS FOR PAGE HEADERS 04500805 |
| C**** 04510805 |
| 90002 FORMAT ("1") 04520805 |
| 90004 FORMAT (" ") 04530805 |
| 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04540805 |
| 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04550805 |
| 90008 FORMAT (" ",21X,A13,A17) 04560805 |
| 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04570805 |
| 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04580805 |
| 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04590805 |
| 1 7X,"REMARKS",24X) 04600805 |
| 90014 FORMAT (" ","----------------------------------------------" , 04610805 |
| 1 "---------------------------------" ) 04620805 |
| 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04630805 |
| C**** 04640805 |
| C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04650805 |
| C**** 04660805 |
| 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04670805 |
| 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04680805 |
| 1 A13) 04690805 |
| 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04700805 |
| C**** 04710805 |
| C**** FORMAT STATEMENTS FOR RUN SUMMARY 04720805 |
| C**** 04730805 |
| 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04740805 |
| 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04750805 |
| 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04760805 |
| 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04770805 |
| 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04780805 |
| CBE** ********************** BBCFMT0B **********************************04790805 |
| C***** 04800805 |
| C***** END OF TEST SEGMENT 164 04810805 |
| STOP 04820805 |
| END 04830805 |
| 04840805 |
