PROGRAM FM700 00010700 C 00020700 C THIS PROGRAM TESTS THE DATA STATEMENT WITH ANS REF. 00030700 C VARIABLE NAMES, ARRAY NAMES, ARRAY ELEMENT 9.1 00040700 C NAMES, SUBSTRING NAMES, AND IMPLIED-DO LISTS. 9.2 00050700 C 9.3 00060700 C SYMBOLIC NAMES OF CONSTANTS ARE PERMITTED IN THE 00070700 C CLIST OF THE DATA STATEMENT. IF NECESSARY, 00080700 C THE CLIST CONSTANT IS CONVERTED TO THE TYPE 00090700 C OF THE NLIST ENTITY ACCORDING TO THE RULES 00100700 C FOR ARITHMETIC CONVERSION. 00110700 C 00120700 C 00130700 CBB** ********************** BBCCOMNT **********************************00140700 C**** 00150700 C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00160700 C**** VERSION 2.1 00170700 C**** 00180700 C**** 00190700 C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00200700 C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00210700 C**** SOFTWARE STANDARDS VALIDATION GROUP 00220700 C**** BUILDING 225 RM A266 00230700 C**** GAITHERSBURG, MD 20899 00240700 C**** 00250700 C**** 00260700 C**** 00270700 CBE** ********************** BBCCOMNT **********************************00280700 IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00290700 IMPLICIT CHARACTER*27 (C) 00300700 CBB** ********************** BBCINITA **********************************00310700 C**** SPECIFICATION STATEMENTS 00320700 C**** 00330700 CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00340700 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00350700 CBE** ********************** BBCINITA **********************************00360700 C 00370700 INTEGER I2N001(2,3), I2N002(7), I2N003(3,7) 00380700 INTEGER I2N004(3,10), I2N005(4,5), I2N006(6,8) 00390700 CHARACTER CVCOMP*25, CVCORR*25, CPN001*5 00400700 CHARACTER CVN001*25, CVN002*5, C1N001(3)*5 00410700 CHARACTER C2N001(3,4)*4, CVN003*17 00420700 REAL R2E001(2), R2N001(5,3) 00430700 DOUBLE PRECISION DVCOMP, DVCORR, DVN001, D1N001(9), DPN001 00440700 COMPLEX ZVCOMP, ZVCORR, ZVN001, Z1N001(10) 00450700 PARAMETER (IPN001=-14, CPN001='SEVEN', IPN002=5, DPN001=0.1948D+3)00460700 EQUIVALENCE (ZVCOMP, R2E001) 00470700 DATA IVN001, C1N001, I2N001(2,1), CVN001(11:22) 00480700 1 /-137, 'FIRST', 'SECND', 'THIRD', 65, 'ELEVENTWELVE'/ 00490700 DATA (I2N001(1,I), I=1,3) /-47, 198, -217/ 00500700 DATA IVN002, CVN002 /IPN001, CPN001/ 00510700 DATA I2N002, (I2N003(I,7), I=1,3), C2N001, CVN003(13:16) 00520700 1 /3*19, 7*-4, 13*'SAME'/ 00530700 DATA IVN003, IVN004, RVN001, ZVN001, DVN001, DVN002 00540700 1 /-0.473E+3, 239.2D-1, 71, (71, -27), 6, 9.1534E-2/ 00550700 DATA (I2N004(2,J), J=1,10) /9,8,7,6,5,4,3,2,1,0/ 00560700 DATA ((R2N001(I,J), J=1,3), I=3,5) 00570700 1 /3.1, 3.2, 3.3, 4.1, 4.2, 4.3, 5.1, 5.2, 5.3/ 00580700 DATA (Z1N001(I), I=3,7) /IPN002*(7.3, -2.28)/ 00590700 DATA (D1N001(I), I=1,9,2) /IPN002*DPN001/ 00600700 DATA (I2N005(I,I+1),I=1,4) / 91, -82, 73, -64/ 00610700 DATA ((I2N006(2*I,I*J-1), I=2,3), J=1,3,2) /41, 62, 45, 68/ 00620700 C 00630700 C 00640700 CBB** ********************** BBCINITB **********************************00650700 C**** INITIALIZE SECTION 00660700 DATA ZVERS, ZVERSD, ZDATE 00670700 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00680700 DATA ZCOMPL, ZNAME, ZTAPE 00690700 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00700700 DATA ZPROJ, ZTAPED, ZPROG 00710700 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00720700 DATA REMRKS /' '/ 00730700 C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00740700 C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00750700 C**** 00760700 CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00770700 CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00780700 CZ03 ZPROG = 'PROGRAM NAME' 00790700 CZ04 ZDATE = 'DATE OF TEST' 00800700 CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00810700 CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00820700 CZ07 ZNAME = 'NAME OF USER' 00830700 CZ08 ZTAPE = 'TAPE OWNER/ID' 00840700 CZ09 ZTAPED = 'DATE TAPE COPIED' 00850700 C 00860700 IVPASS = 0 00870700 IVFAIL = 0 00880700 IVDELE = 0 00890700 IVINSP = 0 00900700 IVTOTL = 0 00910700 IVTOTN = 0 00920700 ICZERO = 0 00930700 C 00940700 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00950700 I01 = 05 00960700 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00970700 I02 = 06 00980700 C 00990700 CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 01000700 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01010700 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01020700 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01030700 C 01040700 CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 01050700 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01060700 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01070700 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01080700 C 01090700 CBE** ********************** BBCINITB **********************************01100700 ZPROG = 'FM700' 01110700 IVTOTL = 23 01120700 CBB** ********************** BBCHED0A **********************************01130700 C**** 01140700 C**** WRITE REPORT TITLE 01150700 C**** 01160700 WRITE (I02, 90002) 01170700 WRITE (I02, 90006) 01180700 WRITE (I02, 90007) 01190700 WRITE (I02, 90008) ZVERS, ZVERSD 01200700 WRITE (I02, 90009) ZPROG, ZPROG 01210700 WRITE (I02, 90010) ZDATE, ZCOMPL 01220700 CBE** ********************** BBCHED0A **********************************01230700 CBB** ********************** BBCHED0B **********************************01240700 C**** WRITE DETAIL REPORT HEADERS 01250700 C**** 01260700 WRITE (I02,90004) 01270700 WRITE (I02,90004) 01280700 WRITE (I02,90013) 01290700 WRITE (I02,90014) 01300700 WRITE (I02,90015) IVTOTL 01310700 CBE** ********************** BBCHED0B **********************************01320700 C 01330700 C 01340700 C TESTS 1 THRU 5 TEST DATA STATEMENT WITH VARIABLE NAMES, 01350700 C ARRAY NAMES, ARRAY ELEMENT NAMES, SUBSTRING NAMES, AND IMPLIED- 01360700 C DO LISTS. 01370700 C 01380700 CT001* TEST 001 **** FCVS PROGRAM 700 ***** 01390700 C VARIABLE NAME 01400700 C 01410700 IVTNUM = 1 01420700 IVCOMP = 0 01430700 IVCORR = -137 01440700 IVCOMP = IVN001 01450700 40010 IF (IVCOMP + 137) 20010, 10010, 20010 01460700 10010 IVPASS = IVPASS + 1 01470700 WRITE (I02, 80002) IVTNUM 01480700 GO TO 0011 01490700 20010 IVFAIL = IVFAIL + 1 01500700 WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 01510700 0011 CONTINUE 01520700 C 01530700 CT002* TEST 002 **** FCVS PROGRAM 700 ***** 01540700 C ARRAY NAME 01550700 C 01560700 IVTNUM = 2 01570700 CVCOMP = ' ' 01580700 CVCORR = 'SECND' 01590700 CVCOMP = C1N001(2) 01600700 IVCOMP = 0 01610700 IF (CVCOMP.EQ.'SECND') IVCOMP = 1 01620700 40020 IF (IVCOMP - 1) 20020, 10020, 20020 01630700 10020 IVPASS = IVPASS + 1 01640700 WRITE (I02, 80002) IVTNUM 01650700 GO TO 0021 01660700 20020 IVFAIL = IVFAIL + 1 01670700 WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 01680700 0021 CONTINUE 01690700 C 01700700 CT003* TEST 003 **** FCVS PROGRAM 700 ***** 01710700 C ARRAY ELEMENT NAME 01720700 C 01730700 IVTNUM = 3 01740700 IVCOMP = 0 01750700 IVCORR = 65 01760700 IVCOMP = I2N001(2,1) 01770700 40030 IF (IVCOMP - 65) 20030, 10030, 20030 01780700 10030 IVPASS = IVPASS + 1 01790700 WRITE (I02, 80002) IVTNUM 01800700 GO TO 0031 01810700 20030 IVFAIL = IVFAIL + 1 01820700 WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 01830700 0031 CONTINUE 01840700 C 01850700 CT004* TEST 004 **** FCVS PROGRAM 700 ***** 01860700 C SUBSTRING NAME 01870700 C 01880700 IVTNUM = 4 01890700 CVCOMP = ' ' 01900700 CVCORR = 'ELEVENTWELVE' 01910700 CVCOMP = CVN001(11:22) 01920700 IVCOMP = 0 01930700 IF (CVCOMP.EQ.'ELEVENTWELVE') IVCOMP = 1 01940700 40040 IF (IVCOMP - 1) 20040, 10040, 20040 01950700 10040 IVPASS = IVPASS + 1 01960700 WRITE (I02, 80002) IVTNUM 01970700 GO TO 0041 01980700 20040 IVFAIL = IVFAIL + 1 01990700 WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 02000700 0041 CONTINUE 02010700 C 02020700 CT005* TEST 005 **** FCVS PROGRAM 700 ***** 02030700 C IMPLIED-DO LIST 02040700 C 02050700 IVTNUM = 5 02060700 IVCOMP = 0 02070700 IVCORR = -217 02080700 IVCOMP = I2N001(1,3) 02090700 40050 IF (IVCOMP + 217) 20050, 10050, 20050 02100700 10050 IVPASS = IVPASS + 1 02110700 WRITE (I02, 80002) IVTNUM 02120700 GO TO 0051 02130700 20050 IVFAIL = IVFAIL + 1 02140700 WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 02150700 0051 CONTINUE 02160700 C 02170700 CT006* TEST 006 **** FCVS PROGRAM 700 ***** 02180700 C CLIST CONTAINS A SYMBOLIC NAME OF AN INTEGER CONSTANT 02190700 C 02200700 IVTNUM = 6 02210700 IVCOMP = 0 02220700 IVCORR = -14 02230700 IVCOMP = IVN002 02240700 40060 IF (IVCOMP + 14) 20060, 10060, 20060 02250700 10060 IVPASS = IVPASS + 1 02260700 WRITE (I02, 80002) IVTNUM 02270700 GO TO 0061 02280700 20060 IVFAIL = IVFAIL + 1 02290700 WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 02300700 0061 CONTINUE 02310700 C 02320700 CT007* TEST 007 **** FCVS PROGRAM 700 ***** 02330700 C CLIST CONTAINS A SYMBOLIC NAME OF A CHARACTER CONSTANT 02340700 C 02350700 IVTNUM = 7 02360700 CVCOMP = ' ' 02370700 CVCORR = 'SEVEN' 02380700 CVCOMP = CVN002 02390700 IVCOMP = 0 02400700 IF (CVCOMP.EQ.'SEVEN') IVCOMP = 1 02410700 40070 IF (IVCOMP - 1) 20070, 10070, 20070 02420700 10070 IVPASS = IVPASS + 1 02430700 WRITE (I02, 80002) IVTNUM 02440700 GO TO 0071 02450700 20070 IVFAIL = IVFAIL + 1 02460700 WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 02470700 0071 CONTINUE 02480700 C 02490700 C TESTS 8 THRU 11 TEST COMBINATIONS OF SUBSTRING NAMES AND 02500700 C ARRAY NAMES AND THE R*C FORMAT OF THE CLIST 02510700 C 02520700 CT008* TEST 008 **** FCVS PROGRAM 700 ***** 02530700 C 02540700 IVTNUM = 8 02550700 IVCOMP = 0 02560700 IVCORR = 23 02570700 IVCOMP = I2N002(3) - I2N002(4) 02580700 40080 IF (IVCOMP - 23) 20080, 10080, 20080 02590700 10080 IVPASS = IVPASS + 1 02600700 WRITE (I02, 80002) IVTNUM 02610700 GO TO 0081 02620700 20080 IVFAIL = IVFAIL + 1 02630700 WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 02640700 0081 CONTINUE 02650700 C 02660700 CT009* TEST 009 **** FCVS PROGRAM 700 ***** 02670700 C 02680700 IVTNUM = 9 02690700 IVCOMP = 0 02700700 IVCORR = -4 02710700 DO 0092 I = 1, 3 02720700 IF (I2N003(I,7) + 4) 0093, 0092, 0093 02730700 0092 CONTINUE 02740700 0093 IVCOMP = I2N003(3,7) 02750700 40090 IF (IVCOMP + 4) 20090, 10090, 20090 02760700 10090 IVPASS = IVPASS + 1 02770700 WRITE (I02, 80002) IVTNUM 02780700 GO TO 0091 02790700 20090 IVFAIL = IVFAIL + 1 02800700 WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 02810700 0091 CONTINUE 02820700 C 02830700 CT010* TEST 010 **** FCVS PROGRAM 700 ***** 02840700 C 02850700 IVTNUM = 10 02860700 CVCOMP = ' ' 02870700 CVCORR = 'SAME' 02880700 DO 0102 I = 1, 3 02890700 DO 0102 J = 1, 4 02900700 IF (C2N001(I,J).NE.'SAME') GO TO 0103 02910700 0102 CONTINUE 02920700 0103 CVCOMP = C2N001(3,4) 02930700 IVCOMP = 0 02940700 IF (CVCOMP.EQ.'SAME') IVCOMP = 1 02950700 40100 IF (IVCOMP - 1) 20100, 10100, 20100 02960700 10100 IVPASS = IVPASS + 1 02970700 WRITE (I02, 80002) IVTNUM 02980700 GO TO 0101 02990700 20100 IVFAIL = IVFAIL + 1 03000700 WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 03010700 0101 CONTINUE 03020700 C 03030700 CT011* TEST 011 **** FCVS PROGRAM 700 ***** 03040700 C 03050700 IVTNUM = 11 03060700 CVCOMP = ' ' 03070700 CVCORR = 'SAME' 03080700 CVCOMP = CVN003(13:16) 03090700 IVCOMP = 0 03100700 IF (CVCOMP.EQ.'SAME') IVCOMP = 1 03110700 40110 IF (IVCOMP - 1) 20110, 10110, 20110 03120700 10110 IVPASS = IVPASS + 1 03130700 WRITE (I02, 80002) IVTNUM 03140700 GO TO 0111 03150700 20110 IVFAIL = IVFAIL + 1 03160700 WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 03170700 0111 CONTINUE 03180700 C 03190700 C TESTS 12 THRU 17 TEST ARITHMETIC CONVERSION OF CLIST 03200700 C CONSTANTS TO THE TYPE OF THE CORRESPONDING NLIST ENTITIES 03210700 C 03220700 CT012* TEST 012 **** FCVS PROGRAM 700 ***** 03230700 C REAL TO INTEGER 03240700 C 03250700 IVTNUM = 12 03260700 IVCOMP = 0 03270700 IVCORR = -473 03280700 IVCOMP = IVN003 03290700 40120 IF (IVCOMP + 473) 20120, 10120, 20120 03300700 10120 IVPASS = IVPASS + 1 03310700 WRITE (I02, 80002) IVTNUM 03320700 GO TO 0121 03330700 20120 IVFAIL = IVFAIL + 1 03340700 WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 03350700 0121 CONTINUE 03360700 C 03370700 CT013* TEST 013 **** FCVS PROGRAM 700 ***** 03380700 C DOUBLE PRECISION TO INTEGER 03390700 C 03400700 IVTNUM = 13 03410700 IVCOMP = 0 03420700 IVCORR = 23 03430700 IVCOMP = IVN004 03440700 40130 IF (IVCOMP - 23) 20130, 10130, 20130 03450700 10130 IVPASS = IVPASS + 1 03460700 WRITE (I02, 80002) IVTNUM 03470700 GO TO 0131 03480700 20130 IVFAIL = IVFAIL + 1 03490700 WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 03500700 0131 CONTINUE 03510700 C 03520700 CT014* TEST 014 **** FCVS PROGRAM 700 ***** 03530700 C INTEGER TO REAL 03540700 C 03550700 IVTNUM = 14 03560700 RVCOMP = 0.0 03570700 RVCORR = 71.0 03580700 RVCOMP = RVN001 03590700 IF (RVCOMP - 0.70996E+02) 20140, 10140, 40140 03600700 40140 IF (RVCOMP - 0.71004E+02) 10140, 10140, 20140 03610700 10140 IVPASS = IVPASS + 1 03620700 WRITE (I02, 80002) IVTNUM 03630700 GO TO 0141 03640700 20140 IVFAIL = IVFAIL + 1 03650700 WRITE (I02, 80012) IVTNUM, RVCOMP, RVCORR 03660700 0141 CONTINUE 03670700 C 03680700 CT015* TEST 015 **** FCVS PROGRAM 700 ***** 03690700 C COMPLEX 03700700 C 03710700 IVTNUM = 15 03720700 ZVCOMP = (0.0, 0.0) 03730700 ZVCORR = (71.0, -27.0) 03740700 ZVCOMP = ZVN001 03750700 IF (R2E001(1) - 0.70996E+02) 20150, 40152, 40151 03760700 40151 IF (R2E001(1) - 0.71004E+02) 40152, 40152, 20150 03770700 40152 IF (R2E001(2) + 0.27002E+02) 20150, 10150, 40150 03780700 40150 IF (R2E001(2) + 0.26998E+02) 10150, 10150, 20150 03790700 10150 IVPASS = IVPASS + 1 03800700 WRITE (I02, 80002) IVTNUM 03810700 GO TO 0151 03820700 20150 IVFAIL = IVFAIL + 1 03830700 WRITE (I02, 80045) IVTNUM, ZVCOMP, ZVCORR 03840700 0151 CONTINUE 03850700 C 03860700 CT016* TEST 016 **** FCVS PROGRAM 700 ***** 03870700 C INTEGER TO DOUBLE PRECISION 03880700 C 03890700 IVTNUM = 16 03900700 DVCOMP = 0.0D0 03910700 DVCORR = 6.0D0 03920700 DVCOMP = DVN001 03930700 IF (DVCOMP - 0.5999999997D+01) 20160, 10160, 40160 03940700 40160 IF (DVCOMP - 0.6000000003D+01) 10160, 10160, 20160 03950700 10160 IVPASS = IVPASS + 1 03960700 WRITE (I02, 80002) IVTNUM 03970700 GO TO 0161 03980700 20160 IVFAIL = IVFAIL + 1 03990700 WRITE (I02, 80031) IVTNUM, DVCOMP, DVCORR 04000700 0161 CONTINUE 04010700 C 04020700 CT017* TEST 017 **** FCVS PROGRAM 700 ***** 04030700 C REAL TO DOUBLE PRECISION 04040700 C 04050700 IVTNUM = 17 04060700 DVCOMP = 0.0D0 04070700 DVCORR = 9.1534D-2 04080700 DVCOMP = DVN002 04090700 IF (DVCOMP - 0.91529D-01) 20170, 10170, 40170 04100700 40170 IF (DVCOMP - 0.91539D-01) 10170, 10170, 20170 04110700 10170 IVPASS = IVPASS + 1 04120700 WRITE (I02, 80002) IVTNUM 04130700 GO TO 0171 04140700 20170 IVFAIL = IVFAIL + 1 04150700 WRITE (I02, 80031) IVTNUM, DVCOMP, DVCORR 04160700 0171 CONTINUE 04170700 C 04180700 C TESTS 18 THRU 21 TEST DIFFERENT DATA TYPES USING THE IMPLIED-DO 04190700 C 04200700 CT018* TEST 018 **** FCVS PROGRAM 700 ***** 04210700 C INTEGER 04220700 C 04230700 IVTNUM = 18 04240700 IVCOMP = 0 04250700 IVCORR = 3 04260700 IVCOMP = I2N004(2,7) 04270700 40180 IF (IVCOMP - 3) 20180, 10180, 20180 04280700 10180 IVPASS = IVPASS + 1 04290700 WRITE (I02, 80002) IVTNUM 04300700 GO TO 0181 04310700 20180 IVFAIL = IVFAIL + 1 04320700 WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 04330700 0181 CONTINUE 04340700 C 04350700 CT019* TEST 019 **** FCVS PROGRAM 700 ***** 04360700 C REAL 04370700 C 04380700 IVTNUM = 19 04390700 RVCOMP = 0.0 04400700 RVCORR = 4.1 04410700 RVCOMP = R2N001(4,1) 04420700 IF (RVCOMP - 0.40998E+01) 20190, 10190, 40190 04430700 40190 IF (RVCOMP - 0.41002E+01) 10190, 10190, 20190 04440700 10190 IVPASS = IVPASS + 1 04450700 WRITE (I02, 80002) IVTNUM 04460700 GO TO 0191 04470700 20190 IVFAIL = IVFAIL + 1 04480700 WRITE (I02, 80012) IVTNUM, RVCOMP, RVCORR 04490700 0191 CONTINUE 04500700 C 04510700 CT020* TEST 020 **** FCVS PROGRAM 700 ***** 04520700 C COMPLEX 04530700 C 04540700 IVTNUM = 20 04550700 ZVCOMP = (0.0, 0.0) 04560700 ZVCORR = (7.3, -2.28) 04570700 ZVCOMP = Z1N001(7) 04580700 IF (R2E001(1) - 0.72996E+01) 20200, 40202, 40201 04590700 40201 IF (R2E001(1) - 0.73004E+01) 40202, 40202, 20200 04600700 40202 IF (R2E001(2) + 0.22802E+01) 20200, 10200, 40200 04610700 40200 IF (R2E001(2) + 0.22798E+01) 10200, 10200, 20200 04620700 10200 IVPASS = IVPASS + 1 04630700 WRITE (I02, 80002) IVTNUM 04640700 GO TO 0201 04650700 20200 IVFAIL = IVFAIL + 1 04660700 WRITE (I02, 80045) IVTNUM, ZVCOMP, ZVCORR 04670700 0201 CONTINUE 04680700 C 04690700 CT021* TEST 021 **** FCVS PROGRAM 700 ***** 04700700 C DOUBLE PRECISION 04710700 C 04720700 IVTNUM = 21 04730700 DVCOMP = 0.0D0 04740700 DVCORR = 0.1948D+3 04750700 DVCOMP = D1N001(9) 04760700 IF (DVCOMP - 0.1947999999D+03) 20210, 10210, 40210 04770700 40210 IF (DVCOMP - 0.1948000001D+03) 10210, 10210, 20210 04780700 10210 IVPASS = IVPASS + 1 04790700 WRITE (I02, 80002) IVTNUM 04800700 GO TO 0211 04810700 20210 IVFAIL = IVFAIL + 1 04820700 WRITE (I02, 80031) IVTNUM, DVCOMP, DVCORR 04830700 0211 CONTINUE 04840700 C 04850700 C TESTS 22 AND 23 TEST THAT EACH SUBSCRIPT EXPRESSION 04860700 C IN AN IMPLIED-DO LIST MAY CONTAIN IMPLIED-DO-VARIABLES OF 04870700 C THE LIST THAT HAS THE SUBSCRIPT EXPRESSION WITHIN ITS RANGE. 04880700 C 04890700 CT022* TEST 022 **** FCVS PROGRAM 700 ***** 04900700 C 04910700 IVTNUM = 22 04920700 IVCOMP = 0 04930700 IVCORR = 155 04940700 IVCOMP = I2N005(3,4) - I2N005(2,3) 04950700 40220 IF (IVCOMP - 155) 20220, 10220, 20220 04960700 10220 IVPASS = IVPASS + 1 04970700 WRITE (I02, 80002) IVTNUM 04980700 GO TO 0221 04990700 20220 IVFAIL = IVFAIL + 1 05000700 WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 05010700 0221 CONTINUE 05020700 C 05030700 CT023* TEST 023 **** FCVS PROGRAM 700 ***** 05040700 C 05050700 IVTNUM = 23 05060700 IVCOMP = 0 05070700 IVCORR = 130 05080700 IVCOMP = I2N006(6,2) + I2N006(6,8) 05090700 40230 IF (IVCOMP - 130) 20230, 10230, 20230 05100700 10230 IVPASS = IVPASS + 1 05110700 WRITE (I02, 80002) IVTNUM 05120700 GO TO 0231 05130700 20230 IVFAIL = IVFAIL + 1 05140700 WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 05150700 0231 CONTINUE 05160700 C 05170700 CBB** ********************** BBCSUM0 **********************************05180700 C**** WRITE OUT TEST SUMMARY 05190700 C**** 05200700 IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 05210700 WRITE (I02, 90004) 05220700 WRITE (I02, 90014) 05230700 WRITE (I02, 90004) 05240700 WRITE (I02, 90020) IVPASS 05250700 WRITE (I02, 90022) IVFAIL 05260700 WRITE (I02, 90024) IVDELE 05270700 WRITE (I02, 90026) IVINSP 05280700 WRITE (I02, 90028) IVTOTN, IVTOTL 05290700 CBE** ********************** BBCSUM0 **********************************05300700 CBB** ********************** BBCFOOT0 **********************************05310700 C**** WRITE OUT REPORT FOOTINGS 05320700 C**** 05330700 WRITE (I02,90016) ZPROG, ZPROG 05340700 WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 05350700 WRITE (I02,90019) 05360700 CBE** ********************** BBCFOOT0 **********************************05370700 90001 FORMAT (" ",56X,"FM700") 05380700 90000 FORMAT (" ",50X,"END OF PROGRAM FM700" ) 05390700 CBB** ********************** BBCFMT0A **********************************05400700 C**** FORMATS FOR TEST DETAIL LINES 05410700 C**** 05420700 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 05430700 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 05440700 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 05450700 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 05460700 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 05470700 1I6,/," ",15X,"CORRECT= " ,I6) 05480700 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05490700 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 05500700 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05510700 1A21,/," ",16X,"CORRECT= " ,A21) 05520700 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 05530700 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 05540700 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 05550700 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 05560700 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 05570700 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 05580700 80050 FORMAT (" ",48X,A31) 05590700 CBE** ********************** BBCFMT0A **********************************05600700 CBB** ********************** BBCFMAT1 **********************************05610700 C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 05620700 C**** 05630700 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05640700 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 05650700 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 05660700 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 05670700 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 05680700 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 05690700 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 05700700 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 05710700 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05720700 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 05730700 2"(",F12.5,", ",F12.5,")") 05740700 CBE** ********************** BBCFMAT1 **********************************05750700 CBB** ********************** BBCFMT0B **********************************05760700 C**** FORMAT STATEMENTS FOR PAGE HEADERS 05770700 C**** 05780700 90002 FORMAT ("1") 05790700 90004 FORMAT (" ") 05800700 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )05810700 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 05820700 90008 FORMAT (" ",21X,A13,A17) 05830700 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 05840700 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 05850700 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 05860700 1 7X,"REMARKS",24X) 05870700 90014 FORMAT (" ","----------------------------------------------" , 05880700 1 "---------------------------------" ) 05890700 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 05900700 C**** 05910700 C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 05920700 C**** 05930700 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 05940700 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 05950700 1 A13) 05960700 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 05970700 C**** 05980700 C**** FORMAT STATEMENTS FOR RUN SUMMARY 05990700 C**** 06000700 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 06010700 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 06020700 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 06030700 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 06040700 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 06050700 CBE** ********************** BBCFMT0B **********************************06060700 STOP 06070700 END 06080700