PROGRAM FM355 C***********************************************************************00010355 C***** FORTRAN 77 00020355 C***** FM355 XAINT - (154) 00030355 C***** 00040355 C***********************************************************************00050355 C***** GENERAL PURPOSE SUBSET REF00060355 C***** TEST INTRINSIC FUNCTIONS AINT, ANINT, NINT 15.3 00070355 C***** TRUNCATION (SIGN OF A * LARGEST INTEGER LE ABS(A) ) (TABLE 5)00080355 C***** 00090355 C***** GENERAL COMMENTS 00100355 C***** FLOAT FUNCTION ASSUMED WORKING 00110355 C***** 00120355 CBB** ********************** BBCCOMNT **********************************00130355 C**** 00140355 C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150355 C**** VERSION 2.1 00160355 C**** 00170355 C**** 00180355 C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190355 C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200355 C**** SOFTWARE STANDARDS VALIDATION GROUP 00210355 C**** BUILDING 225 RM A266 00220355 C**** GAITHERSBURG, MD 20899 00230355 C**** 00240355 C**** 00250355 C**** 00260355 CBE** ********************** BBCCOMNT **********************************00270355 CBB** ********************** BBCINITA **********************************00280355 C**** SPECIFICATION STATEMENTS 00290355 C**** 00300355 CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00310355 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00320355 CBE** ********************** BBCINITA **********************************00330355 CBB** ********************** BBCINITB **********************************00340355 C**** INITIALIZE SECTION 00350355 DATA ZVERS, ZVERSD, ZDATE 00360355 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00370355 DATA ZCOMPL, ZNAME, ZTAPE 00380355 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00390355 DATA ZPROJ, ZTAPED, ZPROG 00400355 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00410355 DATA REMRKS /' '/ 00420355 C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00430355 C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00440355 C**** 00450355 CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00460355 CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00470355 CZ03 ZPROG = 'PROGRAM NAME' 00480355 CZ04 ZDATE = 'DATE OF TEST' 00490355 CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00500355 CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00510355 CZ07 ZNAME = 'NAME OF USER' 00520355 CZ08 ZTAPE = 'TAPE OWNER/ID' 00530355 CZ09 ZTAPED = 'DATE TAPE COPIED' 00540355 C 00550355 IVPASS = 0 00560355 IVFAIL = 0 00570355 IVDELE = 0 00580355 IVINSP = 0 00590355 IVTOTL = 0 00600355 IVTOTN = 0 00610355 ICZERO = 0 00620355 C 00630355 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00640355 I01 = 05 00650355 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00660355 I02 = 06 00670355 C 00680355 CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00690355 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00700355 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00710355 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00720355 C 00730355 CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00740355 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00750355 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00760355 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00770355 C 00780355 CBE** ********************** BBCINITB **********************************00790355 NUVI = I02 00800355 IVTOTL = 48 00810355 ZPROG = 'FM355' 00820355 CBB** ********************** BBCHED0A **********************************00830355 C**** 00840355 C**** WRITE REPORT TITLE 00850355 C**** 00860355 WRITE (I02, 90002) 00870355 WRITE (I02, 90006) 00880355 WRITE (I02, 90007) 00890355 WRITE (I02, 90008) ZVERS, ZVERSD 00900355 WRITE (I02, 90009) ZPROG, ZPROG 00910355 WRITE (I02, 90010) ZDATE, ZCOMPL 00920355 CBE** ********************** BBCHED0A **********************************00930355 C***** 00940355 C***** HEADER FOR SEGMENT 154 00950355 WRITE (NUVI,15401) 00960355 15401 FORMAT (" ", // 2X,"XAINT - (154) INTRINSIC FUNCTIONS--" //10X,00970355 1 "AINT, ANINT, NINT (TYPE CONVERSION) " // 00980355 2 " SUBSET REF. - 15.3" ) 00990355 CBB** ********************** BBCHED0B **********************************01000355 C**** WRITE DETAIL REPORT HEADERS 01010355 C**** 01020355 WRITE (I02,90004) 01030355 WRITE (I02,90004) 01040355 WRITE (I02,90013) 01050355 WRITE (I02,90014) 01060355 WRITE (I02,90015) IVTOTL 01070355 CBE** ********************** BBCHED0B **********************************01080355 C***** 01090355 C***** TEST OF AINT 01100355 C***** 01110355 WRITE(NUVI, 15402) 01120355 15402 FORMAT (/ 8X, "TEST OF AINT" ) 01130355 CT001* TEST 1 THE VALUE ZERO 01140355 IVTNUM = 1 01150355 RCBVS = 0.0 01160355 RCAVS = AINT(RCBVS) 01170355 IF (RCAVS + 0.00005) 20010, 10010, 40010 01180355 40010 IF (RCAVS - 0.00005) 10010, 10010, 20010 01190355 10010 IVPASS = IVPASS + 1 01200355 WRITE (NUVI, 80002) IVTNUM 01210355 GO TO 0011 01220355 20010 IVFAIL = IVFAIL + 1 01230355 RVCORR = 0.0 01240355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 01250355 0011 CONTINUE 01260355 CT002* TEST 2 ZERO PREFIXED WITH A MINUS SIGN 01270355 IVTNUM = 2 01280355 RCDVS = -0.0 01290355 RCAVS = AINT(RCBVS) 01300355 IF (RCAVS + 0.00005) 20020, 10020, 40020 01310355 40020 IF (RCAVS - 0.00005) 10020, 10020, 20020 01320355 10020 IVPASS = IVPASS + 1 01330355 WRITE (NUVI, 80002) IVTNUM 01340355 GO TO 0021 01350355 20020 IVFAIL = IVFAIL + 1 01360355 RVCORR = -0.0 01370355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 01380355 0021 CONTINUE 01390355 CT003* TEST 3 A VALUE IN (0,1) 01400355 IVTNUM = 3 01410355 RCDVS = 0.375 01420355 RCAVS = AINT(RCBVS) 01430355 IF (RCAVS + 0.00005) 20030, 10030, 40030 01440355 40030 IF (RCAVS - 0.00005) 10030, 10030, 20030 01450355 10030 IVPASS = IVPASS + 1 01460355 WRITE (NUVI, 80002) IVTNUM 01470355 GO TO 0031 01480355 20030 IVFAIL = IVFAIL + 1 01490355 RVCORR = 0.0 01500355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 01510355 0031 CONTINUE 01520355 CT004* TEST 4 THE VALUE 1 01530355 IVTNUM = 4 01540355 RCBVS = FLOAT(1) 01550355 RCAVS = AINT(RCBVS) 01560355 IF (RCAVS - 0.99995) 20040, 10040, 40040 01570355 40040 IF (RCAVS - 1.0001) 10040, 10040, 20040 01580355 10040 IVPASS = IVPASS + 1 01590355 WRITE (NUVI, 80002) IVTNUM 01600355 GO TO 0041 01610355 20040 IVFAIL = IVFAIL + 1 01620355 RVCORR = 1.0 01630355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 01640355 0041 CONTINUE 01650355 CT005* TEST 5 AN INTEGRAL VALUE OTHER THAN 0, 1 01660355 IVTNUM = 5 01670355 RCBVS = FLOAT(6) 01680355 RCAVS = AINT(RCBVS) 01690355 IF (RCAVS - 5.9997) 20050, 10050, 40050 01700355 40050 IF (RCAVS - 6.0003) 10050, 10050, 20050 01710355 10050 IVPASS = IVPASS + 1 01720355 WRITE (NUVI, 80002) IVTNUM 01730355 GO TO 0051 01740355 20050 IVFAIL = IVFAIL + 1 01750355 RVCORR = 6.0 01760355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 01770355 0051 CONTINUE 01780355 CT006* TEST 6 A VALUE IN (X,X+1) 01790355 IVTNUM = 6 01800355 RCBVS = 3.75 01810355 RCAVS = AINT(RCBVS) 01820355 IF (RCAVS - 2.9998) 20060, 10060, 40060 01830355 40060 IF (RCAVS - 3.0002) 10060, 10060, 20060 01840355 10060 IVPASS = IVPASS + 1 01850355 WRITE (NUVI, 80002) IVTNUM 01860355 GO TO 0061 01870355 20060 IVFAIL = IVFAIL + 1 01880355 RVCORR = 3.0 01890355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 01900355 0061 CONTINUE 01910355 CT007* TEST 7 A NEGATIVE VALUE WITH MAGNITUDE IN (0,1) 01920355 IVTNUM = 7 01930355 RCBVS = -0.375 01940355 RCAVS = AINT(RCBVS) 01950355 IF (RCAVS + 0.00005) 20070, 10070, 40070 01960355 40070 IF (RCAVS - 0.00005) 10070, 10070, 20070 01970355 10070 IVPASS = IVPASS + 1 01980355 WRITE (NUVI, 80002) IVTNUM 01990355 GO TO 0071 02000355 20070 IVFAIL = IVFAIL + 1 02010355 RVCORR = 0.0 02020355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02030355 0071 CONTINUE 02040355 CT008* TEST 8 THE VALUE -1 02050355 IVTNUM = 8 02060355 RCBVS = FLOAT(-1) 02070355 RCAVS = AINT(RCBVS) 02080355 IF (RCAVS + 1.0001) 20080, 10080, 40080 02090355 40080 IF (RCAVS + 0.99995) 10080, 10080, 20080 02100355 10080 IVPASS = IVPASS + 1 02110355 WRITE (NUVI, 80002) IVTNUM 02120355 GO TO 0081 02130355 20080 IVFAIL = IVFAIL + 1 02140355 RVCORR = -1.0 02150355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02160355 0081 CONTINUE 02170355 CT009* TEST 9 A NEGATIVE INTEGRAL VALUE 02180355 IVTNUM = 9 02190355 RCBVS = FLOAT(-6) 02200355 RCAVS = AINT(RCBVS) 02210355 IF (RCAVS + 6.0003) 20090, 10090, 40090 02220355 40090 IF (RCAVS + 5.9997) 10090, 10090, 20090 02230355 10090 IVPASS = IVPASS + 1 02240355 WRITE (NUVI, 80002) IVTNUM 02250355 GO TO 0091 02260355 20090 IVFAIL = IVFAIL + 1 02270355 RVCORR = -6.0 02280355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02290355 0091 CONTINUE 02300355 CT010* TEST 10 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+1) 02310355 IVTNUM = 10 02320355 RCBVS = -3.75 02330355 RCAVS = AINT(RCBVS) 02340355 IF (RCAVS + 3.0002) 20100, 10100, 40100 02350355 40100 IF (RCAVS + 2.9998) 10100, 10100, 20100 02360355 10100 IVPASS = IVPASS + 1 02370355 WRITE (NUVI, 80002) IVTNUM 02380355 GO TO 0101 02390355 20100 IVFAIL = IVFAIL + 1 02400355 RVCORR = -3.0 02410355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02420355 0101 CONTINUE 02430355 CT011* TEST 11 AN ARITHMETIC EXPRESSION PRESENTED TO AINT 02440355 IVTNUM = 11 02450355 RCBVS = 3.25 02460355 RCDVS = 3.0 02470355 RCAVS = AINT(FLOAT(25) + RCDVS * RCBVS) 02480355 IF (RCAVS - 33.998) 20110, 10110, 40110 02490355 40110 IF (RCAVS - 34.002) 10110, 10110, 20110 02500355 10110 IVPASS = IVPASS + 1 02510355 WRITE (NUVI, 80002) IVTNUM 02520355 GO TO 0111 02530355 20110 IVFAIL = IVFAIL + 1 02540355 RVCORR = 34.0 02550355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02560355 0111 CONTINUE 02570355 CT012* TEST 12 AN ARGUMENT OF LOW MAGNITUDE 02580355 IVTNUM = 12 02590355 RCBVS = 3.7521E-36 02600355 RCAVS = AINT(RCBVS) 02610355 IF (RCAVS + 0.00005) 20120, 10120, 40120 02620355 40120 IF (RCAVS - 0.00005) 10120, 10120, 20120 02630355 10120 IVPASS = IVPASS + 1 02640355 WRITE (NUVI, 80002) IVTNUM 02650355 GO TO 0121 02660355 20120 IVFAIL = IVFAIL + 1 02670355 RVCORR = 0.0 02680355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02690355 0121 CONTINUE 02700355 C***** 02710355 WRITE(NUVI, 90002) 02720355 WRITE(NUVI, 90013) 02730355 WRITE(NUVI, 90014) 02740355 C***** 02750355 C***** TEST OF ANINT 02760355 C***** 02770355 WRITE(NUVI, 15404) 02780355 15404 FORMAT (/ 08X, "TEST OF ANINT" ) 02790355 C***** 02800355 CT013* TEST 13 THE VALUE ZERO 02810355 IVTNUM = 13 02820355 RCBVS = 0.0 02830355 RCAVS = ANINT(RCBVS) 02840355 IF (RCAVS + 0.00005) 20130, 10130, 40130 02850355 40130 IF (RCAVS - 0.00005) 10130, 10130, 20130 02860355 10130 IVPASS = IVPASS + 1 02870355 WRITE (NUVI, 80002) IVTNUM 02880355 GO TO 0131 02890355 20130 IVFAIL = IVFAIL + 1 02900355 RVCORR = 0.0 02910355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02920355 0131 CONTINUE 02930355 CT014* TEST 14 THE VALUE ZERO PREFIXED WITH A MINUS SIGN 02940355 IVTNUM = 14 02950355 RCDVS = 0.0 02960355 RCAVS = ANINT(-RCBVS) 02970355 IF (RCAVS + 0.00005) 20140, 10140, 40140 02980355 40140 IF (RCAVS - 0.00005) 10140, 10140, 20140 02990355 10140 IVPASS = IVPASS + 1 03000355 WRITE (NUVI, 80002) IVTNUM 03010355 GO TO 0141 03020355 20140 IVFAIL = IVFAIL + 1 03030355 RVCORR = 0.0 03040355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03050355 0141 CONTINUE 03060355 CT015* TEST 15 A VALUE IN (0,.5) 03070355 IVTNUM = 15 03080355 RCBVS = 0.25 03090355 RCAVS = ANINT(RCBVS) 03100355 IF (RCAVS + 0.00005) 20150, 10150, 40150 03110355 40150 IF (RCAVS - 0.00005) 10150, 10150, 20150 03120355 10150 IVPASS = IVPASS + 1 03130355 WRITE (NUVI, 80002) IVTNUM 03140355 GO TO 0151 03150355 20150 IVFAIL = IVFAIL + 1 03160355 RVCORR = 0.0 03170355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03180355 0151 CONTINUE 03190355 CT016* TEST 16 THE VALUE 0.5 03200355 IVTNUM = 16 03210355 RCBVS = FLOAT(1) / FLOAT(2) 03220355 RCAVS = ANINT(RCBVS) 03230355 IF (RCAVS - 0.99995) 20160, 10160, 40160 03240355 40160 IF (RCAVS - 1.0001) 10160, 10160, 20160 03250355 10160 IVPASS = IVPASS + 1 03260355 WRITE (NUVI, 80002) IVTNUM 03270355 GO TO 0161 03280355 20160 IVFAIL = IVFAIL + 1 03290355 RVCORR = 1.0 03300355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03310355 0161 CONTINUE 03320355 CT017* TEST 17 A VALUE IN (.5,1) 03330355 IVTNUM = 17 03340355 RCBVS = 0.75 03350355 RCAVS = ANINT(RCBVS) 03360355 IF (RCAVS - 0.99995) 20170, 10170, 40170 03370355 40170 IF (RCAVS - 1.0001) 10170, 10170, 20170 03380355 10170 IVPASS = IVPASS + 1 03390355 WRITE (NUVI, 80002) IVTNUM 03400355 GO TO 0171 03410355 20170 IVFAIL = IVFAIL + 1 03420355 RVCORR = 1.0 03430355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03440355 0171 CONTINUE 03450355 CT018* TEST 18 AN INTEGRAL VALUE OTHER THAN 0,1 03460355 IVTNUM = 18 03470355 RCBVS = FLOAT(5) 03480355 RCAVS = ANINT(RCBVS) 03490355 IF (RCAVS - 4.9997) 20180, 10180, 40180 03500355 40180 IF (RCAVS - 5.0003) 10180, 10180, 20180 03510355 10180 IVPASS = IVPASS + 1 03520355 WRITE (NUVI, 80002) IVTNUM 03530355 GO TO 0181 03540355 20180 IVFAIL = IVFAIL + 1 03550355 RVCORR = 5.0 03560355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03570355 0181 CONTINUE 03580355 CT019* TEST 19 A VALUE IN (X,X+.5) 03590355 IVTNUM = 19 03600355 RCBVS = 10.46875 03610355 RCAVS = ANINT(RCBVS) 03620355 IF (RCAVS - 9.9995) 20190, 10190, 40190 03630355 40190 IF (RCAVS - 10.001) 10190, 10190, 20190 03640355 10190 IVPASS = IVPASS + 1 03650355 WRITE (NUVI, 80002) IVTNUM 03660355 GO TO 0191 03670355 20190 IVFAIL = IVFAIL + 1 03680355 RVCORR = 10.0 03690355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03700355 0191 CONTINUE 03710355 CT020* TEST 20 A VALUE WITH FRACTIONAL PART OF 0.5 03720355 IVTNUM = 20 03730355 RCBVS = FLOAT(16) - FLOAT(1) / FLOAT(2) 03740355 RCAVS = ANINT(RCBVS) 03750355 IF (RCAVS - 15.999) 20200, 10200, 40200 03760355 40200 IF (RCAVS - 16.001) 10200, 10200, 20200 03770355 10200 IVPASS = IVPASS + 1 03780355 WRITE (NUVI, 80002) IVTNUM 03790355 GO TO 0201 03800355 20200 IVFAIL = IVFAIL + 1 03810355 RVCORR = 16.0 03820355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03830355 0201 CONTINUE 03840355 CT021* TEST 21 A VALUE IN (X+.5,X+1) 03850355 IVTNUM = 21 03860355 RCBVS = 27.96875 03870355 RCAVS = ANINT(RCBVS) 03880355 IF (RCAVS - 27.998) 20210, 10210, 40210 03890355 40210 IF (RCAVS - 28.002) 10210, 10210, 20210 03900355 10210 IVPASS = IVPASS + 1 03910355 WRITE (NUVI, 80002) IVTNUM 03920355 GO TO 0211 03930355 20210 IVFAIL = IVFAIL + 1 03940355 RVCORR = 28.0 03950355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03960355 0211 CONTINUE 03970355 CT022* TEST 22 A NEGATIVE VALUE WITH MAGNITUDE IN (0,.5) 03980355 IVTNUM = 22 03990355 RCBVS = -0.25 04000355 RCAVS = ANINT(RCBVS) 04010355 IF (RCAVS + 0.00005) 20220, 10220, 40220 04020355 40220 IF (RCAVS - 0.00005) 10220, 10220, 20220 04030355 10220 IVPASS = IVPASS + 1 04040355 WRITE (NUVI, 80002) IVTNUM 04050355 GO TO 0221 04060355 20220 IVFAIL = IVFAIL + 1 04070355 RVCORR = -0.0 04080355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04090355 0221 CONTINUE 04100355 CT023* TEST 23 THE VALUE -0.5 04110355 IVTNUM = 23 04120355 RCBVS = FLOAT(-1) / FLOAT(2) 04130355 RCAVS = ANINT(RCBVS) 04140355 IF (RCAVS + 1.0001) 20230, 10230, 40230 04150355 40230 IF (RCAVS + 0.99995) 10230, 10230, 20230 04160355 10230 IVPASS = IVPASS + 1 04170355 WRITE (NUVI, 80002) IVTNUM 04180355 GO TO 0231 04190355 20230 IVFAIL = IVFAIL + 1 04200355 RVCORR = -1.0 04210355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04220355 0231 CONTINUE 04230355 CT024* TEST 24 A NEGATIVE VALUE WITH MAGNITUDE IN (.5,1) 04240355 IVTNUM = 24 04250355 RCBVS = -0.75 04260355 RCAVS = ANINT(RCBVS) 04270355 IF (RCAVS + 1.0001) 20240, 10240, 40240 04280355 40240 IF (RCAVS + 0.99995) 10240, 10240, 20240 04290355 10240 IVPASS = IVPASS + 1 04300355 WRITE (NUVI, 80002) IVTNUM 04310355 GO TO 0241 04320355 20240 IVFAIL = IVFAIL + 1 04330355 RVCORR = -1.0 04340355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04350355 0241 CONTINUE 04360355 CT025* TEST 25 A NEGATIVE INTEGRAL VALUE 04370355 IVTNUM = 25 04380355 RCBVS = FLOAT(-5) 04390355 RCAVS = ANINT(RCBVS) 04400355 IF (RCAVS + 5.0003) 20250, 10250, 40250 04410355 40250 IF (RCAVS + 4.9997) 10250, 10250, 20250 04420355 10250 IVPASS = IVPASS + 1 04430355 WRITE (NUVI, 80002) IVTNUM 04440355 GO TO 0251 04450355 20250 IVFAIL = IVFAIL + 1 04460355 RVCORR = -5.0 04470355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04480355 0251 CONTINUE 04490355 CT026* TEST 26 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+.5) 04500355 IVTNUM = 26 04510355 RCBVS = -10.46875 04520355 RCAVS = ANINT(RCBVS) 04530355 IF (RCAVS + 10.001) 20260, 10260, 40260 04540355 40260 IF (RCAVS + 9.9995) 10260, 10260, 20260 04550355 10260 IVPASS = IVPASS + 1 04560355 WRITE (NUVI, 80002) IVTNUM 04570355 GO TO 0261 04580355 20260 IVFAIL = IVFAIL + 1 04590355 RVCORR = -10.0 04600355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04610355 0261 CONTINUE 04620355 CT027* TEST 27 A NEGATIVE VALUE WITH FRACTIONAL COMPONENT .5 04630355 IVTNUM = 27 04640355 RCBVS = FLOAT(-15) - FLOAT(1) / FLOAT(2) 04650355 RCAVS = ANINT(RCBVS) 04660355 IF (RCAVS + 16.001) 20270, 10270, 40270 04670355 40270 IF (RCAVS + 15.999) 10270, 10270, 20270 04680355 10270 IVPASS = IVPASS + 1 04690355 WRITE (NUVI, 80002) IVTNUM 04700355 GO TO 0271 04710355 20270 IVFAIL = IVFAIL + 1 04720355 RVCORR = -16.0 04730355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04740355 0271 CONTINUE 04750355 CT028* TEST 28 A NEGATIVE VALUE WITH MAGNITUDE IN (X+.5,X+1) 04760355 IVTNUM = 28 04770355 RCBVS = -27.96875 04780355 RCAVS = ANINT(RCBVS) 04790355 IF (RCAVS + 28.002) 20280, 10280, 40280 04800355 40280 IF (RCAVS + 27.998) 10280, 10280, 20280 04810355 10280 IVPASS = IVPASS + 1 04820355 WRITE (NUVI, 80002) IVTNUM 04830355 GO TO 0281 04840355 20280 IVFAIL = IVFAIL + 1 04850355 RVCORR = -28.0 04860355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04870355 0281 CONTINUE 04880355 CT029* TEST 29 AN ARITHMETIC EXPRESSION PRESENTED TO ANINT 04890355 IVTNUM = 29 04900355 RCDVS = 8.00 04910355 RCBVS = 7.25 04920355 RCAVS = ANINT(RCDVS - RCBVS) 04930355 IF (RCAVS - 0.99995) 20290, 10290, 40290 04940355 40290 IF (RCAVS - 1.0001) 10290, 10290, 20290 04950355 10290 IVPASS = IVPASS + 1 04960355 WRITE (NUVI, 80002) IVTNUM 04970355 GO TO 0291 04980355 20290 IVFAIL = IVFAIL + 1 04990355 RVCORR = 1.0 05000355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 05010355 0291 CONTINUE 05020355 CT030* TEST 30 AN ARGUMENT OF LOW MAGNITUDE 05030355 IVTNUM = 30 05040355 RCBVS = -5.9876E-35 05050355 RCAVS = ANINT(RCBVS) 05060355 IF (RCAVS + 0.00005) 20300, 10300, 40300 05070355 40300 IF (RCAVS - 0.00005) 10300, 10300, 20300 05080355 10300 IVPASS = IVPASS + 1 05090355 WRITE (NUVI, 80002) IVTNUM 05100355 GO TO 0301 05110355 20300 IVFAIL = IVFAIL + 1 05120355 RVCORR = 0.0 05130355 WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 05140355 0301 CONTINUE 05150355 C***** 05160355 WRITE(NUVI, 90002) 05170355 WRITE(NUVI, 90013) 05180355 WRITE(NUVI, 90014) 05190355 C***** 05200355 C***** TEST OF NINT 05210355 C***** 05220355 WRITE(NUVI, 15405) 05230355 15405 FORMAT (/ 8X, "TEST OF NINT" ) 05240355 C***** 05250355 CT031* TEST 31 THE VALUE ZERO 05260355 IVTNUM = 31 05270355 RCBVS = 0.0 05280355 ICAVI = NINT(RCBVS) 05290355 IF (ICAVI - 0) 20310, 10310, 20310 05300355 10310 IVPASS = IVPASS + 1 05310355 WRITE (NUVI, 80002) IVTNUM 05320355 GO TO 0311 05330355 20310 IVFAIL = IVFAIL + 1 05340355 IVCORR = 0 05350355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 05360355 0311 CONTINUE 05370355 CT032* TEST 32 ZERO PREFIXED WITH A MINUS SIGN 05380355 IVTNUM = 32 05390355 RCDVS = 0.0 05400355 ICAVI = NINT(-RCDVS) 05410355 IF (ICAVI - 0) 20320, 10320, 20320 05420355 10320 IVPASS = IVPASS + 1 05430355 WRITE (NUVI, 80002) IVTNUM 05440355 GO TO 0321 05450355 20320 IVFAIL = IVFAIL + 1 05460355 IVCORR = 0 05470355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 05480355 0321 CONTINUE 05490355 CT033* TEST 33 A VALUE IN (0,.5) 05500355 IVTNUM = 33 05510355 RCBVS = 0.25 05520355 ICAVI = NINT(RCBVS) 05530355 IF (ICAVI - 0) 20330, 10330, 20330 05540355 10330 IVPASS = IVPASS + 1 05550355 WRITE (NUVI, 80002) IVTNUM 05560355 GO TO 0331 05570355 20330 IVFAIL = IVFAIL + 1 05580355 IVCORR = 0 05590355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 05600355 0331 CONTINUE 05610355 CT034* TEST 34 THE VALUE 0.5 05620355 IVTNUM = 34 05630355 RCBVS = FLOAT(1) / FLOAT(2) 05640355 ICAVI = NINT(RCBVS) 05650355 IF (ICAVI - 1) 20340, 10340, 20340 05660355 10340 IVPASS = IVPASS + 1 05670355 WRITE (NUVI, 80002) IVTNUM 05680355 GO TO 0341 05690355 20340 IVFAIL = IVFAIL + 1 05700355 IVCORR = 1 05710355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 05720355 0341 CONTINUE 05730355 CT035* TEST 35 A VALUE IN (.5,1) 05740355 IVTNUM = 35 05750355 RCBVS = 0.75 05760355 ICAVI = NINT(RCBVS) 05770355 IF (ICAVI - 1) 20350, 10350, 20350 05780355 10350 IVPASS = IVPASS + 1 05790355 WRITE (NUVI, 80002) IVTNUM 05800355 GO TO 0351 05810355 20350 IVFAIL = IVFAIL + 1 05820355 IVCORR = 1 05830355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 05840355 0351 CONTINUE 05850355 CT036* TEST 36 AN INTEGRAL VALUE OTHER THAN 0, 1 05860355 IVTNUM = 36 05870355 RCBVS = FLOAT(5) 05880355 ICAVI = NINT(RCBVS) 05890355 IF (ICAVI - 5) 20360, 10360, 20360 05900355 10360 IVPASS = IVPASS + 1 05910355 WRITE (NUVI, 80002) IVTNUM 05920355 GO TO 0361 05930355 20360 IVFAIL = IVFAIL + 1 05940355 IVCORR = 5 05950355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 05960355 0361 CONTINUE 05970355 CT037* TEST 37 A VALUE IN (X,X+.5) 05980355 IVTNUM = 37 05990355 RCBVS = 10.46875 06000355 ICAVI = NINT(RCBVS) 06010355 IF (ICAVI - 10) 20370, 10370, 20370 06020355 10370 IVPASS = IVPASS + 1 06030355 WRITE (NUVI, 80002) IVTNUM 06040355 GO TO 0371 06050355 20370 IVFAIL = IVFAIL + 1 06060355 IVCORR = 10 06070355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06080355 0371 CONTINUE 06090355 CT038* TEST 38 A VALUE WITH FRACTIONAL PART OF 0.5 06100355 IVTNUM = 38 06110355 RCBVS = FLOAT(15) + FLOAT(1) / FLOAT(2) 06120355 ICAVI = NINT(RCBVS) 06130355 IF (ICAVI - 16) 20380, 10380, 20380 06140355 10380 IVPASS = IVPASS + 1 06150355 WRITE (NUVI, 80002) IVTNUM 06160355 GO TO 0381 06170355 20380 IVFAIL = IVFAIL + 1 06180355 IVCORR = 16 06190355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06200355 0381 CONTINUE 06210355 CT039* TEST 39 A VALUE IN (X+.5,X+1) 06220355 IVTNUM = 39 06230355 RCBVS = 27.96875 06240355 ICAVI = NINT(RCBVS) 06250355 IF (ICAVI - 28) 20390, 10390, 20390 06260355 10390 IVPASS = IVPASS + 1 06270355 WRITE (NUVI, 80002) IVTNUM 06280355 GO TO 0391 06290355 20390 IVFAIL = IVFAIL + 1 06300355 IVCORR = 28 06310355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06320355 0391 CONTINUE 06330355 CT040* TEST 40 A NEGATIVE VALUE WITH MAGNITUDE IN (0.,5) 06340355 IVTNUM = 40 06350355 RCBVS = -0.25 06360355 ICAVI = NINT(RCBVS) 06370355 IF (ICAVI - 0) 20400, 10400, 20400 06380355 10400 IVPASS = IVPASS + 1 06390355 WRITE (NUVI, 80002) IVTNUM 06400355 GO TO 0401 06410355 20400 IVFAIL = IVFAIL + 1 06420355 IVCORR = 0 06430355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06440355 0401 CONTINUE 06450355 CT041* TEST 41 THE VALUE -0.5 06460355 IVTNUM = 41 06470355 RCBVS = FLOAT(-1) / FLOAT(2) 06480355 ICAVI = NINT(RCBVS) 06490355 IF (ICAVI + 1) 20410, 10410, 20410 06500355 10410 IVPASS = IVPASS + 1 06510355 WRITE (NUVI, 80002) IVTNUM 06520355 GO TO 0411 06530355 20410 IVFAIL = IVFAIL + 1 06540355 IVCORR = -1 06550355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06560355 0411 CONTINUE 06570355 CT042* TEST 42 A NEGATIVE VALUE WITH MAGNITUDE IN (.5,1) 06580355 IVTNUM = 42 06590355 RCBVS = -0.75 06600355 ICAVI = NINT(RCBVS) 06610355 IF (ICAVI + 1) 20420, 10420, 20420 06620355 10420 IVPASS = IVPASS + 1 06630355 WRITE (NUVI, 80002) IVTNUM 06640355 GO TO 0421 06650355 20420 IVFAIL = IVFAIL + 1 06660355 IVCORR = -1 06670355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06680355 0421 CONTINUE 06690355 CT043* TEST 43 A NEGATIVE INTEGRAL VALUE 06700355 IVTNUM = 43 06710355 RCBVS = FLOAT(-5) 06720355 ICAVI = NINT(RCBVS) 06730355 IF (ICAVI + 5) 20430, 10430, 20430 06740355 10430 IVPASS = IVPASS + 1 06750355 WRITE (NUVI, 80002) IVTNUM 06760355 GO TO 0431 06770355 20430 IVFAIL = IVFAIL + 1 06780355 IVCORR = -5 06790355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06800355 0431 CONTINUE 06810355 CT044* TEST 44 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+.5) 06820355 IVTNUM = 44 06830355 RCBVS = -10.46875 06840355 ICAVI = NINT(RCBVS) 06850355 IF (ICAVI + 10) 20440, 10440, 20440 06860355 10440 IVPASS = IVPASS + 1 06870355 WRITE (NUVI, 80002) IVTNUM 06880355 GO TO 0441 06890355 20440 IVFAIL = IVFAIL + 1 06900355 IVCORR = -10 06910355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06920355 0441 CONTINUE 06930355 CT045* TEST 45 A NEGATIVE VALUE WITH FRACTIONAL COMPONENT 0.5 S106940355 IVTNUM = 45 06950355 RCBVS = FLOAT(-15) - FLOAT(1) / FLOAT(2) 06960355 ICAVI = NINT(RCBVS) 06970355 IF (ICAVI + 16) 20450, 10450, 20450 06980355 10450 IVPASS = IVPASS + 1 06990355 WRITE (NUVI, 80002) IVTNUM 07000355 GO TO 0451 07010355 20450 IVFAIL = IVFAIL + 1 07020355 IVCORR = -16 07030355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 07040355 0451 CONTINUE 07050355 CT046* TEST 46 A NEGATIVE VALUE WITH MAGNITUDE IN (X+.5,X+1) S107060355 IVTNUM = 46 07070355 RCBVS = -27.96875 07080355 ICAVI = NINT(RCBVS) 07090355 IF (ICAVI + 28) 20460, 10460, 20460 07100355 10460 IVPASS = IVPASS + 1 07110355 WRITE (NUVI, 80002) IVTNUM 07120355 GO TO 0461 07130355 20460 IVFAIL = IVFAIL + 1 07140355 IVCORR = -28 07150355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 07160355 0461 CONTINUE 07170355 CT047* TEST 47 AN ARITHMETIC EXPRESSION PRESENTED TO NINT S107180355 IVTNUM = 47 07190355 RCDVS = 8.00 07200355 RCEVS = 7.25 07210355 ICAVI = NINT(RCDVS - RCEVS) 07220355 IF (ICAVI - 1) 20470, 10470, 20470 07230355 10470 IVPASS = IVPASS + 1 07240355 WRITE (NUVI, 80002) IVTNUM 07250355 GO TO 0471 07260355 20470 IVFAIL = IVFAIL + 1 07270355 IVCORR = 1 07280355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 07290355 0471 CONTINUE 07300355 CT048* TEST 48 AN ARGUMENT OF LOW MAGNITUDE 07310355 IVTNUM = 48 07320355 RCBVS = -5.9876E-33 07330355 ICAVI = NINT(RCBVS) 07340355 IF (ICAVI - 0) 20480, 10480, 20480 07350355 10480 IVPASS = IVPASS + 1 07360355 WRITE (NUVI, 80002) IVTNUM 07370355 GO TO 0481 07380355 20480 IVFAIL = IVFAIL + 1 07390355 IVCORR = 0 07400355 WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 07410355 0481 CONTINUE 07420355 C***** 07430355 CBB** ********************** BBCSUM0 **********************************07440355 C**** WRITE OUT TEST SUMMARY 07450355 C**** 07460355 IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 07470355 WRITE (I02, 90004) 07480355 WRITE (I02, 90014) 07490355 WRITE (I02, 90004) 07500355 WRITE (I02, 90020) IVPASS 07510355 WRITE (I02, 90022) IVFAIL 07520355 WRITE (I02, 90024) IVDELE 07530355 WRITE (I02, 90026) IVINSP 07540355 WRITE (I02, 90028) IVTOTN, IVTOTL 07550355 CBE** ********************** BBCSUM0 **********************************07560355 CBB** ********************** BBCFOOT0 **********************************07570355 C**** WRITE OUT REPORT FOOTINGS 07580355 C**** 07590355 WRITE (I02,90016) ZPROG, ZPROG 07600355 WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 07610355 WRITE (I02,90019) 07620355 CBE** ********************** BBCFOOT0 **********************************07630355 CBB** ********************** BBCFMT0A **********************************07640355 C**** FORMATS FOR TEST DETAIL LINES 07650355 C**** 07660355 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 07670355 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 07680355 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 07690355 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 07700355 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 07710355 1I6,/," ",15X,"CORRECT= " ,I6) 07720355 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07730355 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 07740355 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07750355 1A21,/," ",16X,"CORRECT= " ,A21) 07760355 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 07770355 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 07780355 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 07790355 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 07800355 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 07810355 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 07820355 80050 FORMAT (" ",48X,A31) 07830355 CBE** ********************** BBCFMT0A **********************************07840355 CBB** ********************** BBCFMT0B **********************************07850355 C**** FORMAT STATEMENTS FOR PAGE HEADERS 07860355 C**** 07870355 90002 FORMAT ("1") 07880355 90004 FORMAT (" ") 07890355 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )07900355 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07910355 90008 FORMAT (" ",21X,A13,A17) 07920355 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 07930355 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 07940355 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 07950355 1 7X,"REMARKS",24X) 07960355 90014 FORMAT (" ","----------------------------------------------" , 07970355 1 "---------------------------------" ) 07980355 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 07990355 C**** 08000355 C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 08010355 C**** 08020355 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 08030355 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 08040355 1 A13) 08050355 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 08060355 C**** 08070355 C**** FORMAT STATEMENTS FOR RUN SUMMARY 08080355 C**** 08090355 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 08100355 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 08110355 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 08120355 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 08130355 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 08140355 CBE** ********************** BBCFMT0B **********************************08150355 C***** 08160355 C***** END OF TEST SEGMENT 154 08170355 STOP 08180355 END 08190355 08200355