PROGRAM FM829 C***********************************************************************00010829 C***** FORTRAN 77 00020829 C***** FM829 00030829 C***** YGEN1 - (206) 00040829 C***** 00050829 C***********************************************************************00060829 C***** TESTING OF GENERIC FUNCTIONS ANS REF 00070829 C***** INT, REAL, DBLE, CMPLX 15.3 00080829 C***** TABLE 5 00090829 CBB** ********************** BBCCOMNT **********************************00100829 C**** 00110829 C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120829 C**** VERSION 2.1 00130829 C**** 00140829 C**** 00150829 C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160829 C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170829 C**** SOFTWARE STANDARDS VALIDATION GROUP 00180829 C**** BUILDING 225 RM A266 00190829 C**** GAITHERSBURG, MD 20899 00200829 C**** 00210829 C**** 00220829 C**** 00230829 CBE** ********************** BBCCOMNT **********************************00240829 C***** 00250829 C***** S P E C I F I C A T I O N S SEGMENT 206 00260829 DOUBLE PRECISION AVD, BVD, CVD, DVCORR 00270829 COMPLEX AVC, BVC, CVC, ZVCORR 00280829 REAL R2E(2) 00290829 EQUIVALENCE (BVC, R2E) 00300829 C***** 00310829 CBB** ********************** BBCINITA **********************************00320829 C**** SPECIFICATION STATEMENTS 00330829 C**** 00340829 CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350829 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360829 CBE** ********************** BBCINITA **********************************00370829 CBB** ********************** BBCINITB **********************************00380829 C**** INITIALIZE SECTION 00390829 DATA ZVERS, ZVERSD, ZDATE 00400829 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410829 DATA ZCOMPL, ZNAME, ZTAPE 00420829 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430829 DATA ZPROJ, ZTAPED, ZPROG 00440829 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450829 DATA REMRKS /' '/ 00460829 C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470829 C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480829 C**** 00490829 CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500829 CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510829 CZ03 ZPROG = 'PROGRAM NAME' 00520829 CZ04 ZDATE = 'DATE OF TEST' 00530829 CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540829 CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550829 CZ07 ZNAME = 'NAME OF USER' 00560829 CZ08 ZTAPE = 'TAPE OWNER/ID' 00570829 CZ09 ZTAPED = 'DATE TAPE COPIED' 00580829 C 00590829 IVPASS = 0 00600829 IVFAIL = 0 00610829 IVDELE = 0 00620829 IVINSP = 0 00630829 IVTOTL = 0 00640829 IVTOTN = 0 00650829 ICZERO = 0 00660829 C 00670829 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680829 I01 = 05 00690829 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700829 I02 = 06 00710829 C 00720829 CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730829 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740829 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750829 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760829 C 00770829 CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780829 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790829 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800829 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810829 C 00820829 CBE** ********************** BBCINITB **********************************00830829 NUVI = I02 00840829 IVTOTL = 35 00850829 ZPROG = 'FM829' 00860829 CBB** ********************** BBCHED0A **********************************00870829 C**** 00880829 C**** WRITE REPORT TITLE 00890829 C**** 00900829 WRITE (I02, 90002) 00910829 WRITE (I02, 90006) 00920829 WRITE (I02, 90007) 00930829 WRITE (I02, 90008) ZVERS, ZVERSD 00940829 WRITE (I02, 90009) ZPROG, ZPROG 00950829 WRITE (I02, 90010) ZDATE, ZCOMPL 00960829 CBE** ********************** BBCHED0A **********************************00970829 C***** 00980829 C***** HEADER FOR SEGMENT 206 00990829 WRITE(NUVI,20600) 01000829 20600 FORMAT( " ", / " YGEN1 - (206) GENERIC FUNCTIONS --" // 01010829 1 " INT, REAL, DBLE, CMPLX" // 01020829 2 " ANS REF. - 15.3" ) 01030829 CBB** ********************** BBCHED0B **********************************01040829 C**** WRITE DETAIL REPORT HEADERS 01050829 C**** 01060829 WRITE (I02,90004) 01070829 WRITE (I02,90004) 01080829 WRITE (I02,90013) 01090829 WRITE (I02,90014) 01100829 WRITE (I02,90015) IVTOTL 01110829 CBE** ********************** BBCHED0B **********************************01120829 C***** 01130829 CT001* TEST 1 TEST OF INT 01140829 C***** WITH INTEGER ARG 01150829 IVTNUM = 1 01160829 LVI = INT(485) 01170829 IF (LVI - 485) 20010, 10010, 20010 01180829 10010 IVPASS = IVPASS + 1 01190829 WRITE (NUVI, 80002) IVTNUM 01200829 GO TO 0011 01210829 20010 IVFAIL = IVFAIL + 1 01220829 IVCORR = 485 01230829 WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01240829 0011 CONTINUE 01250829 CT002* TEST 2 WITH DOUBLE PREC ARG 01260829 IVTNUM = 2 01270829 LVI = INT(1.375D0) 01280829 IF (LVI - 1) 20020, 10020, 20020 01290829 10020 IVPASS = IVPASS + 1 01300829 WRITE (NUVI, 80002) IVTNUM 01310829 GO TO 0021 01320829 20020 IVFAIL = IVFAIL + 1 01330829 IVCORR = 1 01340829 WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01350829 0021 CONTINUE 01360829 CT003* TEST 3 WITH COMPLEX ARG 01370829 IVTNUM = 3 01380829 LVI = INT((1.24, 5.67)) 01390829 IF (LVI - 1) 20030, 10030, 20030 01400829 10030 IVPASS = IVPASS + 1 01410829 WRITE (NUVI, 80002) IVTNUM 01420829 GO TO 0031 01430829 20030 IVFAIL = IVFAIL + 1 01440829 IVCORR = 1 01450829 WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01460829 0031 CONTINUE 01470829 CT004* TEST 4 TEST OF INT AND IFIX 01480829 C***** WITH REAL ARGS 01490829 IVTNUM = 4 01500829 LVI = INT(6.0001) + IFIX(-1.750) 01510829 IF (LVI - 5) 20040, 10040, 20040 01520829 10040 IVPASS = IVPASS + 1 01530829 WRITE (NUVI, 80002) IVTNUM 01540829 GO TO 0041 01550829 20040 IVFAIL = IVFAIL + 1 01560829 IVCORR = 5 01570829 WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01580829 0041 CONTINUE 01590829 CT005* TEST 5 TEST OF INT AND IDINT 01600829 C***** WITH DOUBLE PREC ARGS 01610829 IVTNUM = 5 01620829 AVD = -1.11D1 01630829 LVI = INT(AVD) * IDINT(3.5D0) 01640829 IF (LVI + 33) 20050, 10050, 20050 01650829 10050 IVPASS = IVPASS + 1 01660829 WRITE (NUVI, 80002) IVTNUM 01670829 GO TO 0051 01680829 20050 IVFAIL = IVFAIL + 1 01690829 IVCORR = -33 01700829 WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01710829 0051 CONTINUE 01720829 CT006* TEST 6 INTEGER, REAL, DOUBLE PRECISION, AND COMPLEX 01730829 C***** ARGUMENTS 01740829 IVTNUM = 6 01750829 LVI = INT(-327) + INT(6.75) * INT(123) - INT(6.0001D0) 01760829 1 / IFIX(13.3) + INT((2.4, 3.5)) + IDINT(-3.375D0) 01770829 IF (LVI - 410) 20060, 10060, 20060 01780829 10060 IVPASS = IVPASS + 1 01790829 WRITE (NUVI, 80002) IVTNUM 01800829 GO TO 0061 01810829 20060 IVFAIL = IVFAIL + 1 01820829 IVCORR = 410 01830829 WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01840829 0061 CONTINUE 01850829 CT007* TEST 7 TEST OF REAL 01860829 C***** WITH REAL ARG 01870829 IVTNUM = 7 01880829 AVS = -3.0 01890829 BVS = REAL(AVS) 01900829 IF (BVS + 0.30002E+01) 20070, 10070, 40070 01910829 40070 IF (BVS + 0.29998E+01) 10070, 10070, 20070 01920829 10070 IVPASS = IVPASS + 1 01930829 WRITE (NUVI, 80002) IVTNUM 01940829 GO TO 0071 01950829 20070 IVFAIL = IVFAIL + 1 01960829 RVCORR = -3.0 01970829 WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 01980829 0071 CONTINUE 01990829 CT008* TEST 8 WITH DOUBLE PRECISION 02000829 IVTNUM = 8 02010829 AVD = 0.96875D0 02020829 BVS = REAL(AVD) 02030829 IF (BVS - 0.96870E+00) 20080, 10080, 40080 02040829 40080 IF (BVS - 0.96880E+00) 10080, 10080, 20080 02050829 10080 IVPASS = IVPASS + 1 02060829 WRITE (NUVI, 80002) IVTNUM 02070829 GO TO 0081 02080829 20080 IVFAIL = IVFAIL + 1 02090829 RVCORR = 0.96875 02100829 WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 02110829 0081 CONTINUE 02120829 CT009* TEST 9 WITH COMPLEX 02130829 IVTNUM = 9 02140829 BVS = REAL((2.5, -3.0)) 02150829 IF (BVS - 0.24998E+01) 20090, 10090, 40090 02160829 40090 IF (BVS - 0.25002E+01) 10090, 10090, 20090 02170829 10090 IVPASS = IVPASS + 1 02180829 WRITE (NUVI, 80002) IVTNUM 02190829 GO TO 0091 02200829 20090 IVFAIL = IVFAIL + 1 02210829 RVCORR = 2.5 02220829 WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 02230829 0091 CONTINUE 02240829 CT010* TEST 10 TEST OF REAL AND FLOAT 02250829 IVTNUM = 10 02260829 BVS = REAL(6) + FLOAT(8) 02270829 IF (BVS - 0.13999E+02) 20100, 10100, 40100 02280829 40100 IF (BVS - 0.14001E+02) 10100, 10100, 20100 02290829 10100 IVPASS = IVPASS + 1 02300829 WRITE (NUVI, 80002) IVTNUM 02310829 GO TO 0101 02320829 20100 IVFAIL = IVFAIL + 1 02330829 RVCORR = 14.0 02340829 WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 02350829 0101 CONTINUE 02360829 CT011* TEST 11 TEST OF REAL AND SNGL 02370829 IVTNUM = 11 02380829 AVD = 2.5D0 02390829 BVS = REAL(AVD) + SNGL(0.35875D2) 02400829 IF (BVS - 0.38373E+02) 20110, 10110, 40110 02410829 40110 IF (BVS - 0.38377E+02) 10110, 10110, 20110 02420829 10110 IVPASS = IVPASS + 1 02430829 WRITE (NUVI, 80002) IVTNUM 02440829 GO TO 0111 02450829 20110 IVFAIL = IVFAIL + 1 02460829 RVCORR = 38.375 02470829 WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 02480829 0111 CONTINUE 02490829 CT012* TEST 12 TEST OF REAL, FLOAT, AND SNGL 02500829 IVTNUM = 12 02510829 BVS = REAL(13) + FLOAT(9) * SNGL(0.7625D1) - REAL(2.625D0) + 02520829 1 REAL(3.5) / REAL((2.0, 4.0)) 02530829 IF (BVS - 0.80746E+02) 20120, 10120, 40120 02540829 40120 IF (BVS - 0.80754E+02) 10120, 10120, 20120 02550829 10120 IVPASS = IVPASS + 1 02560829 WRITE (NUVI, 80002) IVTNUM 02570829 GO TO 0121 02580829 20120 IVFAIL = IVFAIL + 1 02590829 RVCORR = 80.75 02600829 WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 02610829 0121 CONTINUE 02620829 CT013* TEST 13 TEST OF DBLE 02630829 C***** WITH INTEGER ARG 02640829 IVTNUM = 13 02650829 LVI = 9 02660829 BVD = DBLE(LVI) 02670829 IF (BVD - 0.89995D+01) 20130, 10130, 40130 02680829 40130 IF (BVD - 0.90005D+01) 10130, 10130, 20130 02690829 10130 IVPASS = IVPASS + 1 02700829 WRITE (NUVI, 80002) IVTNUM 02710829 GO TO 0131 02720829 20130 IVFAIL = IVFAIL + 1 02730829 DVCORR = 9.0D0 02740829 WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 02750829 0131 CONTINUE 02760829 CT014* TEST 14 WITH REAL ARG 02770829 IVTNUM = 14 02780829 AVS = 10.5 02790829 BVD = DBLE(AVS) 02800829 IF (BVD - 0.10499D+02) 20140, 10140, 40140 02810829 40140 IF (BVD - 0.10501D+02) 10140, 10140, 20140 02820829 10140 IVPASS = IVPASS + 1 02830829 WRITE (NUVI, 80002) IVTNUM 02840829 GO TO 0141 02850829 20140 IVFAIL = IVFAIL + 1 02860829 DVCORR = 10.5D0 02870829 WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 02880829 0141 CONTINUE 02890829 CT015* TEST 15 WITH DOUBLE PREC ARG 02900829 IVTNUM = 15 02910829 AVD = 9.9D0 02920829 BVD = DBLE(AVD) 02930829 IF (BVD - 0.9899999995D+01) 20150, 10150, 40150 02940829 40150 IF (BVD - 0.9900000005D+01) 10150, 10150, 20150 02950829 10150 IVPASS = IVPASS + 1 02960829 WRITE (NUVI, 80002) IVTNUM 02970829 GO TO 0151 02980829 20150 IVFAIL = IVFAIL + 1 02990829 DVCORR = 9.9D0 03000829 WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 03010829 0151 CONTINUE 03020829 CT016* TEST 16 WITH COMPLEX ARG 03030829 IVTNUM = 16 03040829 AVC = (2.5, 5.5) 03050829 BVD = DBLE(AVC) 03060829 IF (BVD - 0.24998D+01) 20160, 10160, 40160 03070829 40160 IF (BVD - 0.25002D+01) 10160, 10160, 20160 03080829 10160 IVPASS = IVPASS + 1 03090829 WRITE (NUVI, 80002) IVTNUM 03100829 GO TO 0161 03110829 20160 IVFAIL = IVFAIL + 1 03120829 DVCORR = 2.5D0 03130829 WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 03140829 0161 CONTINUE 03150829 CT017* TEST 17 TEST OF CMPLX WITH ONE ARG 03160829 C***** WITH INTEGER ARG 03170829 IVTNUM = 17 03180829 BVC = CMPLX(9) 03190829 IF (R2E(1) - 0.89995E+01) 20170, 40172, 40171 03200829 40171 IF (R2E(1) - 0.90005E+01) 40172, 40172, 20170 03210829 40172 IF (R2E(2) + 0.50000E-04) 20170, 10170, 40170 03220829 40170 IF (R2E(2) - 0.50000E-04) 10170, 10170, 20170 03230829 10170 IVPASS = IVPASS + 1 03240829 WRITE (NUVI, 80002) IVTNUM 03250829 GO TO 0171 03260829 20170 IVFAIL = IVFAIL + 1 03270829 ZVCORR = (9,0) 03280829 WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 03290829 0171 CONTINUE 03300829 CT018* TEST 18 WITH REAL 03310829 IVTNUM = 18 03320829 BVC = CMPLX(4.093) 03330829 IF (R2E(1) - 0.40928E+01) 20180, 40182, 40181 03340829 40181 IF (R2E(1) - 0.40932E+01) 40182, 40182, 20180 03350829 40182 IF (R2E(2) + 0.50000E-04) 20180, 10180, 40180 03360829 40180 IF (R2E(2) - 0.50000E-04) 10180, 10180, 20180 03370829 10180 IVPASS = IVPASS + 1 03380829 WRITE (NUVI, 80002) IVTNUM 03390829 GO TO 0181 03400829 20180 IVFAIL = IVFAIL + 1 03410829 ZVCORR = (4.093,0.0) 03420829 WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 03430829 0181 CONTINUE 03440829 CT019* TEST 19 WITH DOUBLE PREC ARG 03450829 IVTNUM = 19 03460829 AVD = 0.375D-3 03470829 BVC = CMPLX(AVD) 03480829 IF (R2E(1) - 0.37498E-03) 20190, 40192, 40191 03490829 40191 IF (R2E(1) - 0.37502E-03) 40192, 40192, 20190 03500829 40192 IF (R2E(2) + 0.50000E-04) 20190, 10190, 40190 03510829 40190 IF (R2E(2) - 0.50000E-04) 10190, 10190, 20190 03520829 10190 IVPASS = IVPASS + 1 03530829 WRITE (NUVI, 80002) IVTNUM 03540829 GO TO 0191 03550829 20190 IVFAIL = IVFAIL + 1 03560829 ZVCORR = (0.375E-3, 0.0E0) 03570829 WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 03580829 0191 CONTINUE 03590829 CT020* TEST 20 WITH COMPLEX 03600829 IVTNUM = 20 03610829 AVC = (4.5, 1.2) 03620829 BVC = CMPLX(AVC) 03630829 IF (R2E(1) - 0.44997E+01) 20200, 40202, 40201 03640829 40201 IF (R2E(1) - 0.45003E+01) 40202, 40202, 20200 03650829 40202 IF (R2E(2) - 0.11999E+01) 20200, 10200, 40200 03660829 40200 IF (R2E(2) - 0.12001E+01) 10200, 10200, 20200 03670829 10200 IVPASS = IVPASS + 1 03680829 WRITE (NUVI, 80002) IVTNUM 03690829 GO TO 0201 03700829 20200 IVFAIL = IVFAIL + 1 03710829 ZVCORR = (4.5, 1.2) 03720829 WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 03730829 0201 CONTINUE 03740829 CT021* TEST 21 TEST OF CMPLX WITH TWO ARGS 03750829 C***** WITH INTEGER ARGS 03760829 IVTNUM = 21 03770829 BVC = CMPLX(3, 1) 03780829 IF (R2E(1) - 0.29998E+01) 20210, 40212, 40211 03790829 40211 IF (R2E(1) - 0.30002E+01) 40212, 40212, 20210 03800829 40212 IF (R2E(2) - 0.99995E+00) 20210, 10210, 40210 03810829 40210 IF (R2E(2) - 0.10001E+01) 10210, 10210, 20210 03820829 10210 IVPASS = IVPASS + 1 03830829 WRITE (NUVI, 80002) IVTNUM 03840829 GO TO 0211 03850829 20210 IVFAIL = IVFAIL + 1 03860829 ZVCORR = (3.0, 1.0) 03870829 WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 03880829 0211 CONTINUE 03890829 CT022* TEST 22 WITH REAL ARGS 03900829 IVTNUM = 22 03910829 BVC = CMPLX(8.34, 634.3) 03920829 IF (R2E(1) - 0.83395E+01) 20220, 40222, 40221 03930829 40221 IF (R2E(1) - 0.83405E+01) 40222, 40222, 20220 03940829 40222 IF (R2E(2) - 0.63426E+03) 20220, 10220, 40220 03950829 40220 IF (R2E(2) - 0.63434E+03) 10220, 10220, 20220 03960829 10220 IVPASS = IVPASS + 1 03970829 WRITE (NUVI, 80002) IVTNUM 03980829 GO TO 0221 03990829 20220 IVFAIL = IVFAIL + 1 04000829 ZVCORR = (8.34, 634.3) 04010829 WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 04020829 0221 CONTINUE 04030829 CT023* TEST 23 WITH DOUBLE PREC ARGS 04040829 IVTNUM = 23 04050829 AVD = 0.96875D0 04060829 BVD = 3.5D-1 04070829 BVC = CMPLX(AVD, BVD) 04080829 IF (R2E(1) - 0.96870E+00) 20230, 40232, 40231 04090829 40231 IF (R2E(1) - 0.96880E+00) 40232, 40232, 20230 04100829 40232 IF (R2E(2) - 0.34998E+00) 20230, 10230, 40230 04110829 40230 IF (R2E(2) - 0.35002E+00) 10230, 10230, 20230 04120829 10230 IVPASS = IVPASS + 1 04130829 WRITE (NUVI, 80002) IVTNUM 04140829 GO TO 0231 04150829 20230 IVFAIL = IVFAIL + 1 04160829 ZVCORR = (0.96875, 0.35) 04170829 WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 04180829 0231 CONTINUE 04190829 CT024* TEST 24 TEST OF INT AND = 04200829 C***** WITH REAL EXPR 04210829 IVTNUM = 24 04220829 CVS = 0.0 04230829 CVD = 0.0D0 04240829 CVC = (0.0,0.0) 04250829 LVI = 0 04260829 AVS = 5.0 04270829 IVI = 1.0 * 5.0 + 6.0 04280829 KVI = LVI + INT(1.0 * AVS + 6.0) 04290829 IF (KVI - 11) 20240, 10240, 20240 04300829 10240 IVPASS = IVPASS + 1 04310829 WRITE (NUVI, 80002) IVTNUM 04320829 GO TO 0241 04330829 20240 IVFAIL = IVFAIL + 1 04340829 IVCORR = 11 04350829 WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR 04360829 0241 CONTINUE 04370829 CT025* TEST 25 WITH DOUBLE PREC EXPR 04380829 IVTNUM = 25 04390829 AVD = 3.48D0 04400829 IVI = 3.48D0 * 47.98D0 04410829 KVI = LVI + INT(AVD * 47.98D0) 04420829 IF (KVI - 166) 20250, 10250, 20250 04430829 10250 IVPASS = IVPASS + 1 04440829 WRITE (NUVI, 80002) IVTNUM 04450829 GO TO 0251 04460829 20250 IVFAIL = IVFAIL + 1 04470829 IVCORR = 166 04480829 WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR 04490829 0251 CONTINUE 04500829 CT026* TEST 26 WITH COMPLEX EXPR 04510829 IVTNUM = 26 04520829 AVC = (3.9, 5.0) 04530829 IVI = (3.4, 4.5) + (3.9, 5.0) 04540829 KVI = LVI + INT((3.4, 4.5) + AVC) 04550829 IF (KVI - 7) 20260, 10260, 20260 04560829 10260 IVPASS = IVPASS + 1 04570829 WRITE (NUVI, 80002) IVTNUM 04580829 GO TO 0261 04590829 20260 IVFAIL = IVFAIL + 1 04600829 IVCORR = 7 04610829 WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR 04620829 0261 CONTINUE 04630829 CT027* TEST 27 TEST OF REAL AND = 04640829 C***** WITH INT EXPR 04650829 IVTNUM = 27 04660829 IVI = 20 04670829 AVS = 20 + 34 / 20 04680829 BVS = CVS + REAL(IVI + 34 / IVI) 04690829 IF (BVS - 0.20999E+02) 20270, 10270, 40270 04700829 40270 IF (BVS - 0.21001E+02) 10270, 10270, 20270 04710829 10270 IVPASS = IVPASS + 1 04720829 WRITE (NUVI, 80002) IVTNUM 04730829 GO TO 0271 04740829 20270 IVFAIL = IVFAIL + 1 04750829 RVCORR = 21.0 04760829 WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 04770829 0271 CONTINUE 04780829 CT028* TEST 28 WITH DOUBLE PREC EXPR 04790829 IVTNUM = 28 04800829 JVI = 28 04810829 AVD = 0.9834D0 04820829 AVS = 3.0748D0 / 0.9834D0 04830829 BVS = CVS + REAL(3.0748D0 / AVD) 04840829 IF (BVS - 0.31265E+01) 20280, 10280, 40280 04850829 40280 IF (BVS - 0.31269E+01) 10280, 10280, 20280 04860829 10280 IVPASS = IVPASS + 1 04870829 WRITE (NUVI, 80002) IVTNUM 04880829 GO TO 0281 04890829 20280 IVFAIL = IVFAIL + 1 04900829 RVCORR = 3.1267033 04910829 WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 04920829 0281 CONTINUE 04930829 CT029* TEST 29 WITH COMPLEX 04940829 IVTNUM = 29 04950829 JVI = 29 04960829 AVC = (1.0, 384.9) 04970829 AVS = (3.495, 98.734) * (1.0, 384.9) 04980829 BVS = CVS + REAL((3.495, 98.734) * AVC) 04990829 IF (BVS + 0.38001E+05) 20290, 10290, 40290 05000829 40290 IF (BVS + 0.37997E+05) 10290, 10290, 20290 05010829 10290 IVPASS = IVPASS + 1 05020829 WRITE (NUVI, 80002) IVTNUM 05030829 GO TO 0291 05040829 20290 IVFAIL = IVFAIL + 1 05050829 RVCORR = -37999.222 05060829 WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 05070829 0291 CONTINUE 05080829 CT030* TEST 30 TEST OF DBLE AND = 05090829 C***** WITH INTEGER EXPR 05100829 IVTNUM = 30 05110829 JVI = 30 05120829 IVI = 5 05130829 AVD = 1 * 5 + 6 05140829 BVD = CVD + DBLE(1 * IVI + 6) 05150829 IF (BVD - 0.10999D+02) 20300, 10300, 40300 05160829 40300 IF (BVD - 0.11001D+02) 10300, 10300, 20300 05170829 10300 IVPASS = IVPASS + 1 05180829 WRITE (NUVI, 80002) IVTNUM 05190829 GO TO 0301 05200829 20300 IVFAIL = IVFAIL + 1 05210829 DVCORR = .11000000D+02 05220829 WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 05230829 0301 CONTINUE 05240829 CT031* TEST 31 WITH REAL EXPR 05250829 IVTNUM = 31 05260829 JVI = 31 05270829 AVS = -4.5 05280829 AVD = 1.3 / (-4.5) 05290829 BVD = CVD + DBLE(1.3 / AVS) 05300829 IF (BVD + 0.28891D+00) 20310, 10310, 40310 05310829 40310 IF (BVD + 0.28887D+00) 10310, 10310, 20310 05320829 10310 IVPASS = IVPASS + 1 05330829 WRITE (NUVI, 80002) IVTNUM 05340829 GO TO 0311 05350829 20310 IVFAIL = IVFAIL + 1 05360829 DVCORR = -0.288888888888888889D+00 05370829 WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 05380829 0311 CONTINUE 05390829 CT032* TEST 32 WITH COMPLEX EXPR 05400829 IVTNUM = 32 05410829 JVI = 32 05420829 AVC = (3.9, 5.0) 05430829 AVD = (3.4, 4.5) + (3.9, 5.0) 05440829 BVD = CVD + DBLE((3.4, 4.5) + AVC) 05450829 IF (BVD - 0.72996D+01) 20320, 10320, 40320 05460829 40320 IF (BVD - 0.73004D+01) 10320, 10320, 20320 05470829 10320 IVPASS = IVPASS + 1 05480829 WRITE (NUVI, 80002) IVTNUM 05490829 GO TO 0321 05500829 20320 IVFAIL = IVFAIL + 1 05510829 DVCORR = .73000000D+01 05520829 WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 05530829 0321 CONTINUE 05540829 CT033* TEST 33 TEST OF CMPLX AND = 05550829 C***** WITH INTEGER EXPR 05560829 IVTNUM = 33 05570829 JVI = 33 05580829 IVI = 673 05590829 AVC = 394 - 673 05600829 BVC = CVC + CMPLX(394 - IVI) 05610829 IF (R2E(1) + 0.27902E+03) 20330, 40332, 40331 05620829 40331 IF (R2E(1) + 0.27898E+03) 40332, 40332, 20330 05630829 40332 IF (R2E(2) + 0.50000E-04) 20330, 10330, 40330 05640829 40330 IF (R2E(2) - 0.50000E-04) 10330, 10330, 20330 05650829 10330 IVPASS = IVPASS + 1 05660829 WRITE (NUVI, 80002) IVTNUM 05670829 GO TO 0331 05680829 20330 IVFAIL = IVFAIL + 1 05690829 ZVCORR = (-279.00000, .00000000) 05700829 WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 05710829 0331 CONTINUE 05720829 CT034* TEST 34 WITH REAL EXPR 05730829 IVTNUM = 34 05740829 JVI = 34 05750829 AVS = 3.48 05760829 AVC = 3.48 * 47.98 05770829 BVC = CVC + CMPLX(AVS * 47.98) 05780829 IF (R2E(1) - 0.16696E+03) 20340, 40342, 40341 05790829 40341 IF (R2E(1) - 0.16698E+03) 40342, 40342, 20340 05800829 40342 IF (R2E(2) + 0.50000E-04) 20340, 10340, 40340 05810829 40340 IF (R2E(2) - 0.50000E-04) 10340, 10340, 20340 05820829 10340 IVPASS = IVPASS + 1 05830829 WRITE (NUVI, 80002) IVTNUM 05840829 GO TO 0341 05850829 20340 IVFAIL = IVFAIL + 1 05860829 ZVCORR = (166.97040, .00000000) 05870829 WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 05880829 0341 CONTINUE 05890829 CT035* TEST 35 05900829 IVTNUM = 35 05910829 JVI = 35 05920829 AVD = 0.94D1 05930829 AVC = 3.0283D3 / 0.94D1 05940829 BVC = CVC + CMPLX(3.0283D3 / AVD) 05950829 IF (R2E(1) - 0.32214E+03) 20350, 40352, 40351 05960829 40351 IF (R2E(1) - 0.32218E+03) 40352, 40352, 20350 05970829 40352 IF (R2E(2) + 0.50000E-04) 20350, 10350, 40350 05980829 40350 IF (R2E(2) - 0.50000E-04) 10350, 10350, 20350 05990829 10350 IVPASS = IVPASS + 1 06000829 WRITE (NUVI, 80002) IVTNUM 06010829 GO TO 0351 06020829 20350 IVFAIL = IVFAIL + 1 06030829 ZVCORR = (322.15957, .000000000) 06040829 WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 06050829 0351 CONTINUE 06060829 C***** 06070829 CBB** ********************** BBCSUM0 **********************************06080829 C**** WRITE OUT TEST SUMMARY 06090829 C**** 06100829 IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 06110829 WRITE (I02, 90004) 06120829 WRITE (I02, 90014) 06130829 WRITE (I02, 90004) 06140829 WRITE (I02, 90020) IVPASS 06150829 WRITE (I02, 90022) IVFAIL 06160829 WRITE (I02, 90024) IVDELE 06170829 WRITE (I02, 90026) IVINSP 06180829 WRITE (I02, 90028) IVTOTN, IVTOTL 06190829 CBE** ********************** BBCSUM0 **********************************06200829 CBB** ********************** BBCFOOT0 **********************************06210829 C**** WRITE OUT REPORT FOOTINGS 06220829 C**** 06230829 WRITE (I02,90016) ZPROG, ZPROG 06240829 WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 06250829 WRITE (I02,90019) 06260829 CBE** ********************** BBCFOOT0 **********************************06270829 CBB** ********************** BBCFMT0A **********************************06280829 C**** FORMATS FOR TEST DETAIL LINES 06290829 C**** 06300829 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 06310829 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 06320829 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 06330829 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 06340829 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 06350829 1I6,/," ",15X,"CORRECT= " ,I6) 06360829 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06370829 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 06380829 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06390829 1A21,/," ",16X,"CORRECT= " ,A21) 06400829 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 06410829 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 06420829 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 06430829 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 06440829 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 06450829 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 06460829 80050 FORMAT (" ",48X,A31) 06470829 CBE** ********************** BBCFMT0A **********************************06480829 CBB** ********************** BBCFMAT1 **********************************06490829 C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 06500829 C**** 06510829 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06520829 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 06530829 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 06540829 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 06550829 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 06560829 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 06570829 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06580829 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06590829 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06600829 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 06610829 2"(",F12.5,", ",F12.5,")") 06620829 CBE** ********************** BBCFMAT1 **********************************06630829 CBB** ********************** BBCFMT0B **********************************06640829 C**** FORMAT STATEMENTS FOR PAGE HEADERS 06650829 C**** 06660829 90002 FORMAT ("1") 06670829 90004 FORMAT (" ") 06680829 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )06690829 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06700829 90008 FORMAT (" ",21X,A13,A17) 06710829 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 06720829 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 06730829 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 06740829 1 7X,"REMARKS",24X) 06750829 90014 FORMAT (" ","----------------------------------------------" , 06760829 1 "---------------------------------" ) 06770829 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 06780829 C**** 06790829 C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 06800829 C**** 06810829 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 06820829 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 06830829 1 A13) 06840829 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 06850829 C**** 06860829 C**** FORMAT STATEMENTS FOR RUN SUMMARY 06870829 C**** 06880829 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 06890829 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 06900829 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 06910829 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 06920829 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 06930829 CBE** ********************** BBCFMT0B **********************************06940829 C***** 06950829 C***** END OF TEST SEGMENT 206 06960829 STOP 06970829 END 06980829