blob: e8516e0585dbccdf4a0c55fa96490e362de43a72 [file] [log] [blame]
PROGRAM FM801
C***********************************************************************00010801
C***** FORTRAN 77 00020801
C***** FM801 YDINT - (155) 00030801
C***** 00040801
C***********************************************************************00050801
C***** GENERAL PURPOSE ANS REF 00060801
C***** TEST INTRINSIC FUNCTIONS DINT, DNINT, IDNINT 15.3 00070801
C***** TRUNCATION (SIGN OF A * LARGEST INTEGER LE ABS(A) ) (TABLE 5)00080801
C***** 00090801
C***** GENERAL COMMENTS 00100801
C***** FLOAT FUNCTION ASSUMED WORKING 00110801
C***** 00120801
CBB** ********************** BBCCOMNT **********************************00130801
C**** 00140801
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150801
C**** VERSION 2.1 00160801
C**** 00170801
C**** 00180801
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190801
C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200801
C**** SOFTWARE STANDARDS VALIDATION GROUP 00210801
C**** BUILDING 225 RM A266 00220801
C**** GAITHERSBURG, MD 20899 00230801
C**** 00240801
C**** 00250801
C**** 00260801
CBE** ********************** BBCCOMNT **********************************00270801
C***** 00280801
C***** S P E C I F I C A T I O N S SEGMENT 155 00290801
DOUBLE PRECISION DNAVD, DNBVD, DNDVD 00300801
C***** 00310801
CBB** ********************** BBCINITA **********************************00320801
C**** SPECIFICATION STATEMENTS 00330801
C**** 00340801
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350801
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360801
CBE** ********************** BBCINITA **********************************00370801
CBB** ********************** BBCINITB **********************************00380801
C**** INITIALIZE SECTION 00390801
DATA ZVERS, ZVERSD, ZDATE 00400801
1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410801
DATA ZCOMPL, ZNAME, ZTAPE 00420801
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430801
DATA ZPROJ, ZTAPED, ZPROG 00440801
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450801
DATA REMRKS /' '/ 00460801
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470801
C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480801
C**** 00490801
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500801
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510801
CZ03 ZPROG = 'PROGRAM NAME' 00520801
CZ04 ZDATE = 'DATE OF TEST' 00530801
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540801
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550801
CZ07 ZNAME = 'NAME OF USER' 00560801
CZ08 ZTAPE = 'TAPE OWNER/ID' 00570801
CZ09 ZTAPED = 'DATE TAPE COPIED' 00580801
C 00590801
IVPASS = 0 00600801
IVFAIL = 0 00610801
IVDELE = 0 00620801
IVINSP = 0 00630801
IVTOTL = 0 00640801
IVTOTN = 0 00650801
ICZERO = 0 00660801
C 00670801
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680801
I01 = 05 00690801
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700801
I02 = 06 00710801
C 00720801
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730801
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740801
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750801
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760801
C 00770801
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780801
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790801
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800801
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810801
C 00820801
CBE** ********************** BBCINITB **********************************00830801
NUVI = I02 00840801
IVTOTL = 45 00850801
ZPROG = 'FM801' 00860801
CBB** ********************** BBCHED0A **********************************00870801
C**** 00880801
C**** WRITE REPORT TITLE 00890801
C**** 00900801
WRITE (I02, 90002) 00910801
WRITE (I02, 90006) 00920801
WRITE (I02, 90007) 00930801
WRITE (I02, 90008) ZVERS, ZVERSD 00940801
WRITE (I02, 90009) ZPROG, ZPROG 00950801
WRITE (I02, 90010) ZDATE, ZCOMPL 00960801
CBE** ********************** BBCHED0A **********************************00970801
C***** 00980801
C***** HEADER FOR SEGMENT 155 00990801
WRITE (NUVI,15501) 01000801
15501 FORMAT (" ", // 1X,"YDINT - (155) INTRINSIC FUNCTIONS--" //16X, 01010801
1 "DINT, DNINT, IDNINT (TYPE CONVERSION) " // 01020801
2 " ANS REF. - 15.3" ) 01030801
CBB** ********************** BBCHED0B **********************************01040801
C**** WRITE DETAIL REPORT HEADERS 01050801
C**** 01060801
WRITE (I02,90004) 01070801
WRITE (I02,90004) 01080801
WRITE (I02,90013) 01090801
WRITE (I02,90014) 01100801
WRITE (I02,90015) IVTOTL 01110801
CBE** ********************** BBCHED0B **********************************01120801
C***** 01130801
C***** TEST OF DINT 01140801
C***** 01150801
WRITE(NUVI, 15502) 01160801
15502 FORMAT(// 8X, "TEST OF DINT" ) 01170801
CT001* TEST 1 THE VALUE ZERO 01180801
IVTNUM = 1 01190801
DNBVD = 0.0D0 01200801
DNAVD = DINT(DNBVD) 01210801
IF (DNAVD + 5.0D-10) 20010, 10010, 40010 01220801
40010 IF (DNAVD - 5.0D-10) 10010, 10010, 20010 01230801
10010 IVPASS = IVPASS + 1 01240801
WRITE (NUVI, 80002) IVTNUM 01250801
GO TO 0011 01260801
20010 IVFAIL = IVFAIL + 1 01270801
DVCORR = 0.0D0 01280801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 01290801
0011 CONTINUE 01300801
CT002* TEST 2 A VALUE IN (0,1) 01310801
IVTNUM = 2 01320801
DNBVD = 0.375D0 01330801
DNAVD = DINT(DNBVD) 01340801
IF (DNAVD + 5.0D-10) 20020, 10020, 40020 01350801
40020 IF (DNAVD - 5.0D-10) 10020, 10020, 20020 01360801
10020 IVPASS = IVPASS + 1 01370801
WRITE (NUVI, 80002) IVTNUM 01380801
GO TO 0021 01390801
20020 IVFAIL = IVFAIL + 1 01400801
DVCORR = 0.0D0 01410801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 01420801
0021 CONTINUE 01430801
CT003* TEST 3 THE VALUE 1 01440801
IVTNUM = 3 01450801
DNBVD = FLOAT(1) 01460801
DNAVD = DINT(DNBVD) 01470801
IF (DNAVD - 0.9999999995D0) 20030, 10030, 40030 01480801
40030 IF (DNAVD - 1.000000001D0) 10030, 10030, 20030 01490801
10030 IVPASS = IVPASS + 1 01500801
WRITE (NUVI, 80002) IVTNUM 01510801
GO TO 0031 01520801
20030 IVFAIL = IVFAIL + 1 01530801
DVCORR = 1.0D0 01540801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 01550801
0031 CONTINUE 01560801
CT004* TEST 4 AN INTEGRAL VALUE OTHER THAN 0, 1 01570801
IVTNUM = 4 01580801
DNBVD = FLOAT(6) 01590801
DNAVD = DINT(DNBVD) 01600801
IF (DNAVD - 5.999999997D0) 20040, 10040, 40040 01610801
40040 IF (DNAVD - 6.000000003D0) 10040, 10040, 20040 01620801
10040 IVPASS = IVPASS + 1 01630801
WRITE (NUVI, 80002) IVTNUM 01640801
GO TO 0041 01650801
20040 IVFAIL = IVFAIL + 1 01660801
DVCORR = 6.0D0 01670801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 01680801
0041 CONTINUE 01690801
CT005* TEST 5 A VALUE IN (X,X+1) 01700801
IVTNUM = 5 01710801
DNBVD = 0.375D1 01720801
DNAVD = DINT(DNBVD) 01730801
IF (DNAVD - 2.999999998D0) 20050, 10050, 40050 01740801
40050 IF (DNAVD - 3.000000002D0) 10050, 10050, 20050 01750801
10050 IVPASS = IVPASS + 1 01760801
WRITE (NUVI, 80002) IVTNUM 01770801
GO TO 0051 01780801
20050 IVFAIL = IVFAIL + 1 01790801
DVCORR = 0.3D1 01800801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 01810801
0051 CONTINUE 01820801
CT006* TEST 6 A NEGATIVE VALUE WITH MAGNITUDE IN (0,1) 01830801
IVTNUM = 6 01840801
DNBVD = -0.375D0 01850801
DNAVD = DINT(DNBVD) 01860801
IF (DNAVD + 5.0D-10) 20060, 10060, 40060 01870801
40060 IF (DNAVD - 5.0D-10) 10060, 10060, 20060 01880801
10060 IVPASS = IVPASS + 1 01890801
WRITE (NUVI, 80002) IVTNUM 01900801
GO TO 0061 01910801
20060 IVFAIL = IVFAIL + 1 01920801
DVCORR = 0.0D0 01930801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 01940801
0061 CONTINUE 01950801
CT007* TEST 7 THE VALUE -1 01960801
IVTNUM = 7 01970801
DNBVD = FLOAT(-1) 01980801
DNAVD = DINT(DNBVD) 01990801
IF (DNAVD + 1.000000001D0) 20070, 10070, 40070 02000801
40070 IF (DNAVD + 0.9999999995D0) 10070, 10070, 20070 02010801
10070 IVPASS = IVPASS + 1 02020801
WRITE (NUVI, 80002) IVTNUM 02030801
GO TO 0071 02040801
20070 IVFAIL = IVFAIL + 1 02050801
DVCORR = -1.0D0 02060801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02070801
0071 CONTINUE 02080801
CT008* TEST 8 A NEGATIVE INTEGRAL VALUE 02090801
IVTNUM = 8 02100801
DNBVD = FLOAT(-6) 02110801
DNAVD = DINT(DNBVD) 02120801
IF (DNAVD + 6.000000003D0) 20080, 10080, 40080 02130801
40080 IF (DNAVD + 5.999999997D0) 10080, 10080, 20080 02140801
10080 IVPASS = IVPASS + 1 02150801
WRITE (NUVI, 80002) IVTNUM 02160801
GO TO 0081 02170801
20080 IVFAIL = IVFAIL + 1 02180801
DVCORR = -6.0D0 02190801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02200801
0081 CONTINUE 02210801
CT009* TEST 9 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+1) 02220801
IVTNUM = 9 02230801
DNBVD = -0.375D1 02240801
DNAVD = DINT(DNBVD) 02250801
IF (DNAVD + 3.000000002D0) 20090, 10090, 40090 02260801
40090 IF (DNAVD + 2.999999998D0) 10090, 10090, 20090 02270801
10090 IVPASS = IVPASS + 1 02280801
WRITE (NUVI, 80002) IVTNUM 02290801
GO TO 0091 02300801
20090 IVFAIL = IVFAIL + 1 02310801
DVCORR = -0.3D1 02320801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02330801
0091 CONTINUE 02340801
CT010* TEST 10 ZERO PREFIXED WITH A MINUS SIGN 02350801
IVTNUM = 10 02360801
DNBVD = 0.0D0 02370801
DNAVD = DINT(-DNBVD) 02380801
IF (DNAVD + 5.0D-10) 20100, 10100, 40100 02390801
40100 IF (DNAVD - 5.0D-10) 10100, 10100, 20100 02400801
10100 IVPASS = IVPASS + 1 02410801
WRITE (NUVI, 80002) IVTNUM 02420801
GO TO 0101 02430801
20100 IVFAIL = IVFAIL + 1 02440801
DVCORR = 0.0D0 02450801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02460801
0101 CONTINUE 02470801
CT011* TEST 11 AN ARITHMETIC EXPRESSION PRESENTED TO FUNCTION 02480801
IVTNUM = 11 02490801
DNBVD = 0.375D1 02500801
DNAVD = DINT(DNBVD/0.375D0) 02510801
IF (DNAVD - 0.9000000000D1) 20110, 10110, 40110 02520801
40110 IF (DNAVD - 1.000000001D1) 10110, 10110, 20110 02530801
10110 IVPASS = IVPASS + 1 02540801
WRITE (NUVI, 80002) IVTNUM 02550801
GO TO 0111 02560801
20110 IVFAIL = IVFAIL + 1 02570801
DVCORR = 1.0D1 02580801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02590801
0111 CONTINUE 02600801
C***** 02610801
WRITE (NUVI, 90002) 02620801
WRITE (NUVI, 90013) 02630801
WRITE (NUVI, 90014) 02640801
C***** 02650801
C***** TEST OF DNINT 02660801
C***** 02670801
WRITE(NUVI, 15504) 02680801
15504 FORMAT( // 8X, "TEST OF DNINT" ) 02690801
CT012* TEST 12 THE VALUE ZERO 02700801
IVTNUM = 12 02710801
DNBVD = 0.0D0 02720801
DNAVD = DNINT(DNBVD) 02730801
IF (DNAVD + 5.0D-10) 20120, 10120, 40120 02740801
40120 IF (DNAVD - 5.0D-10) 10120, 10120, 20120 02750801
10120 IVPASS = IVPASS + 1 02760801
WRITE (NUVI, 80002) IVTNUM 02770801
GO TO 0121 02780801
20120 IVFAIL = IVFAIL + 1 02790801
DVCORR = 0.0D0 02800801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02810801
0121 CONTINUE 02820801
CT013* TEST 13 A VALUE IN (0,.5) 02830801
IVTNUM = 13 02840801
DNBVD = 0.25D0 02850801
DNAVD = DNINT(DNBVD) 02860801
IF (DNAVD + 5.0D-10) 20130, 10130, 40130 02870801
40130 IF (DNAVD - 5.0D-10) 10130, 10130, 20130 02880801
10130 IVPASS = IVPASS + 1 02890801
WRITE (NUVI, 80002) IVTNUM 02900801
GO TO 0131 02910801
20130 IVFAIL = IVFAIL + 1 02920801
DVCORR = 0.0D0 02930801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02940801
0131 CONTINUE 02950801
CT014* TEST 14 THE VALUE 0.5 02960801
IVTNUM = 14 02970801
DNBVD = FLOAT(1) / FLOAT(2) 02980801
DNAVD = DNINT(DNBVD) 02990801
IF (DNAVD - 0.9999999995D0) 20140, 10140, 40140 03000801
40140 IF (DNAVD - 1.000000001D0) 10140, 10140, 20140 03010801
10140 IVPASS = IVPASS + 1 03020801
WRITE (NUVI, 80002) IVTNUM 03030801
GO TO 0141 03040801
20140 IVFAIL = IVFAIL + 1 03050801
DVCORR = 1.0D0 03060801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03070801
0141 CONTINUE 03080801
CT015* TEST 15 A VALUE IN (.5,1) 03090801
IVTNUM = 15 03100801
DNBVD = 0.75D0 03110801
DNAVD = DNINT(DNBVD) 03120801
IF (DNAVD - 0.9999999995D0) 20150, 10150, 40150 03130801
40150 IF (DNAVD - 1.000000001D0) 10150, 10150, 20150 03140801
10150 IVPASS = IVPASS + 1 03150801
WRITE (NUVI, 80002) IVTNUM 03160801
GO TO 0151 03170801
20150 IVFAIL = IVFAIL + 1 03180801
DVCORR = 1.0D0 03190801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03200801
0151 CONTINUE 03210801
CT016* TEST 16 AN INTEGRAL VALUE OTHER THAN 0, 1 03220801
IVTNUM = 16 03230801
DNBVD = FLOAT(5) 03240801
DNAVD = DNINT(DNBVD) 03250801
IF (DNAVD - 4.999999997D0) 20160, 10160, 40160 03260801
40160 IF (DNAVD - 5.000000003D0) 10160, 10160, 20160 03270801
10160 IVPASS = IVPASS + 1 03280801
WRITE (NUVI, 80002) IVTNUM 03290801
GO TO 0161 03300801
20160 IVFAIL = IVFAIL + 1 03310801
DVCORR = 5.0D0 03320801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03330801
0161 CONTINUE 03340801
CT017* TEST 17 A VALUE IN (X,X+.5) 03350801
IVTNUM = 17 03360801
DNBVD = 10.46875D0 03370801
DNAVD = DNINT(DNBVD) 03380801
IF (DNAVD - 9.999999995D0) 20170, 10170, 40170 03390801
40170 IF (DNAVD - 10.00000001D0) 10170, 10170, 20170 03400801
10170 IVPASS = IVPASS + 1 03410801
WRITE (NUVI, 80002) IVTNUM 03420801
GO TO 0171 03430801
20170 IVFAIL = IVFAIL + 1 03440801
DVCORR = 10.0D0 03450801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03460801
0171 CONTINUE 03470801
CT018* TEST 18 A VALUE WITH FRACTIONAL COMPONENT 0.5 03480801
IVTNUM = 18 03490801
DNBVD = FLOAT(15) + FLOAT(1) / FLOAT(2) 03500801
DNAVD = DNINT(DNBVD) 03510801
IF (DNAVD - 15.99999999D0) 20180, 10180, 40180 03520801
40180 IF (DNAVD - 16.00000001D0) 10180, 10180, 20180 03530801
10180 IVPASS = IVPASS + 1 03540801
WRITE (NUVI, 80002) IVTNUM 03550801
GO TO 0181 03560801
20180 IVFAIL = IVFAIL + 1 03570801
DVCORR = 16.0D0 03580801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03590801
0181 CONTINUE 03600801
CT019* TEST 19 A VALUE IN (X+.5,X+1) 03610801
IVTNUM = 19 03620801
DNBVD = 27.96875D0 03630801
DNAVD = DNINT(DNBVD) 03640801
IF (DNAVD - 27.99999998D0) 20190, 10190, 40190 03650801
40190 IF (DNAVD - 28.00000002D0) 10190, 10190, 20190 03660801
10190 IVPASS = IVPASS + 1 03670801
WRITE (NUVI, 80002) IVTNUM 03680801
GO TO 0191 03690801
20190 IVFAIL = IVFAIL + 1 03700801
DVCORR = 28.0D0 03710801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03720801
0191 CONTINUE 03730801
CT020* TEST 20 A NEGATIVE VALUE WITH MAGNITUDE IN (0,.5) 03740801
IVTNUM = 20 03750801
DNBVD = -0.25D0 03760801
DNAVD = DNINT(DNBVD) 03770801
IF (DNAVD + 5.0D-10) 20200, 10200, 40200 03780801
40200 IF (DNAVD - 5.0D-10) 10200, 10200, 20200 03790801
10200 IVPASS = IVPASS + 1 03800801
WRITE (NUVI, 80002) IVTNUM 03810801
GO TO 0201 03820801
20200 IVFAIL = IVFAIL + 1 03830801
DVCORR = 0.0D0 03840801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03850801
0201 CONTINUE 03860801
CT021* TEST 21 THE VALUE -0.5 03870801
IVTNUM = 21 03880801
DNBVD = -FLOAT(1) / FLOAT(2) 03890801
DNAVD = DNINT(DNBVD) 03900801
IF (DNAVD + 1.000000001D0) 20210, 10210, 40210 03910801
40210 IF (DNAVD + 0.9999999995D0) 10210, 10210, 20210 03920801
10210 IVPASS = IVPASS + 1 03930801
WRITE (NUVI, 80002) IVTNUM 03940801
GO TO 0211 03950801
20210 IVFAIL = IVFAIL + 1 03960801
DVCORR = -1.0D0 03970801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03980801
0211 CONTINUE 03990801
CT022* TEST 22 A NEGATIVE VALUE WITH MAGNITUDE IN (.5,1) 04000801
IVTNUM = 22 04010801
DNBVD = -0.75D0 04020801
DNAVD = DNINT(DNBVD) 04030801
IF (DNAVD + 1.000000001D0) 20220, 10220, 40220 04040801
40220 IF (DNAVD + 0.9999999995D0) 10220, 10220, 20220 04050801
10220 IVPASS = IVPASS + 1 04060801
WRITE (NUVI, 80002) IVTNUM 04070801
GO TO 0221 04080801
20220 IVFAIL = IVFAIL + 1 04090801
DVCORR = -1.0D0 04100801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04110801
0221 CONTINUE 04120801
CT023* TEST 23 A NEGATIVE INTEGRAL VALUE 04130801
IVTNUM = 23 04140801
DNBVD = -FLOAT(5) 04150801
DNAVD = DNINT(DNBVD) 04160801
IF (DNAVD + 5.000000003D0) 20230, 10230, 40230 04170801
40230 IF (DNAVD + 4.999999997D0) 10230, 10230, 20230 04180801
10230 IVPASS = IVPASS + 1 04190801
WRITE (NUVI, 80002) IVTNUM 04200801
GO TO 0231 04210801
20230 IVFAIL = IVFAIL + 1 04220801
DVCORR = -5.0D0 04230801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04240801
0231 CONTINUE 04250801
CT024* TEST 24 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+.5) 04260801
IVTNUM = 24 04270801
DNBVD = -10.46875D0 04280801
DNAVD = DNINT(DNBVD) 04290801
IF (DNAVD + 10.00000001D0) 20240, 10240, 40240 04300801
40240 IF (DNAVD + 9.999999995D0) 10240, 10240, 20240 04310801
10240 IVPASS = IVPASS + 1 04320801
WRITE (NUVI, 80002) IVTNUM 04330801
GO TO 0241 04340801
20240 IVFAIL = IVFAIL + 1 04350801
DVCORR = -10.0D0 04360801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04370801
0241 CONTINUE 04380801
CT025* TEST 25 A NEGATIVE VALUE WITH FRACTIONAL COMPONENT 0.5 04390801
IVTNUM = 25 04400801
DNBVD = FLOAT(-15) - FLOAT(1) / FLOAT(2) 04410801
DNAVD = DNINT(DNBVD) 04420801
IF (DNAVD + 16.00000001D0) 20250, 10250, 40250 04430801
40250 IF (DNAVD + 15.99999999D0) 10250, 10250, 20250 04440801
10250 IVPASS = IVPASS + 1 04450801
WRITE (NUVI, 80002) IVTNUM 04460801
GO TO 0251 04470801
20250 IVFAIL = IVFAIL + 1 04480801
DVCORR = -16.0D0 04490801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04500801
0251 CONTINUE 04510801
CT026* TEST 26 A NEGATIVE VALUE WITH MAGNITUDE IN (X+.5,X+1) 04520801
IVTNUM = 26 04530801
DNBVD = -27.96875D0 04540801
DNAVD = DNINT(DNBVD) 04550801
IF (DNAVD + 28.00000002D0) 20260, 10260, 40260 04560801
40260 IF (DNAVD + 27.99999998D0) 10260, 10260, 20260 04570801
10260 IVPASS = IVPASS + 1 04580801
WRITE (NUVI, 80002) IVTNUM 04590801
GO TO 0261 04600801
20260 IVFAIL = IVFAIL + 1 04610801
DVCORR = -28.0D0 04620801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04630801
0261 CONTINUE 04640801
CT027* TEST 27 ZERO PREFIXED WITH A MINUS SIGN 04650801
IVTNUM = 27 04660801
DNBVD = 0.0D0 04670801
DNAVD = DNINT(-DNBVD) 04680801
IF (DNAVD + 5.0D-10) 20270, 10270, 40270 04690801
40270 IF (DNAVD - 5.0D-10) 10270, 10270, 20270 04700801
10270 IVPASS = IVPASS + 1 04710801
WRITE (NUVI, 80002) IVTNUM 04720801
GO TO 0271 04730801
20270 IVFAIL = IVFAIL + 1 04740801
DVCORR = 0.0D0 04750801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04760801
0271 CONTINUE 04770801
CT028* TEST 28 AN ARITHMETIC EXPRESSION PRESENTED TO FUNCTION 04780801
IVTNUM = 28 04790801
DNBVD = 8.00D0 04800801
DNDVD = 7.25D0 04810801
DNAVD = DNINT(DNBVD - DNDVD) 04820801
IF (DNAVD - 0.9999999995D0) 20280, 10280, 40280 04830801
40280 IF (DNAVD - 1.000000001D0) 10280, 10280, 20280 04840801
10280 IVPASS = IVPASS + 1 04850801
WRITE (NUVI, 80002) IVTNUM 04860801
GO TO 0281 04870801
20280 IVFAIL = IVFAIL + 1 04880801
DVCORR = 1.0D0 04890801
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04900801
0281 CONTINUE 04910801
C***** 04920801
WRITE (NUVI, 90002) 04930801
WRITE (NUVI, 90013) 04940801
WRITE (NUVI, 90014) 04950801
C***** 04960801
C***** TEST OF IDNINT 04970801
C***** 04980801
C***** 04990801
WRITE(NUVI, 15506) 05000801
15506 FORMAT( // 8X, "TEST OF IDNINT" ) 05010801
CT029* TEST 29 THE VALUE ZERO 05020801
IVTNUM = 29 05030801
DNBVD = 0.0D0 05040801
INAVI = IDNINT(DNBVD) 05050801
IF (INAVI - 0) 20290, 10290, 20290 05060801
10290 IVPASS = IVPASS + 1 05070801
WRITE (NUVI, 80002) IVTNUM 05080801
GO TO 0291 05090801
20290 IVFAIL = IVFAIL + 1 05100801
IVCORR = 0 05110801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05120801
0291 CONTINUE 05130801
CT030* TEST 30 A VALUE IN (0.,5) 05140801
IVTNUM = 30 05150801
DNBVD = 0.25D0 05160801
INAVI = IDNINT(DNBVD) 05170801
IF (INAVI - 0) 20300, 10300, 20300 05180801
10300 IVPASS = IVPASS + 1 05190801
WRITE (NUVI, 80002) IVTNUM 05200801
GO TO 0301 05210801
20300 IVFAIL = IVFAIL + 1 05220801
IVCORR = 0 05230801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05240801
0301 CONTINUE 05250801
CT031* TEST 31 THE VALUE 0.5 05260801
IVTNUM = 31 05270801
DNBVD = FLOAT(1) / FLOAT(2) 05280801
INAVI = IDNINT(DNBVD) 05290801
IF (INAVI - 1) 20310, 10310, 20310 05300801
10310 IVPASS = IVPASS + 1 05310801
WRITE (NUVI, 80002) IVTNUM 05320801
GO TO 0311 05330801
20310 IVFAIL = IVFAIL + 1 05340801
IVCORR = 1 05350801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05360801
0311 CONTINUE 05370801
CT032* TEST 32 A VALUE IN (.5,1) 05380801
IVTNUM = 32 05390801
DNBVD = 0.75D0 05400801
INAVI = IDNINT(DNBVD) 05410801
IF (INAVI - 1) 20320, 10320, 20320 05420801
10320 IVPASS = IVPASS + 1 05430801
WRITE (NUVI, 80002) IVTNUM 05440801
GO TO 0321 05450801
20320 IVFAIL = IVFAIL + 1 05460801
IVCORR = 1 05470801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05480801
0321 CONTINUE 05490801
CT033* TEST 33 AN INTEGRAL VALUE OTHER THAN 0, 1 05500801
IVTNUM = 33 05510801
DNBVD = FLOAT(5) 05520801
INAVI = IDNINT(DNBVD) 05530801
IF (INAVI - 5) 20330, 10330, 20330 05540801
10330 IVPASS = IVPASS + 1 05550801
WRITE (NUVI, 80002) IVTNUM 05560801
GO TO 0331 05570801
20330 IVFAIL = IVFAIL + 1 05580801
IVCORR = 5 05590801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05600801
0331 CONTINUE 05610801
CT034* TEST 34 A VALUE IN (X,X+.5) 05620801
IVTNUM = 34 05630801
DNBVD = 10.46875D0 05640801
INAVI = IDNINT(DNBVD) 05650801
IF (INAVI - 10) 20340, 10340, 20340 05660801
10340 IVPASS = IVPASS + 1 05670801
WRITE (NUVI, 80002) IVTNUM 05680801
GO TO 0341 05690801
20340 IVFAIL = IVFAIL + 1 05700801
IVCORR = 10 05710801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05720801
0341 CONTINUE 05730801
CT035* TEST 35 A VALUE WITH FRACTIONAL COMPONENT 0.5 05740801
IVTNUM = 35 05750801
DNBVD = FLOAT(15) + FLOAT(1) / FLOAT(2) 05760801
INAVI = IDNINT(DNBVD) 05770801
IF (INAVI - 16) 20350, 10350, 20350 05780801
10350 IVPASS = IVPASS + 1 05790801
WRITE (NUVI, 80002) IVTNUM 05800801
GO TO 0351 05810801
20350 IVFAIL = IVFAIL + 1 05820801
IVCORR = 16 05830801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05840801
0351 CONTINUE 05850801
CT036* TEST 36 A VALUE IN (X+.5,X+1) 05860801
IVTNUM = 36 05870801
DNBVD = 27.96875D0 05880801
INAVI = IDNINT(DNBVD) 05890801
IF (INAVI - 28) 20360, 10360, 20360 05900801
10360 IVPASS = IVPASS + 1 05910801
WRITE (NUVI, 80002) IVTNUM 05920801
GO TO 0361 05930801
20360 IVFAIL = IVFAIL + 1 05940801
IVCORR = 28 05950801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05960801
0361 CONTINUE 05970801
CT037* TEST 37 A NEGATIVE VALUE WITH MAGNITUDE IN (0,.5) 05980801
IVTNUM = 37 05990801
DNBVD = -0.25D0 06000801
INAVI = IDNINT(DNBVD) 06010801
IF (INAVI - 0) 20370, 10370, 20370 06020801
10370 IVPASS = IVPASS + 1 06030801
WRITE (NUVI, 80002) IVTNUM 06040801
GO TO 0371 06050801
20370 IVFAIL = IVFAIL + 1 06060801
IVCORR = 0 06070801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06080801
0371 CONTINUE 06090801
CT038* TEST 38 THE VALUE -0.5 06100801
IVTNUM = 38 06110801
DNBVD = -FLOAT(1) / FLOAT(2) 06120801
INAVI = IDNINT(DNBVD) 06130801
IF (INAVI + 1) 20380, 10380, 20380 06140801
10380 IVPASS = IVPASS + 1 06150801
WRITE (NUVI, 80002) IVTNUM 06160801
GO TO 0381 06170801
20380 IVFAIL = IVFAIL + 1 06180801
IVCORR = -1 06190801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06200801
0381 CONTINUE 06210801
CT039* TEST 39 A NEGATIVE VALUE WITH MAGNITUDE IN (.5,1) 06220801
IVTNUM = 39 06230801
DNBVD = -0.75D0 06240801
INAVI = IDNINT(DNBVD) 06250801
IF (INAVI + 1) 20390, 10390, 20390 06260801
10390 IVPASS = IVPASS + 1 06270801
WRITE (NUVI, 80002) IVTNUM 06280801
GO TO 0391 06290801
20390 IVFAIL = IVFAIL + 1 06300801
IVCORR = -1 06310801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06320801
0391 CONTINUE 06330801
CT040* TEST 40 A NEGATIVE INTEGRAL VALUE 06340801
IVTNUM = 40 06350801
DNBVD = -FLOAT(5) 06360801
INAVI = IDNINT(DNBVD) 06370801
IF (INAVI + 5) 20400, 10400, 20400 06380801
10400 IVPASS = IVPASS + 1 06390801
WRITE (NUVI, 80002) IVTNUM 06400801
GO TO 0401 06410801
20400 IVFAIL = IVFAIL + 1 06420801
IVCORR = -5 06430801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06440801
0401 CONTINUE 06450801
CT041* TEST 41 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+.5) 06460801
IVTNUM = 41 06470801
DNBVD = -10.46875D0 06480801
INAVI = IDNINT(DNBVD) 06490801
IF (INAVI + 10) 20410, 10410, 20410 06500801
10410 IVPASS = IVPASS + 1 06510801
WRITE (NUVI, 80002) IVTNUM 06520801
GO TO 0411 06530801
20410 IVFAIL = IVFAIL + 1 06540801
IVCORR = -10 06550801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06560801
0411 CONTINUE 06570801
CT042* TEST 42 A NEGATIVE VALUE WITH FRACTIONAL COMPONENT 0.5 06580801
IVTNUM = 42 06590801
DNBVD = FLOAT(-15) - FLOAT(1) /FLOAT(2) 06600801
INAVI = IDNINT(DNBVD) 06610801
IF (INAVI + 16) 20420, 10420, 20420 06620801
10420 IVPASS = IVPASS + 1 06630801
WRITE (NUVI, 80002) IVTNUM 06640801
GO TO 0421 06650801
20420 IVFAIL = IVFAIL + 1 06660801
IVCORR = -16 06670801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06680801
0421 CONTINUE 06690801
CT043* TEST 43 A NEGATIVE VALUE WITH MAGNITUDE IN (X+.5,X+1) 06700801
IVTNUM = 43 06710801
DNBVD = -27.96875D0 06720801
INAVI = IDNINT(DNBVD) 06730801
IF (INAVI + 28) 20430, 10430, 20430 06740801
10430 IVPASS = IVPASS + 1 06750801
WRITE (NUVI, 80002) IVTNUM 06760801
GO TO 0431 06770801
20430 IVFAIL = IVFAIL + 1 06780801
IVCORR = -28 06790801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06800801
0431 CONTINUE 06810801
CT044* TEST 44 ZERO PREFIXED WITH A MINUS SIGN 06820801
IVTNUM = 44 06830801
DNBVD = 0.0D0 06840801
INAVI = IDNINT(-DNBVD) 06850801
IF (INAVI - 0) 20440, 10440, 20440 06860801
10440 IVPASS = IVPASS + 1 06870801
WRITE (NUVI, 80002) IVTNUM 06880801
GO TO 0441 06890801
20440 IVFAIL = IVFAIL + 1 06900801
IVCORR = 0 06910801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06920801
0441 CONTINUE 06930801
CT045* TEST 45 AN ARITHMETIC EXPRESSION PRESENTED TO FUNCTION 06940801
IVTNUM = 45 06950801
DNBVD = 8.00D0 06960801
DNDVD = 7.25D0 06970801
INAVI = IDNINT(DNBVD - DNDVD) 06980801
IF (INAVI - 1) 20450, 10450, 20450 06990801
10450 IVPASS = IVPASS + 1 07000801
WRITE (NUVI, 80002) IVTNUM 07010801
GO TO 0451 07020801
20450 IVFAIL = IVFAIL + 1 07030801
IVCORR = 1 07040801
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 07050801
0451 CONTINUE 07060801
C***** 07070801
CBB** ********************** BBCSUM0 **********************************07080801
C**** WRITE OUT TEST SUMMARY 07090801
C**** 07100801
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 07110801
WRITE (I02, 90004) 07120801
WRITE (I02, 90014) 07130801
WRITE (I02, 90004) 07140801
WRITE (I02, 90020) IVPASS 07150801
WRITE (I02, 90022) IVFAIL 07160801
WRITE (I02, 90024) IVDELE 07170801
WRITE (I02, 90026) IVINSP 07180801
WRITE (I02, 90028) IVTOTN, IVTOTL 07190801
CBE** ********************** BBCSUM0 **********************************07200801
CBB** ********************** BBCFOOT0 **********************************07210801
C**** WRITE OUT REPORT FOOTINGS 07220801
C**** 07230801
WRITE (I02,90016) ZPROG, ZPROG 07240801
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 07250801
WRITE (I02,90019) 07260801
CBE** ********************** BBCFOOT0 **********************************07270801
CBB** ********************** BBCFMT0A **********************************07280801
C**** FORMATS FOR TEST DETAIL LINES 07290801
C**** 07300801
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 07310801
80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 07320801
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 07330801
80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 07340801
80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 07350801
1I6,/," ",15X,"CORRECT= " ,I6) 07360801
80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07370801
1E12.5,/," ",16X,"CORRECT= " ,E12.5) 07380801
80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07390801
1A21,/," ",16X,"CORRECT= " ,A21) 07400801
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 07410801
80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 07420801
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 07430801
80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 07440801
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 07450801
80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 07460801
80050 FORMAT (" ",48X,A31) 07470801
CBE** ********************** BBCFMT0A **********************************07480801
CBB** ********************** BBCFMAT1 **********************************07490801
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 07500801
C**** 07510801
80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07520801
1D17.10,/," ",16X,"CORRECT= " ,D17.10) 07530801
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 07540801
80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 07550801
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 07560801
80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 07570801
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 07580801
80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 07590801
80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07600801
1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 07610801
2"(",F12.5,", ",F12.5,")") 07620801
CBE** ********************** BBCFMAT1 **********************************07630801
CBB** ********************** BBCFMT0B **********************************07640801
C**** FORMAT STATEMENTS FOR PAGE HEADERS 07650801
C**** 07660801
90002 FORMAT ("1") 07670801
90004 FORMAT (" ") 07680801
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )07690801
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07700801
90008 FORMAT (" ",21X,A13,A17) 07710801
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 07720801
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 07730801
90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 07740801
1 7X,"REMARKS",24X) 07750801
90014 FORMAT (" ","----------------------------------------------" , 07760801
1 "---------------------------------" ) 07770801
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 07780801
C**** 07790801
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 07800801
C**** 07810801
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 07820801
90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 07830801
1 A13) 07840801
90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 07850801
C**** 07860801
C**** FORMAT STATEMENTS FOR RUN SUMMARY 07870801
C**** 07880801
90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 07890801
90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 07900801
90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 07910801
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 07920801
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 07930801
CBE** ********************** BBCFMT0B **********************************07940801
C***** 07950801
C***** END OF TEST SEGMENT 155 07960801
STOP 07970801
END 07980801
07990801